summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/demos/print.tcl53
-rw-r--r--library/demos/widget80
-rw-r--r--library/msgs/cs.msg18
-rw-r--r--library/msgs/da.msg18
-rw-r--r--library/msgs/de.msg18
-rw-r--r--library/msgs/el.msg18
-rw-r--r--library/msgs/en.msg19
-rw-r--r--library/msgs/eo.msg18
-rw-r--r--library/msgs/es.msg18
-rw-r--r--library/msgs/fr.msg18
-rw-r--r--library/msgs/hu.msg18
-rw-r--r--library/msgs/it.msg18
-rw-r--r--library/msgs/nl.msg18
-rw-r--r--library/msgs/pl.msg18
-rw-r--r--library/msgs/pt.msg18
-rw-r--r--library/msgs/ru.msg18
-rw-r--r--library/msgs/sv.msg18
-rw-r--r--library/print.tcl995
-rw-r--r--library/tk.tcl1
19 files changed, 1325 insertions, 75 deletions
diff --git a/library/demos/print.tcl b/library/demos/print.tcl
new file mode 100644
index 0000000..ebe6553
--- /dev/null
+++ b/library/demos/print.tcl
@@ -0,0 +1,53 @@
+# print.tcl --
+#
+# This demonstration script showcases the tk print commands.
+#
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .print
+destroy $w
+toplevel $w
+wm title $w "Printing Demonstration"
+positionWindow $w
+
+image create photo logo -data {R0lGODlhMABLAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnMzJmZzJmZmZlmmZlmZplmM5kzZpkzM5kzAGaZzGZmzGZmmWYzZmYzMzNmzDNmmTMzmTMzZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAAAAAwAEsAAAb+QIFwSCwahY9HRMI8Op/JJVNSqVqv2OvjyRU8slbIJGwYg60S5ZR6jRi/4ITBOhkYIOd8dltEnAdmFQMJeoVXCEd/VnKGjRVOZ3NVgHlsjpBxVRCEYBIEAAARl4lgZmVgEQAKFx8Mo0ZnpqgAFyi2JqKGmGebWRIAILbCIo27cYFWASTCtievRXqSVwQfzLYeeYESxlnSVRIW1igjWHJmjBXbpKXeFQTizlh1eJNVHbYf0LGc39XW2PIoVZE0whasWPSqFBBHrkKEA3QG0DFTEMXBUsjCWesg4oMFAGwgtKsiwqA+jGiCiRPGAM6pLCVLGKHQ6EGJlc0IuDxzAgX+CCOW9DjAaUsEyAoT+GHpeSRoHgxEUWgAUEUpFhMWgTbKEPUBAU15TBZxekYD0RMEqCDLIpYIWTAcmGEd9rWQBxQyjeQqdK/ZTWEO3mK5l+9No75SrcHhm9WwnlzNoA5zdM+JHz0HCPQdUauZowoFnSw+c2CBvw6dUXT4LMKE6EIHUqMexgCiIREknOwl7Q+FhNQoLuzOc6Kw3kIIVOLqjYKBYCwinmgo9CBEswfMAziK7mRDoQhcUZxwoBKFibq3n3jXI0GyCPLC0DrS8GR1oaEoRBRYVhT99/qG4DcCA/yNU4Ajbjhhnx4P2DJggR3YZog6RyyYxwM9PSgMBaP+sQdgIRL0JAKBwnTooRMAFWLdiPyJ8JwvTnyQoh5midCASh149ZkTIFAmHnzOZOBfIU6U4Mhd4zF34DNEoDAhARGY50BvJkioyxFOGkKAShGkFsJwejiR5Xf8aZAaBp89coQJjuDXAQOApekEm45ANaAtIbyYxREf0OlICCK841uaahZBQjyfjXCACYjuaASjhFagRKSFNtloHg+hYWIxRohnBQWCSSAhBVZ+hkgRnlbxwJIVgIqGlaU6wkeTxHxjm6gVLImrFbHWVEQ1taZjWxJX7KqqnqgUEUxDwtqajrOaRkqhEDcxWwECbEjxTYe9gojqOJQ6JO231ob72bSqAjh4RgfsjiDCCfDCK8K8I9TL7r33nvGtCO7CO1dUAONk3LcBFxzwwEMwZ/DC4iAsRIE+CWNCbzeV8FfEtoDwVwnlacxMkcKQYIE/F5TQ2QcedUZCagyc3NsFGrXVZMipWVBCzKv4Q0JvCviDsjAwf4ylxBeX0KcwGs81ccgqGS3MBxc3RjDDVAvdBRcfeFy1MFd3bcQHJEQdlddkP5E1Cf9yXfbaV2d9RBAAOw==
+}
+
+
+pack [label $w.l -text "This demonstration showcases
+ the tk print command. Clicking the buttons below
+ print the data from the canvas and text widgets
+ using platform-native dialogs."] -side top
+
+pack [frame $w.m] -fill both -expand yes -side top
+
+set c [canvas $w.m.c -bg white]
+pack $c -fill both -expand no -side left
+
+$c create rectangle 30 10 200 50 -fill blue -outline black
+$c create oval 30 60 200 110 -fill green
+$c create image 130 150 -image logo
+$c create text 150 250 -anchor n -font {Helvetica 12} \
+ -text "A short demo of simple canvas elements."
+
+set txt {
+Tcl, or Tool Command Language, is an open-source multi-purpose C library which includes a powerful dynamic scripting language. Together they provide ideal cross-platform development environment for any programming project. It has served for decades as an essential system component in organizations ranging from NASA to Cisco Systems, is a must-know language in the fields of EDA, and powers companies such as FlightAware and F5 Networks.
+
+Tcl is fit for both the smallest and largest programming tasks, obviating the need to decide whether it is overkill for a given job or whether a system written in Tcl will scale up as needed. Wherever a shell script might be used Tcl is a better choice, and entire web ecosystems and mission-critical control and testing systems have also been written in Tcl. Tcl excels in all these roles due to the minimal syntax of the language, the unique programming paradigm exposed at the script level, and the careful engineering that has gone into the design of the Tcl internals.
+}
+
+set t [text $w.m.t -wrap word]
+pack $t -side right -fill both -expand no
+$t insert end $txt
+
+pack [frame $w.f] -side top -fill both -expand no
+pack [button $w.f.b -text "Print Canvas" -command [list tk print $w.m.c]] -expand no
+pack [button $w.f.x -text "Print Text" -command [list tk print $w.m.t]] -expand no
+
+## See Code / Dismiss buttons
+pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
+
+
diff --git a/library/demos/widget b/library/demos/widget
index e56954d..354ac3f 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -388,6 +388,8 @@ addFormattedText {
@@demo fontchoose Font selection dialog
@@new
@@demo systray System tray icon and notification
+ @@new
+ @@demo print Printing from canvas and text widgets
@@subtitle Animation
@@demo anilabel Animated labels
@@ -643,80 +645,7 @@ proc showCode w {
# file - Name of the original file (implicitly for title)
proc printCode {w file} {
- set code [$w get 1.0 end-1c]
-
- set dir "."
- if {[info exists ::env(HOME)]} {
- set dir "$::env(HOME)"
- }
- if {[info exists ::env(TMP)]} {
- set dir $::env(TMP)
- }
- if {[info exists ::env(TEMP)]} {
- set dir $::env(TEMP)
- }
-
- set filename [file join $dir "tkdemo-$file"]
- set outfile [open $filename "w"]
- puts $outfile $code
- close $outfile
-
- switch -- $::tcl_platform(platform) {
- unix {
- if {[catch {exec lp -c $filename} msg]} {
- tk_messageBox -title "Print spooling failure" \
- -message "Print spooling probably failed: $msg"
- }
- }
- windows {
- if {[catch {PrintTextWin32 $filename} msg]} {
- tk_messageBox -title "Print spooling failure" \
- -message "Print spooling probably failed: $msg"
- }
- }
- default {
- tk_messageBox -title "Operation not Implemented" \
- -message "Wow! Unknown platform: $::tcl_platform(platform)"
- }
- }
-
- #
- # Be careful to throw away the temporary file in a gentle manner ...
- #
- if {[file exists $filename]} {
- catch {file delete $filename}
- }
-}
-
-# PrintTextWin32 --
-# Print a file under Windows using all the "intelligence" necessary
-#
-# Arguments:
-# filename - Name of the file
-#
-# Note:
-# Taken from the Wiki page by Keith Vetter, "Printing text files under
-# Windows".
-# Note:
-# Do not execute the command in the background: that way we can dispose of the
-# file smoothly.
-#
-proc PrintTextWin32 {filename} {
- package require registry
- set app [auto_execok notepad.exe]
- set pcmd "$app /p %1"
- catch {
- set app [registry get {HKEY_CLASSES_ROOT\.txt} {}]
- set pcmd [registry get \
- {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}]
- }
-
- regsub -all {%1} $pcmd $filename pcmd
- puts $pcmd
-
- regsub -all {\\} $pcmd {\\\\} pcmd
- set command "[auto_execok start] /min $pcmd"
- eval exec $command
+ tk print $w
}
# tkAboutDialog --
@@ -729,7 +658,8 @@ proc tkAboutDialog {} {
"[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}]
[mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}]
[mc "Copyright © %s" {2001-2009 Donal K. Fellows}]
-[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]"
+[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]
+[mc "Copyright © %s" {2021 Kevin Walzer}]"
}
# Local Variables:
diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg
index a93c4ec..c9ee256 100644
--- a/library/msgs/cs.msg
+++ b/library/msgs/cs.msg
@@ -75,3 +75,21 @@ namespace eval ::tk {
::msgcat::mcset cs "retry" "znovu"
::msgcat::mcset cs "yes" "ano"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset cs "Print" "Tisknout"
+ ::msgcat::mcset cs "Printer" "Tiskárna"
+ ::msgcat::mcset cs "Letter " "Dopis "
+ ::msgcat::mcset cs "Legal " "Legální "
+ ::msgcat::mcset cs "A4" "A4"
+ ::msgcat::mcset cs "Grayscale" "Stupně Šedi"
+ ::msgcat::mcset cs "RGB" "RGB"
+ ::msgcat::mcset cs "Options" "Možnosti"
+ ::msgcat::mcset cs "Copies" "Kopie"
+ ::msgcat::mcset cs "Paper" "Papír"
+ ::msgcat::mcset cs "Scale" "Škála"
+ ::msgcat::mcset cs "Orientation" "Orientace"
+ ::msgcat::mcset cs "Portrait" "Portrét"
+ ::msgcat::mcset cs "Landscape" "Krajina"
+ ::msgcat::mcset cs "Output" "Výstup"
+} \ No newline at end of file
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index 282f919..eb86516 100644
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
@@ -76,3 +76,21 @@ namespace eval ::tk {
::msgcat::mcset da "retry" "gentag"
::msgcat::mcset da "yes" "ja"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset da "Print" "Trykke"
+ ::msgcat::mcset da "Printer" "Printer"
+ ::msgcat::mcset da "Letter " "Brev"
+ ::msgcat::mcset da "Legal " "Juridisk"
+ ::msgcat::mcset da "A4" "A4"
+ ::msgcat::mcset da "Grayscale" "Gråtoneskala"
+ ::msgcat::mcset da "RGB" "Rgb"
+ ::msgcat::mcset da "Options" "Indstillinger"
+ ::msgcat::mcset da "Copies" "Kopier"
+ ::msgcat::mcset da "Paper" "Papir"
+ ::msgcat::mcset da "Scale" "Skalere"
+ ::msgcat::mcset da "Orientation" "Orientering"
+ ::msgcat::mcset da "Portrait" "Portræt"
+ ::msgcat::mcset da "Landscape" "Landskab"
+ ::msgcat::mcset da "Output" "Udskriv Publikation"
+} \ No newline at end of file
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 2cf25d2..fb4a8e7 100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
@@ -89,3 +89,21 @@ namespace eval ::tk {
::msgcat::mcset de "retry" "wiederholen"
::msgcat::mcset de "yes" "ja"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset de "Print" "Drucken"
+ ::msgcat::mcset de "Printer" "Drucker"
+ ::msgcat::mcset de "Letter " "Brief"
+ ::msgcat::mcset de "Legal " "Rechtlich"
+ ::msgcat::mcset de "A4" "A4"
+ ::msgcat::mcset de "Grayscale" "Graustufen"
+ ::msgcat::mcset de "RGB" "Rgb"
+ ::msgcat::mcset de "Options" "Optionen"
+ ::msgcat::mcset de "Copies" "Kopien"
+ ::msgcat::mcset de "Paper" "Papier"
+ ::msgcat::mcset de "Scale" "Skala"
+ ::msgcat::mcset de "Orientation" "Ausrichtung"
+ ::msgcat::mcset de "Portrait" "Porträt"
+ ::msgcat::mcset de "Landscape" "Landschaft"
+ ::msgcat::mcset de "Output" "Ausgabe"
+} \ No newline at end of file
diff --git a/library/msgs/el.msg b/library/msgs/el.msg
index 34f4aa7..7aa6246 100644
--- a/library/msgs/el.msg
+++ b/library/msgs/el.msg
@@ -84,3 +84,21 @@ namespace eval ::tk {
::msgcat::mcset el "retry" "προσπάθησε ξανά"
::msgcat::mcset el "yes" "ναι"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset el "Print" "Τυπώνω"
+ ::msgcat::mcset el "Printer" "Εκτυπωτής"
+ ::msgcat::mcset el "Letter " "Γράμμα"
+ ::msgcat::mcset el "Legal " "Νομικός"
+ ::msgcat::mcset el "A4" "Α4"
+ ::msgcat::mcset el "Grayscale" "Κλίμακα Του Γκρι"
+ ::msgcat::mcset el "RGB" "Rgb"
+ ::msgcat::mcset el "Options" "Επιλογές"
+ ::msgcat::mcset el "Copies" "Αντίγραφα"
+ ::msgcat::mcset el "Paper" "Χαρτί"
+ ::msgcat::mcset el "Scale" "Κλίμακα"
+ ::msgcat::mcset el "Orientation" "Προσανατολισμός"
+ ::msgcat::mcset el "Portrait" "Προσωπογραφία"
+ ::msgcat::mcset el "Landscape" "Τοπίο"
+ ::msgcat::mcset el "Output" "Έξοδος"
+} \ No newline at end of file
diff --git a/library/msgs/en.msg b/library/msgs/en.msg
index 5ad1094..3f0d988 100644
--- a/library/msgs/en.msg
+++ b/library/msgs/en.msg
@@ -89,3 +89,22 @@ namespace eval ::tk {
::msgcat::mcset en "retry"
::msgcat::mcset en "yes"
}
+
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset en "Print"
+ ::msgcat::mcset en "Printer"
+ ::msgcat::mcset en "Letter "
+ ::msgcat::mcset en "Legal "
+ ::msgcat::mcset en "A4"
+ ::msgcat::mcset en "Grayscale"
+ ::msgcat::mcset en "RGB"
+ ::msgcat::mcset en "Options"
+ ::msgcat::mcset en "Copies"
+ ::msgcat::mcset en "Paper"
+ ::msgcat::mcset en "Scale"
+ ::msgcat::mcset en "Orientation"
+ ::msgcat::mcset en "Portrait"
+ ::msgcat::mcset en "Landscape"
+ ::msgcat::mcset en "Output"
+}
diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg
index d285fb8..08dfc1e 100644
--- a/library/msgs/eo.msg
+++ b/library/msgs/eo.msg
@@ -73,3 +73,21 @@ namespace eval ::tk {
::msgcat::mcset eo "retry" "ripetu"
::msgcat::mcset eo "yes" "jes"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset eo "Print" "Presi"
+ ::msgcat::mcset eo "Printer" "Presilo"
+ ::msgcat::mcset eo "Letter " "Letero"
+ ::msgcat::mcset eo "Legal " "Laŭleĝa"
+ ::msgcat::mcset eo "A4" "A4"
+ ::msgcat::mcset eo "Grayscale" "Grizskalo"
+ ::msgcat::mcset eo "RGB" "RGB"
+ ::msgcat::mcset eo "Options" "Opcioj"
+ ::msgcat::mcset eo "Copies" "Kopioj"
+ ::msgcat::mcset eo "Paper" "Papero"
+ ::msgcat::mcset eo "Scale" "Skalo"
+ ::msgcat::mcset eo "Orientation" "Orientiĝo"
+ ::msgcat::mcset eo "Portrait" "Portreto"
+ ::msgcat::mcset eo "Landscape" "Pejzaĝo"
+ ::msgcat::mcset eo "Output" "Eligo"
+} \ No newline at end of file
diff --git a/library/msgs/es.msg b/library/msgs/es.msg
index f7082b8..724ea3b 100644
--- a/library/msgs/es.msg
+++ b/library/msgs/es.msg
@@ -74,3 +74,21 @@ namespace eval ::tk {
::msgcat::mcset es "retry" "reintentar"
::msgcat::mcset es "yes" "sí"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset es "Print" "Imprimir"
+ ::msgcat::mcset es "Printer" "Impresora"
+ ::msgcat::mcset es "Letter " "Carta"
+ ::msgcat::mcset es "Legal " "Legal"
+ ::msgcat::mcset es "A4" "A4"
+ ::msgcat::mcset es "Grayscale" "Escala De Grises"
+ ::msgcat::mcset es "RGB" "Rgb"
+ ::msgcat::mcset es "Options" "Opciones"
+ ::msgcat::mcset es "Copies" "Copias"
+ ::msgcat::mcset es "Paper" "Papel"
+ ::msgcat::mcset es "Scale" "Escama"
+ ::msgcat::mcset es "Orientation" "Orientación"
+ ::msgcat::mcset es "Portrait" "Retrato"
+ ::msgcat::mcset es "Landscape" "Paisaje"
+ ::msgcat::mcset es "Output" "Salida"
+} \ No newline at end of file
diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg
index cab8c50..0d3ef08 100644
--- a/library/msgs/fr.msg
+++ b/library/msgs/fr.msg
@@ -70,3 +70,21 @@ namespace eval ::tk {
::msgcat::mcset fr "retry" "réessayer"
::msgcat::mcset fr "yes" "oui"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset fr "Print" "Imprimer"
+ ::msgcat::mcset fr "Printer" "Imprimante"
+ ::msgcat::mcset fr "Letter " "Lettre"
+ ::msgcat::mcset fr "Legal " "Légal"
+ ::msgcat::mcset fr "A4" "A4"
+ ::msgcat::mcset fr "Grayscale" "Niveaux de Gris"
+ ::msgcat::mcset fr "RGB" "RVB"
+ ::msgcat::mcset fr "Options" "Options"
+ ::msgcat::mcset fr "Copies" "Nombre d'exemplaires"
+ ::msgcat::mcset fr "Paper" "Papier"
+ ::msgcat::mcset fr "Scale" "Échelle"
+ ::msgcat::mcset fr "Orientation" "Orientation"
+ ::msgcat::mcset fr "Portrait" "Portrait"
+ ::msgcat::mcset fr "Landscape" "Paysage"
+ ::msgcat::mcset fr "Output" "Sortie"
+} \ No newline at end of file
diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg
index 6d60cc6..5c1d929 100644
--- a/library/msgs/hu.msg
+++ b/library/msgs/hu.msg
@@ -76,3 +76,21 @@ namespace eval ::tk {
::msgcat::mcset hu "retry" "újra"
::msgcat::mcset hu "yes" "igen"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset hu "Print" "Nyomtat"
+ ::msgcat::mcset hu "Printer" "Nyomtató"
+ ::msgcat::mcset hu "Letter " "Levél"
+ ::msgcat::mcset hu "Legal " "Törvényes"
+ ::msgcat::mcset hu "A4" "A4"
+ ::msgcat::mcset hu "Grayscale" "Szürkeárnyalatos"
+ ::msgcat::mcset hu "RGB" "Rgb"
+ ::msgcat::mcset hu "Options" "Beállítások"
+ ::msgcat::mcset hu "Copies" "Másolatok"
+ ::msgcat::mcset hu "Paper" "Papír"
+ ::msgcat::mcset hu "Scale" "Hangsor"
+ ::msgcat::mcset hu "Orientation" "Tájékozódás"
+ ::msgcat::mcset hu "Portrait" "Portré"
+ ::msgcat::mcset hu "Landscape" "Táj"
+ ::msgcat::mcset hu "Output" "Hozam"
+} \ No newline at end of file
diff --git a/library/msgs/it.msg b/library/msgs/it.msg
index f6ad124..d7d9263 100644
--- a/library/msgs/it.msg
+++ b/library/msgs/it.msg
@@ -71,3 +71,21 @@ namespace eval ::tk {
::msgcat::mcset it "retry" "riprova"
::msgcat::mcset it "yes" "sì"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset it "Print" "Stampare"
+ ::msgcat::mcset it "Printer" "Stampante"
+ ::msgcat::mcset it "Letter " "Lettera"
+ ::msgcat::mcset it "Legal " "Legale"
+ ::msgcat::mcset it "A4" "A4"
+ ::msgcat::mcset it "Grayscale" "Scala Di Grigi"
+ ::msgcat::mcset it "RGB" "Rgb"
+ ::msgcat::mcset it "Options" "Opzioni"
+ ::msgcat::mcset it "Copies" "Copie"
+ ::msgcat::mcset it "Paper" "Carta"
+ ::msgcat::mcset it "Scale" "Scala"
+ ::msgcat::mcset it "Orientation" "Orientamento"
+ ::msgcat::mcset it "Portrait" "Ritratto"
+ ::msgcat::mcset it "Landscape" "Paesaggio"
+ ::msgcat::mcset it "Output" "Prodotto"
+} \ No newline at end of file
diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg
index fd0348b..b751824 100644
--- a/library/msgs/nl.msg
+++ b/library/msgs/nl.msg
@@ -89,3 +89,21 @@ namespace eval ::tk {
::msgcat::mcset nl "retry" "opnieuw"
::msgcat::mcset nl "yes" "ja"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset nl "Print" "Afdrukken"
+ ::msgcat::mcset nl "Printer" "Printer"
+ ::msgcat::mcset nl "Letter " "Brief"
+ ::msgcat::mcset nl "Legal " "Legaal"
+ ::msgcat::mcset nl "A4" "A4"
+ ::msgcat::mcset nl "Grayscale" "Grijswaarden"
+ ::msgcat::mcset nl "RGB" "Rgb"
+ ::msgcat::mcset nl "Options" "Opties"
+ ::msgcat::mcset nl "Copies" "Kopieën"
+ ::msgcat::mcset nl "Paper" "Papier"
+ ::msgcat::mcset nl "Scale" "Schub"
+ ::msgcat::mcset nl "Orientation" "Oriëntatie"
+ ::msgcat::mcset nl "Portrait" "Portret"
+ ::msgcat::mcset nl "Landscape" "Landschap"
+ ::msgcat::mcset nl "Output" "Uitvoer"
+} \ No newline at end of file
diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg
index f616397..d47b834 100644
--- a/library/msgs/pl.msg
+++ b/library/msgs/pl.msg
@@ -89,3 +89,21 @@ namespace eval ::tk {
::msgcat::mcset pl "retry" "ponów"
::msgcat::mcset pl "yes" "tak"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset pl "Print" "Drukować"
+ ::msgcat::mcset pl "Printer" "Drukarka"
+ ::msgcat::mcset pl "Letter " "Litera"
+ ::msgcat::mcset pl "Legal " "Legalny"
+ ::msgcat::mcset pl "A4" "A4"
+ ::msgcat::mcset pl "Grayscale" "Skala Szarości"
+ ::msgcat::mcset pl "RGB" "Rgb"
+ ::msgcat::mcset pl "Options" "Opcje"
+ ::msgcat::mcset pl "Copies" "Kopie"
+ ::msgcat::mcset pl "Paper" "Papier"
+ ::msgcat::mcset pl "Scale" "Skala"
+ ::msgcat::mcset pl "Orientation" "Orientacja"
+ ::msgcat::mcset pl "Portrait" "Portret"
+ ::msgcat::mcset pl "Landscape" "Krajobraz"
+ ::msgcat::mcset pl "Output" "Produkt Wyjściowy"
+} \ No newline at end of file
diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg
index 91c7f7a..d4fdfea 100644
--- a/library/msgs/pt.msg
+++ b/library/msgs/pt.msg
@@ -72,3 +72,21 @@ namespace eval ::tk {
::msgcat::mcset pt "retry" "tentar novamente"
::msgcat::mcset pt "yes" "sim"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset pt "Print" "Imprimir"
+ ::msgcat::mcset pt "Printer" "Impressora"
+ ::msgcat::mcset pt "Letter " "Letra"
+ ::msgcat::mcset pt "Legal " "Legal"
+ ::msgcat::mcset pt "A4" "A4"
+ ::msgcat::mcset pt "Grayscale" "Escala De Cinza"
+ ::msgcat::mcset pt "RGB" "Rgb"
+ ::msgcat::mcset pt "Options" "Opções"
+ ::msgcat::mcset pt "Copies" "Exemplares"
+ ::msgcat::mcset pt "Paper" "Papel"
+ ::msgcat::mcset pt "Scale" "Escala"
+ ::msgcat::mcset pt "Orientation" "Orientação"
+ ::msgcat::mcset pt "Portrait" "Retrato"
+ ::msgcat::mcset pt "Landscape" "Paisagem"
+ ::msgcat::mcset pt "Output" "Saída"
+} \ No newline at end of file
diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg
index 3389ce8..bd7c7b2 100644
--- a/library/msgs/ru.msg
+++ b/library/msgs/ru.msg
@@ -73,3 +73,21 @@ namespace eval ::tk {
::msgcat::mcset ru "yes" "да"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset ru "Print" "Печатать"
+ ::msgcat::mcset ru "Printer" "Принтер"
+ ::msgcat::mcset ru "Letter " "Письмо"
+ ::msgcat::mcset ru "Legal " "Законный"
+ ::msgcat::mcset ru "A4" "A4"
+ ::msgcat::mcset ru "Grayscale" "Серый Масштаб"
+ ::msgcat::mcset ru "RGB" "Ргб"
+ ::msgcat::mcset ru "Options" "Параметры"
+ ::msgcat::mcset ru "Copies" "Копии"
+ ::msgcat::mcset ru "Paper" "Бумага"
+ ::msgcat::mcset ru "Scale" "Шкала"
+ ::msgcat::mcset ru "Orientation" "Ориентация"
+ ::msgcat::mcset ru "Portrait" "Портрет"
+ ::msgcat::mcset ru "Landscape" "Ландшафт"
+ ::msgcat::mcset ru "Output" "Выпуск"
+} \ No newline at end of file
diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg
index a1ef8c5..5858221 100644
--- a/library/msgs/sv.msg
+++ b/library/msgs/sv.msg
@@ -74,3 +74,21 @@ namespace eval ::tk {
::msgcat::mcset sv "retry" "försök igen"
::msgcat::mcset sv "yes" "ja"
}
+#localization of print terms by Kevin Walzer via Microsoft Translator
+namespace eval ::tk {
+ ::msgcat::mcset sv "Print" "Trycka"
+ ::msgcat::mcset sv "Printer" "Skrivare"
+ ::msgcat::mcset sv "Letter " "Brev"
+ ::msgcat::mcset sv "Legal " "Laglig"
+ ::msgcat::mcset sv "A4" "A4 (På 199"
+ ::msgcat::mcset sv "Grayscale" "Gråskala"
+ ::msgcat::mcset sv "RGB" "Rgb"
+ ::msgcat::mcset sv "Options" "Alternativ"
+ ::msgcat::mcset sv "Copies" "Kopior"
+ ::msgcat::mcset sv "Paper" "Papper"
+ ::msgcat::mcset sv "Scale" "Skala"
+ ::msgcat::mcset sv "Orientation" "Orientering"
+ ::msgcat::mcset sv "Portrait" "Porträtt"
+ ::msgcat::mcset sv "Landscape" "Landskap"
+ ::msgcat::mcset sv "Output" "Utdata"
+} \ No newline at end of file
diff --git a/library/print.tcl b/library/print.tcl
new file mode 100644
index 0000000..7820a5f
--- /dev/null
+++ b/library/print.tcl
@@ -0,0 +1,995 @@
+# print.tcl --
+
+# This file defines the 'tk print' command for printing of the canvas
+# widget and text on X11, Windows, and macOS. It implements an abstraction
+# layer that presents a consistent API across the three platforms.
+
+# Copyright © 2009 Michael I. Schwartz.
+# Copyright © 2021 Kevin Walzer/WordTech Communications LLC.
+# Copyright © 2021 Harald Oehlmann, Elmicron GmbH
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+namespace eval ::tk::print {
+ namespace import -force ::tk::msgcat::*
+
+ # makeTempFile:
+ # Create a temporary file and populate its contents
+ # Arguments:
+ # filename - base of the name of the file to create
+ # contents - what to put in the file; defaults to empty
+ # Returns:
+ # Full filename for created file
+ #
+ proc makeTempFile {filename {contents ""}} {
+ set f [file tempfile filename $filename]
+ try {
+ puts -nonewline $f $contents
+ return $filename
+ } finally {
+ close $f
+ }
+ }
+
+ if {[tk windowingsystem] eq "win32"} {
+ variable printer_name
+ variable copies
+ variable dpi_x
+ variable dpi_y
+ variable paper_width
+ variable paper_height
+ variable margin_left
+ variable margin_top
+ variable printargs
+ array set printargs {}
+
+ # Multiple utility procedures for printing text based on the
+ # C printer primitives.
+
+ # _set_dc:
+ # Select printer and set device context and other parameters
+ # for print job.
+ #
+ proc _set_dc {} {
+ variable printargs
+ variable printer_name
+ variable paper_width
+ variable paper_height
+ variable dpi_x
+ variable dpi_y
+ variable copies
+
+ #First, we select the printer.
+ _selectprinter
+
+ #Next, set values. Some are taken from the printer,
+ #some are sane defaults.
+
+ if {[info exists printer_name] && $printer_name ne ""} {
+ set printargs(hDC) $printer_name
+ set printargs(pw) $paper_width
+ set printargs(pl) $paper_height
+ set printargs(lm) 1000
+ set printargs(tm) 1000
+ set printargs(rm) 1000
+ set printargs(bm) 1000
+ set printargs(resx) $dpi_x
+ set printargs(resy) $dpi_y
+ set printargs(copies) $copies
+ set printargs(resolution) [list $dpi_x $dpi_y]
+ }
+ }
+
+ # _print_data
+ # This function prints multiple-page files, using a line-oriented
+ # function, taking advantage of knowing the character widths.
+ # Arguments:
+ # data - Text data for printing
+ # breaklines - If non-zero, keep newlines in the string as
+ # newlines in the output.
+ # font - Font for printing
+ proc _print_data {data {breaklines 1} {font ""}} {
+ variable printargs
+ variable printer_name
+
+ _set_dc
+
+ if {![info exists printer_name]} {
+ return
+ }
+
+ if {$font eq ""} {
+ _gdi characters $printargs(hDC) -array printcharwid
+ } else {
+ _gdi characters $printargs(hDC) -font $font -array printcharwid
+ }
+ set pagewid [expr {($printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx)}]
+ set pagehgt [expr {($printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy)}]
+ set totallen [string length $data]
+ set curlen 0
+ set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000}]
+
+ _opendoc
+ _openpage
+
+ while {$curlen < $totallen} {
+ set linestring [string range $data $curlen end]
+ if {$breaklines} {
+ set endind [string first "\n" $linestring]
+ if {$endind != -1} {
+ set linestring [string range $linestring 0 $endind]
+ # handle blank lines....
+ if {$linestring eq ""} {
+ set linestring " "
+ }
+ }
+ }
+
+ set result [_print_page_nextline $linestring \
+ printcharwid printargs $curhgt $font]
+ incr curlen [lindex $result 0]
+ incr curhgt [lindex $result 1]
+ if {$curhgt + [lindex $result 1] > $pagehgt} {
+ _closepage
+ _openpage
+ set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000}]
+ }
+ }
+
+ _closepage
+ _closedoc
+ }
+
+ # _print_file
+ # This function prints multiple-page files
+ # It will either break lines or just let them run over the
+ # margins (and thus truncate).
+ # The font argument is JUST the font name, not any additional
+ # arguments.
+ # Arguments:
+ # filename - File to open for printing
+ # breaklines - 1 to break lines as done on input, 0 to ignore newlines
+ # font - Optional arguments to supply to the text command
+ proc _print_file {filename {breaklines 1} {font ""}} {
+ set fn [open $filename r]
+ set data [read $fn]
+ close $fn
+ _print_data $data $breaklines $font
+ }
+
+ # _print_page_nextline
+ # Returns the pair "chars y"
+ # where chars is the number of characters printed on the line
+ # and y is the height of the line printed
+ # Arguments:
+ # string - Data to print
+ # pdata - Array of values for printer characteristics
+ # cdata - Array of values for character widths
+ # y - Y value to begin printing at
+ # font - if non-empty specifies a font to draw the line in
+ proc _print_page_nextline {string carray parray y font} {
+ upvar #0 $carray charwidths
+ upvar #0 $parray printargs
+
+ variable printargs
+
+ set endindex 0
+ set totwidth 0
+ set maxwidth [expr {
+ (($printargs(pw) - $printargs(rm)) / 1000) * $printargs(resx)
+ }]
+ set maxstring [string length $string]
+ set lm [expr {$printargs(lm) * $printargs(resx) / 1000}]
+
+ for {set i 0} {($i < $maxstring) && ($totwidth < $maxwidth)} {incr i} {
+ incr totwidth $charwidths([string index $string $i])
+ # set width($i) $totwidth
+ }
+
+ set endindex $i
+ set startindex $endindex
+
+ if {$i < $maxstring} {
+ # In this case, the whole data string is not used up, and we
+ # wish to break on a word. Since we have all the partial
+ # widths calculated, this should be easy.
+
+ set endindex [expr {[string wordstart $string $endindex] - 1}]
+ set startindex [expr {$endindex + 1}]
+
+ # If the line is just too long (no word breaks), print as much
+ # as you can....
+ if {$endindex <= 1} {
+ set endindex $i
+ set startindex $i
+ }
+ }
+
+ set txt [string trim [string range $string 0 $endindex] "\r\n"]
+ if {$font ne ""} {
+ set result [_gdi text $printargs(hDC) $lm $y \
+ -anchor nw -justify left \
+ -text $txt -font $font]
+ } else {
+ set result [_gdi text $printargs(hDC) $lm $y \
+ -anchor nw -justify left -text $txt]
+ }
+ return "$startindex $result"
+ }
+
+ # These procedures read in the canvas widget, and write all of
+ # its contents out to the Windows printer.
+
+ variable option
+ variable vtgPrint
+
+ proc _init_print_canvas {} {
+ variable option
+ variable vtgPrint
+ variable printargs
+
+ set vtgPrint(printer.bg) white
+ }
+
+ proc _is_win {} {
+ variable printargs
+
+ return [info exist tk_patchLevel]
+ }
+
+ # _print_widget
+ # Main procedure for printing a widget. Currently supports
+ # canvas widgets. Handles opening and closing of printer.
+ # Arguments:
+ # wid - The widget to be printed.
+ # printer - Flag whether to use the default printer.
+ # name - App name to pass to printer.
+
+ proc _print_widget {wid {printer default} {name "Tk Print Output"}} {
+ variable printargs
+ variable printer_name
+
+ _set_dc
+
+ if {![info exists printer_name]} {
+ return
+ }
+
+ _opendoc
+ _openpage
+
+ # Here is where any scaling/gdi mapping should take place
+ # For now, scale so the dimensions of the window are sized to the
+ # width of the page. Scale evenly.
+
+ # For normal windows, this may be fine--but for a canvas, one
+ # wants the canvas dimensions, and not the WINDOW dimensions.
+ if {[winfo class $wid] eq "Canvas"} {
+ set sc [$wid cget -scrollregion]
+ # if there is no scrollregion, use width and height.
+ if {$sc eq ""} {
+ set window_x [$wid cget -width]
+ set window_y [$wid cget -height]
+ } else {
+ set window_x [lindex $sc 2]
+ set window_y [lindex $sc 3]
+ }
+ } else {
+ set window_x [winfo width $wid]
+ set window_y [winfo height $wid]
+ }
+
+ set printer_x [expr {
+ ( $printargs(pw) - $printargs(lm) - $printargs(rm) ) *
+ $printargs(resx) / 1000.0
+ }]
+ set printer_y [expr {
+ ( $printargs(pl) - $printargs(tm) - $printargs(bm) ) *
+ $printargs(resy) / 1000.0
+ }]
+ set factor_x [expr {$window_x / $printer_x}]
+ set factor_y [expr {$window_y / $printer_y}]
+
+ if {$factor_x < $factor_y} {
+ set lo $window_y
+ set ph $printer_y
+ } else {
+ set lo $window_x
+ set ph $printer_x
+ }
+
+ _gdi map $printargs(hDC) -logical $lo -physical $ph \
+ -offset $printargs(resolution)
+
+ # Handling of canvas widgets.
+ switch [winfo class $wid] {
+ Canvas {
+ _print_canvas $printargs(hDC) $wid
+ }
+ default {
+ puts "Can't print items of type [winfo class $wid]. No handler registered"
+ }
+ }
+
+ # End printing process.
+ _closepage
+ _closedoc
+ }
+
+ # _print_canvas
+ # Main procedure for writing canvas widget items to printer.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ proc _print_canvas {hdc cw} {
+ variable vtgPrint
+ variable printargs
+
+ # Get information about page being printed to
+ # print_canvas.CalcSizing $cw
+ set vtgPrint(canvas.bg) [string tolower [$cw cget -background]]
+
+ # Re-write each widget from cw to printer
+ foreach id [$cw find all] {
+ set type [$cw type $id]
+ if {[info commands _print_canvas.$type] eq "_print_canvas.$type"} {
+ _print_canvas.[$cw type $id] $printargs(hDC) $cw $id
+ } else {
+ puts "Omitting canvas item of type $type since there is no handler registered for it"
+ }
+ }
+ }
+
+ # These procedures support the various canvas item types, reading the
+ # information about the item on the real canvas and then writing a
+ # similar item to the printer.
+
+ # _print_canvas.line
+ # Description:
+ # Prints a line item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.line {hdc cw id} {
+ variable vtgPrint
+ variable printargs
+
+ set color [_print_canvas.TransColor [$cw itemcget $id -fill]]
+ if {[string match $vtgPrint(printer.bg) $color]} {
+ return
+ }
+
+ set coords [$cw coords $id]
+ set wdth [$cw itemcget $id -width]
+ set arrow [$cw itemcget $id -arrow]
+ set arwshp [$cw itemcget $id -arrowshape]
+ set dash [$cw itemcget $id -dash]
+ set smooth [$cw itemcget $id -smooth]
+ set splinesteps [$cw itemcget $id -splinesteps]
+
+ set cmdargs {}
+
+ if {$wdth > 1} {
+ lappend cmdargs -width $wdth
+ }
+ if {$dash ne ""} {
+ lappend cmdargs -dash $dash
+ }
+ if {$smooth ne ""} {
+ lappend cmdargs -smooth $smooth
+ }
+ if {$splinesteps ne ""} {
+ lappend cmdargs -splinesteps $splinesteps
+ }
+
+ set result [_gdi line $hdc {*}$coords \
+ -fill $color -arrow $arrow -arrowshape $arwshp \
+ {*}$cmdargs]
+ if {$result ne ""} {
+ puts $result
+ }
+ }
+
+ # _print_canvas.arc
+ # Prints a arc item.
+ # Args:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.arc {hdc cw id} {
+ variable vtgPrint
+ variable printargs
+
+ set color [_print_canvas.TransColor [$cw itemcget $id -outline]]
+ if {[string match $vtgPrint(printer.bg) $color]} {
+ return
+ }
+ set coords [$cw coords $id]
+ set wdth [$cw itemcget $id -width]
+ set style [$cw itemcget $id -style]
+ set start [$cw itemcget $id -start]
+ set extent [$cw itemcget $id -extent]
+ set fill [$cw itemcget $id -fill]
+
+ set cmdargs {}
+ if {$wdth > 1} {
+ lappend cmdargs -width $wdth
+ }
+ if {$fill ne ""} {
+ lappend cmdargs -fill $fill
+ }
+
+ _gdi arc $hdc {*}$coords \
+ -outline $color -style $style -start $start -extent $extent \
+ {*}$cmdargs
+ }
+
+ # _print_canvas.polygon
+ # Prints a polygon item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.polygon {hdc cw id} {
+ variable vtgPrint
+ variable printargs
+
+ set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]]
+ if {$fcolor eq ""} {
+ set fcolor $vtgPrint(printer.bg)
+ }
+ set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]]
+ if {$ocolor eq ""} {
+ set ocolor $vtgPrint(printer.bg)
+ }
+ set coords [$cw coords $id]
+ set wdth [$cw itemcget $id -width]
+ set smooth [$cw itemcget $id -smooth]
+ set splinesteps [$cw itemcget $id -splinesteps]
+
+ set cmdargs {}
+ if {$smooth ne ""} {
+ lappend cmdargs -smooth $smooth
+ }
+ if {$splinesteps ne ""} {
+ lappend cmdargs -splinesteps $splinesteps
+ }
+
+ _gdi polygon $hdc {*}$coords \
+ -width $wdth -fill $fcolor -outline $ocolor {*}$cmdargs
+ }
+
+ # _print_canvas.oval
+ # Prints an oval item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.oval {hdc cw id} {
+ variable vtgPrint
+
+ set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]]
+ if {$fcolor eq ""} {
+ set fcolor $vtgPrint(printer.bg)
+ }
+ set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]]
+ if {$ocolor eq ""} {
+ set ocolor $vtgPrint(printer.bg)
+ }
+ set coords [$cw coords $id]
+ set wdth [$cw itemcget $id -width]
+
+ _gdi oval $hdc {*}$coords \
+ -width $wdth -fill $fcolor -outline $ocolor
+ }
+
+ # _print_canvas.rectangle
+ # Prints a rectangle item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.rectangle {hdc cw id} {
+ variable vtgPrint
+
+ set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]]
+ if {$fcolor eq ""} {
+ set fcolor $vtgPrint(printer.bg)
+ }
+ set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]]
+ if {$ocolor eq ""} {
+ set ocolor $vtgPrint(printer.bg)
+ }
+ set coords [$cw coords $id]
+ set wdth [$cw itemcget $id -width]
+
+ _gdi rectangle $hdc {*}$coords \
+ -width $wdth -fill $fcolor -outline $ocolor
+ }
+
+ # _print_canvas.text
+ # Prints a text item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.text {hdc cw id} {
+ variable vtgPrint
+ variable printargs
+
+ set color [_print_canvas.TransColor [$cw itemcget $id -fill]]
+ # if {"white" eq [string tolower $color]} {return}
+ # set color black
+ set txt [$cw itemcget $id -text]
+ if {$txt eq ""} {
+ return
+ }
+ set coords [$cw coords $id]
+ set anchr [$cw itemcget $id -anchor]
+
+ set bbox [$cw bbox $id]
+ set wdth [expr {[lindex $bbox 2] - [lindex $bbox 0]}]
+
+ set just [$cw itemcget $id -justify]
+
+ # Get the real canvas font info and create a compatible font,
+ # suitable for printer name extraction.
+ set font [font create {*}[font actual [$cw itemcget $id -font]]]
+
+ # Just get the name and family, or some of the _gdi commands will
+ # fail.
+ set font [list [font configure $font -family] \
+ -[font configure $font -size]]
+
+ _gdi text $hdc {*}$coords \
+ -fill $color -text $txt -font $font \
+ -anchor $anchr -width $wdth -justify $just
+ }
+
+ # _print_canvas.image
+ # Prints an image item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.image {hdc cw id} {
+ # First, we have to get the image name.
+ set imagename [$cw itemcget $id -image]
+
+ # Now we get the size.
+ set wid [image width $imagename]
+ set hgt [image height $imagename]
+
+ # Next, we get the location and anchor
+ set anchor [$cw itemcget $id -anchor]
+ set coords [$cw coords $id]
+
+ _gdi photo $hdc -destination $coords -photo $imagename
+ }
+
+ # _print_canvas.bitmap
+ # Prints a bitmap item.
+ # Arguments:
+ # hdc - The printer handle.
+ # cw - The canvas widget.
+ # id - The id of the canvas item.
+ proc _print_canvas.bitmap {hdc cw id} {
+ variable option
+ variable vtgPrint
+
+ # First, we have to get the bitmap name.
+ set imagename [$cw itemcget $id -image]
+
+ # Now we get the size.
+ set wid [image width $imagename]
+ set hgt [image height $imagename]
+
+ #Next, we get the location and anchor.
+ set anchor [$cw itemcget $id -anchor]
+ set coords [$cw coords $id]
+
+ # Since the GDI commands don't yet support images and bitmaps,
+ # and since this represents a rendered bitmap, we CAN use
+ # copybits IF we create a new temporary toplevel to hold the beast.
+ # If this is too ugly, change the option!
+
+ if {[info exist option(use_copybits)]} {
+ set firstcase $option(use_copybits)
+ } else {
+ set firstcase 0
+ }
+ if {$firstcase > 0} {
+ set tl [toplevel .tmptop[expr {int( rand() * 65535 )}] \
+ -height $hgt -width $wid \
+ -background $vtgPrint(canvas.bg)]
+ canvas $tl.canvas -width $wid -height $hgt
+ $tl.canvas create image 0 0 -image $imagename -anchor nw
+ pack $tl.canvas -side left -expand false -fill none
+ tkwait visibility $tl.canvas
+ update
+ set srccoords [list 0 0 [expr {$wid - 1}] [expr {$hgt - 1}]]
+ set dstcoords [list [lindex $coords 0] [lindex $coords 1] [expr {$wid - 1}] [expr {$hgt - 1}]]
+ _gdi copybits $hdc -window $tl -client \
+ -source $srccoords -destination $dstcoords
+ destroy $tl
+ } else {
+ _gdi bitmap $hdc {*}$coords \
+ -anchor $anchor -bitmap $imagename
+ }
+ }
+
+ # These procedures transform attribute setting from the real
+ # canvas to the appropriate setting for printing to paper.
+
+ # _print_canvas.TransColor
+ # Does the actual transformation of colors from the
+ # canvas widget to paper.
+ # Arguments:
+ # color - The color value to be transformed.
+ proc _print_canvas.TransColor {color} {
+ variable vtgPrint
+ variable printargs
+
+ switch [string toupper $color] {
+ $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)}
+ }
+ return $color
+ }
+
+ # Initialize all the variables once.
+ _init_print_canvas
+ }
+ #end win32 procedures
+
+ #begin X11 procedures
+
+ # 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.
+
+ if {[tk windowingsystem] eq "x11"} {
+ variable printcmd ""
+ variable printlist {}
+ variable choosepaper
+ variable chooseprinter {}
+ variable p
+
+ # _setprintenv
+ # Set the print environtment - print command, and list of printers.
+ # Arguments:
+ # none.
+
+ proc _setprintenv {} {
+ variable printcmd
+ variable printlist
+
+ #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] != -1} {
+ 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
+ }
+
+ # 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
+ }
+
+ #Build list of printers.
+ set printdata [exec lpstat -a]
+ foreach item [split $printdata \n] {
+ lappend printlist [lindex [split $item] 0]
+ }
+ }
+
+ # _print
+ # Main printer dialog. Select printer, set options, and
+ # fire print command.
+ # Arguments:
+ # w - widget with contents to print.
+ #
+
+ proc _print {w} {
+ variable printlist
+ variable printcmd
+ variable chooseprinter
+ variable printcopies
+ variable printorientation
+ variable choosepaper
+ variable color
+ variable p
+ variable zoomnumber
+
+ _setprintenv
+
+ set chooseprinter [lindex $printlist 0]
+
+ set p ._print
+ catch {destroy $p}
+
+ toplevel $p
+ wm title $p "Print"
+ wm resizable $p 0 0
+
+ frame $p.frame -padx 10 -pady 10
+ pack $p.frame -fill x -expand no
+
+ #The main dialog
+ frame $p.frame.printframe -padx 5 -pady 5
+ pack $p.frame.printframe -side top -fill x -expand no
+
+ label $p.frame.printframe.printlabel -text [mc "Printer"]
+ ttk::combobox $p.frame.printframe.mb \
+ -textvariable [namespace which -variable chooseprinter] \
+ -state readonly -values [lsort -unique $printlist]
+ pack $p.frame.printframe.printlabel $p.frame.printframe.mb \
+ -side left -fill x -expand no
+
+ bind $p.frame.printframe.mb <<ComboboxSelected>> {
+ set chooseprinter {$p.frame.printframe.mb get}
+ }
+
+ set paperlist [list [mc Letter] [mc Legal] [mc A4]]
+ set colorlist [list [mc Grayscale] [mc RGB]]
+
+ #Initialize with sane defaults.
+ set printcopies 1
+ set choosepaper [mc A4]
+ set color [mc RGB]
+ set printorientation portrait
+
+ set percentlist {100 90 80 70 60 50 40 30 20 10}
+
+ #Base widgets to load.
+ labelframe $p.frame.copyframe -text [mc "Options"] -padx 5 -pady 5
+ pack $p.frame.copyframe -fill x -expand no
+
+ frame $p.frame.copyframe.l -padx 5 -pady 5
+ pack $p.frame.copyframe.l -side top -fill x -expand no
+
+ label $p.frame.copyframe.l.copylabel -text [mc "Copies"]
+ spinbox $p.frame.copyframe.l.field -from 1 -to 1000 \
+ -textvariable [namespace which -variable printcopies] -width 5
+
+ pack $p.frame.copyframe.l.copylabel $p.frame.copyframe.l.field \
+ -side left -fill x -expand no
+
+ set printcopies [$p.frame.copyframe.l.field get]
+
+ frame $p.frame.copyframe.r -padx 5 -pady 5
+ pack $p.frame.copyframe.r -fill x -expand no
+
+ label $p.frame.copyframe.r.paper -text [mc "Paper"]
+ tk_optionMenu $p.frame.copyframe.r.menu \
+ [namespace which -variable choosepaper] \
+ {*}$paperlist
+
+ pack $p.frame.copyframe.r.paper $p.frame.copyframe.r.menu \
+ -side left -fill x -expand no
+
+ #Widgets with additional options for canvas output.
+ if {[winfo class $w] eq "Canvas"} {
+
+ frame $p.frame.copyframe.z -padx 5 -pady 5
+ pack $p.frame.copyframe.z -fill x -expand no
+
+ label $p.frame.copyframe.z.zlabel -text [mc "Scale"]
+ tk_optionMenu $p.frame.copyframe.z.zentry \
+ [namespace which -variable zoomnumber] \
+ {*}$percentlist
+
+ pack $p.frame.copyframe.z.zlabel $p.frame.copyframe.z.zentry \
+ -side left -fill x -expand no
+
+ frame $p.frame.copyframe.orient -padx 5 -pady 5
+ pack $p.frame.copyframe.orient -fill x -expand no
+
+ label $p.frame.copyframe.orient.text -text [mc "Orientation"]
+ radiobutton $p.frame.copyframe.orient.v -text [mc "Portrait"] \
+ -value portrait -compound left \
+ -variable [namespace which -variable printorientation]
+ radiobutton $p.frame.copyframe.orient.h -text [mc "Landscape"] \
+ -value landscape -compound left \
+ -variable [namespace which -variable printorientation]
+
+ pack $p.frame.copyframe.orient.text \
+ $p.frame.copyframe.orient.v $p.frame.copyframe.orient.h \
+ -side left -fill x -expand no
+
+ frame $p.frame.copyframe.c -padx 5 -pady 5
+ pack $p.frame.copyframe.c -fill x -expand no
+
+ label $p.frame.copyframe.c.l -text [mc "Output"]
+ tk_optionMenu $p.frame.copyframe.c.c \
+ [namespace which -variable color] \
+ {*}$colorlist
+ pack $p.frame.copyframe.c.l $p.frame.copyframe.c.c -side left \
+ -fill x -expand no
+ }
+
+ #Build rest of GUI.
+ frame $p.frame.buttonframe
+ pack $p.frame.buttonframe -fill x -expand no -side bottom
+
+ button $p.frame.buttonframe.printbutton -text [mc "Print"] \
+ -command [namespace code [list _runprint $w]]
+ button $p.frame.buttonframe.cancel -text [mc "Cancel"] \
+ -command {destroy ._print}
+
+ pack $p.frame.buttonframe.printbutton $p.frame.buttonframe.cancel \
+ -side right -fill x -expand no
+ #Center the window as a dialog.
+ ::tk::PlaceWindow $p
+ }
+
+ # _runprint -
+ # Execute the print command--print the file.
+ # Arguments:
+ # w - widget with contents to print.
+ #
+ proc _runprint {w} {
+ variable printlist
+ variable printcmd
+ variable choosepaper
+ variable chooseprinter
+ variable color
+ variable printcopies
+ variable printorientation
+ variable zoomnumber
+ variable p
+
+ #First, generate print file.
+
+ if {[winfo class $w] eq "Text"} {
+ set file [makeTempFile tk_text.txt [$w get 1.0 end]]
+ }
+
+ if {[winfo class $w] eq "Canvas"} {
+ if {$color eq [mc "RGB"]} {
+ set colormode color
+ } else {
+ set colormode gray
+ }
+
+ if {$printorientation eq "landscape"} {
+ set willrotate "1"
+ } else {
+ set willrotate "0"
+ }
+
+ #Scale based on size of widget, not size of paper.
+ set printwidth [expr {$zoomnumber / 100.00 * [winfo width $w]}]
+ set file [makeTempFile tk_canvas.ps]
+ $w postscript -file $file -colormode $colormode \
+ -rotate $willrotate -pagewidth $printwidth
+ }
+
+ #Build list of args to pass to print command.
+
+ set printargs {}
+ set printcopies [$p.frame.copyframe.l.field get]
+ if {$printcmd eq "lpr"} {
+ lappend printargs -P $chooseprinter -# $printcopies
+ } else {
+ lappend printargs -d $chooseprinter -n $printcopies
+ }
+
+ after 500
+ exec $printcmd {*}$printargs -o PageSize=$choosepaper $file
+
+ after 500
+ destroy ._print
+ }
+ }
+ #end X11 procedures
+
+ #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.
+ # outFilename - base for filename to write to; conventionally should
+ # have .pdf as suffix
+ # Returns:
+ # The full pathname of the generated PDF.
+ #
+ proc makePDF {inFilename outFilename} {
+ set out [::tk::print::makeTempFile $outFilename]
+ try {
+ exec /usr/sbin/cupsfilter $inFilename > $out
+ } trap NONE {msg} {
+ # cupsfilter produces a lot of debugging output, which we
+ # don't want.
+ regsub -all -line {^(?:DEBUG|INFO):.*$} $msg "" msg
+ set msg [string trimleft [regsub -all {\n+} $msg "\n"] "\n"]
+ if {$msg ne ""} {
+ # Lines should be prefixed with WARN or ERROR now
+ puts $msg
+ }
+ }
+ return $out
+ }
+ }
+ #end macOS Aqua procedures
+
+ namespace export canvas text
+ namespace ensemble create
+}
+
+# tk print --
+# This procedure prints the canvas and text widgets using platform-
+# native API's.
+# Arguments:
+# w: Widget to print.
+proc ::tk::print {w} {
+ switch [winfo class $w],[tk windowingsystem] {
+ "Canvas,win32" {
+ tailcall ::tk::print::_print_widget $w 0 "Tk Print Output"
+ }
+ "Canvas,x11" {
+ tailcall ::tk::print::_print $w
+ }
+ "Canvas,aqua" {
+ set psfile [::tk::print::makeTempFile tk_canvas.ps]
+ try {
+ $w postscript -file $psfile
+ set printfile [::tk::print::makePDF $psfile tk_canvas.pdf]
+ ::tk::print::_print $printfile
+ } finally {
+ file delete $psfile
+ }
+ }
+
+ "Text,win32" {
+ tailcall ::tk::print::_print_data [$w get 1.0 end] 1 {Arial 12}
+ }
+ "Text,x11" {
+ tailcall ::tk::print::_print $w
+ }
+ "Text,aqua" {
+ set txtfile [::tk::print::makeTempFile tk_text.txt [$w get 1.0 end]]
+ try {
+ set printfile [::tk::print::makePDF $txtfile tk_text.pdf]
+ ::tk::print::_print $printfile
+ } finally {
+ file delete $txtfile
+ }
+ }
+
+ default {
+ return -code error -errorcode {TK PRINT CLASS_UNSUPPORTED} \
+ "widgets of class [winfo class $w] are not supported on\
+ this platform"
+ }
+ }
+}
+
+#Add this command to the tk command ensemble: tk print
+#Thanks to Christian Gollwitzer for the guidance here
+namespace ensemble configure tk -map \
+ [dict merge [namespace ensemble configure tk -map] \
+ {print ::tk::print}]
+
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/library/tk.tcl b/library/tk.tcl
index 952db30..2531e6a 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -503,6 +503,7 @@ if {$::tk_library ne ""} {
SourceLibFile listbox
SourceLibFile menu
SourceLibFile panedwindow
+ SourceLibFile print
SourceLibFile scale
SourceLibFile scrlbar
SourceLibFile spinbox
generated by cgit v0.12 at 2024-11-16 11:01:29 (GMT)