--- cheap-call-0.6c-25.1.99.tcl	Sun Jan 31 18:25:55 1999
+++ cheap-call-0.7e-25.1.99.tcl	Sun Jan 31 19:38:03 1999
@@ -8,10 +8,12 @@
 #
 # email: salmon@billiger-telefonieren.de
 
+# Export/Print added by Kurt Garloff, <kurt@garloff.de>
+
 package require http 2.0
 
 set stand "25.1.1999"
-set version "0.6c"
+set version "0.7e"
 
 set use_proxy nein
 set http_proxy www
@@ -29,11 +31,14 @@
 set font(2_small) "{courier 8}"
 set font(3_big) "{courier 10}"
 set font(3_small) "{courier 8}"
+set aus "alle Anbieter zeigen"; set auswahl($aus) 1
 set aus "nur Call-by-Call-Anbieter zeigen"; set auswahl($aus) 2
 set aus "nur \'echte\' Call-by-Call-Anbieter zeigen"; set auswahl($aus) 3
-set aus "alle Anbieter zeigen"; set auswahl($aus) 1
 set welche $aus;
 
+set lnln 80
+set pgln 66
+
 set tag(heute) today
 set tag(montags) Mon
 set tag(dienstags) Tue
@@ -107,8 +112,11 @@
     menu $base.menu.datei.m -tearoff 0
     $base.menu.datei.m add command -label "Einstellungen" \
 	-command proxy_config -underline 0 
+    $base.menu.datei.m add command -label "Export/Print" \
+	-command export -underline 1
     $base.menu.datei.m add command -label "Beenden" \
-	-command quit -underline 0
+	-command quit -accelerator q -underline 0
+    bind . q quit
 
     # Label Zeit&Tag
 
@@ -120,7 +128,7 @@
     listbox $base.list.right.cbox -yscroll "$base.list.cybar set" -xscroll "$base.list.right.cxbar set" -setgrid 1 -height 12 -font {courier 10}
     $base.list.right.cbox insert 0 "R20"  "R50" "Fern" "C" "D1" "D2" "Eplus" "Andorra" "Belgien" "Belgien, Antwerpen" "Belgien, Brüssel" "Belgien, Leuven" "Dänemark" "Estland" "Finnland" "Frankreich" "Frankreich, Paris" "Färöer Inseln" "Griechenland" "Großbritannien, Edinburgh" "Großbritannien, London (Außenbezirk)" "Großbritannien, London (Innenbezirk)" "Großbritannien" "Insel Man" "Irland" "Israel" "Italien" "Italien, Mailand" "Italien, Rom" "Jugoslawien" "Jugoslawien, Montenegro" "Jugoslawien, Serbien" "Kanada" "Kanalinseln" "Kroatien" "Lettland" "Liechtenstein" "Litauen" "Luxemburg" "Madeira" "Malta" "Mexico" "Niederlande" "Niederlande, Amsterdam" "Niederlande, Den Haag" "Niederlande, Rotterdam" "Niederländische Antillen" "Nordirland" "Norwegen" "Österreich, Wien" "Österreich" "Polen" "Portugal (mit Azoren)" "Rumänien" "Russische Föderation (westl. des 40. Längengrades)" "Russische Föderation, Moskau" "Russische Föderation, St. Petersburg" "Schweden" "Schweden, Stockholm" "Schweiz" "Schweiz, Zürich" "Slowakische Republik" "Slowenien" "Spanien" "Spanien, Barcelona" "Spanien, Bilbao" "Spanien, Gerona" "Spanien, Madrid" "Spanien, Mallorca" "Tschechische Republik" "Türkei" "USA" "USA, Alaska" "USA, Hawaii" "USA, toll-free" "Ungarn" "Vatikanstadt" "Weißrußland (Belarus)" "sonstige Länder"  
 
-    bind $base.list.right.cbox <Double-1> { set zone [selection get]; zeigen }
+    bind $base.list.right.cbox <Double-1> { zeigen }
     # Switch "Welche Anbieter zeigen"
 
     set m [tk_optionMenu $base.buttons2.anbieter welche \
@@ -164,7 +172,8 @@
 
     # Button Anzeigen
 
-    button $base.buttons2.anzeigen -text "Abfragen!" -command "zeigen" 
+    button $base.buttons2.anzeigen -text "Aktualisieren" -underline 0 -command "zeigen" 
+    bind . a zeigen
 
 
     # Menu Gebuehren
@@ -231,8 +240,8 @@
     pack $base.tariflabel $base.tariflabel2 -side top -fill x
     pack $base.menu.datei $base.menu.info -side left
     pack $base.menu.hilfe -side right
-    pack $base.buttons2.anbieter -side left
-    pack $base.buttons2.zeit $base.buttons2.tag $base.buttons2.text -side right
+    pack $base.buttons2.anzeigen -side left
+    pack $base.buttons2.anbieter $base.buttons2.zeit $base.buttons2.tag $base.buttons2.text -side right
 
     pack $base.tabelle.oben -side left
     pack $base.list.left -side left -fill both -expand 1
@@ -256,20 +265,32 @@
     }
 }
 
-proc zeigen {} {
-    global liste base use_proxy http_proxy http_proxy_port day time info tag zeit stand zone welche auswahl
+# Calc use_day and use_time
+
+proc evaldaytime {} {
+    global zeit tag time day
 
     if { $zeit($time) == "now"} {
-	scan [clock format [clock seconds] -format "%H"] "%d" use_time
+	uplevel { scan [clock format [clock seconds] -format "%H"] "%d" use_time }
     } else {
-	set use_time $zeit($time)
+	uplevel { set use_time $zeit($time) }
     }
 
     if { $tag($day) == "today"} {
-	set use_day [clock format [clock seconds] -format "%a"]
+	uplevel { set use_day [clock format [clock seconds] -format "%a"] }
     } else {
-	set use_day $tag($day)
+	uplevel { set use_day $tag($day) }
     }
+}
+
+# Show prices
+
+proc zeigen {} {
+    global liste base use_proxy http_proxy http_proxy_port day time info tag zeit stand zone welche auswahl
+
+    set zone [$base.list.right.cbox get active]
+    
+    evaldaytime
 
     if {$zone != "idletasks"} {
 	if {$info != "intern"} {
@@ -315,6 +336,234 @@
 	}
     }
 }
+
+# Fill String up to the specified length (or cut, if it's too long)
+
+proc strfill { str ln fillchar } {
+    upvar $str _str
+    set realln [string length $_str]
+    if {$realln >= $ln} {
+	set _str [string range $_str 0 [expr $ln - 1] ]
+    } else {
+	while {$realln < $ln} {
+	    append _str $fillchar
+	    incr realln
+	}
+    }
+    #puts "\"$_str\""
+}
+
+
+# Try to do an intelligent splitting of the line
+
+proc intelsplit { str1 str2 ln } {
+    upvar $str1 _str1
+    upvar $str2 _str2
+    set _str2 ""
+    #string trimright _str1
+    if { [string length $_str1] <= $ln } { strfill _str1 $ln " "; return }
+    set idx [expr $ln - 1]
+    if { [regexp " " [string index $_str1 $ln] ] } {
+	set _str2 [ string range $_str1 [expr $ln + 1] end ]
+	set _str1 [ string range $_str1 0 [expr $ln - 1] ]
+	#strfill _str1 $ln " "
+	return
+    }
+    while { $idx > 0 } {
+	set char [string index $_str1 $idx]
+	if { [regexp {[.; /-]} $char] } {
+	    set _str2 [ string range $_str1 [expr $idx + 1] end ]
+	    set _str1 [ string range $_str1 0 $idx ]
+	    strfill _str1 $ln " "
+	    return
+	}
+	incr idx -1
+    }
+    set _str2 [ string range $_str1 $ln end ]
+    set _str1 [ string range $_str1 0 [expr $ln - 1] ]
+}
+	    
+# Dialog when Export/Print is called
+
+proc exportdlg {} {
+    
+    toplevel .dlg -class Dialog
+    wm title .dlg "Exportieren/Drucken"
+    label .dlg.label1 -text "Dateiname/Drucker:"
+    entry .dlg.entry1 -width 40 -relief sunken -bd 2 -textvariable fn
+    label .dlg.label2 -text "Zeilenlänge (0 = unendl.):"
+    entry .dlg.entry2 -width 5 -relief sunken -bd 2 -textvariable lnln
+    label .dlg.label0 -text "Hinweis: Zum Drucken geben Sie hier den Namen Ihrer\nDruckerschnittstelle (z.B. \"PRN\" unter DOS/Win, \"/dev/lp0\" unter Un*x)\noder eine Pipeline zu Ihrem Druckprogramm an (z.B. \"| lpr -Pascii\").\nFalls eine Datei das angegebenen Namens existiert,\nwird diese überschrieben."
+    label .dlg.label3 -text "Papierlänge (0 = unendl.):"
+    entry .dlg.entry3 -width 5 -relief sunken -bd 2 -textvariable pgln
+    button .dlg.button1 -default normal -text "OK" -command "destroy .dlg"
+    bind .dlg <Return> "destroy .dlg"
+    button .dlg.button2 -text "Abbruch" -command { set fn ""; destroy .dlg }
+    pack .dlg.label0 .dlg.label1 .dlg.entry1 .dlg.label2 .dlg.entry2 .dlg.label3 .dlg.entry3 -side top -padx 3m -pady 3m -ipadx 2m -ipady 1m
+    pack .dlg.button2 .dlg.button1 -side left -expand 1 -padx 3m -pady 3m -ipadx 2m -ipady 1m
+    focus .dlg.entry1
+    #grab .dlg
+    tkwait window .dlg
+}
+
+# Build header
+
+proc updateheader { pgno } {
+    global tag2 zone version stand lnln welche auswahl
+    upvar head _head
+    upvar foot _foot
+    upvar use_day _use_day
+    upvar use_time _use_time
+    
+    set _sepline "|======="
+    strfill _sepline [expr $lnln - 1] "="
+    append _sepline "|\n"
+
+    set line "| "
+    if { $auswahl($welche) == 1 } { append line "Alle" } else {
+	if { $auswahl($welche) == 2 } { append line "C-b-C" } else {
+	    if { $auswahl($welche) == 3 } { append line "Echte CbC" } else {
+		append line "!ERROR!" }
+	}
+    }
+
+    append line " Tarife $tag2($_use_day) $_use_time.00 Uhr im Bereich $zone."
+    strfill line [expr $lnln - 6] " "
+    append line " S." $pgno
+    strfill line [expr $lnln - 1] " "
+    append line "|\n"
+    set _head "$_sepline$line$_sepline"
+    
+    set line "|Preis|Nummer|Betreiber         |Anmeldung    |Bemerkungen"
+    strfill line [expr $lnln - 1] " "
+    append line "|\n"
+    append _head $line
+
+    set line "|"
+    strfill line 6 "-"
+    append line "+"
+    strfill line 13 "-"
+    append line "+"
+    strfill line 32 "-"
+    append line "+"
+    strfill line 46 "-"
+    append line "+"
+    strfill line [expr $lnln - 1] "-"
+    append line "|"
+    
+    append _head $line
+    
+    set line "| Angaben in DM/min inkl. MWSt ohne Gewähr.  (Cheap-Call $version, $stand)"
+    strfill line [expr $lnln - 1] " "
+    append line "|\n"
+    set _foot "$_sepline$line$_sepline"
+}
+
+# Some vendors have too long names
+
+proc fixlongline { ln char max vend } {
+    upvar $ln line
+    upvar $vend betr
+    set char1 [expr $char-1]
+    set idx 0
+    
+    set charidx [ string index $line [expr $char+$idx] ]
+    set stridx [ string range $line [expr $char+$idx] [expr $char+$idx+3] ]
+    
+    if { $charidx == "0" || $stridx == "nein" || $stridx == "    " } { return }
+
+    while { $idx < $max } {
+	set charidx [ string index $line [expr $char+$idx] ]
+	set stridx [ string range $line [expr $char+$idx] [expr $char+$idx+3] ]
+	if { $charidx == "0" || $stridx == "nein" || $stridx == "    " } {
+	    append betr [string range $line $char [expr $char1+$idx]]
+	    set line1 [string range $line 0 $char1]
+	    set line2 [string range $line [expr $char+$idx] end]
+	    set line $line1
+	    append line $line2
+	    return
+	}
+	incr idx
+    }
+}	    
+
+# Show "Export/Print"
+
+proc export {} {
+    global liste base use_proxy http_proxy http_proxy_port day time info tag zeit stand zone welche auswahl tag2 version
+    global lnln fn pgln
+
+    evaldaytime
+
+    set fn "Tarif-$zone-$use_day-$use_time.txt"
+    regsub -all {[ ,;]} $fn _ fn
+
+    exportdlg 
+    if { $fn == "" } { return }
+    if { ![regexp {^[|>].*} $fn] } { regsub -all {[,;]} $fn _ fn }
+    if { $lnln == 0 } { set lnln 9999 }
+    if { $pgln == 0 } { set pgln 9999 }
+
+    #set fe [file exists $fn]
+    set fd [open $fn "w" "0664"]
+    #if {$fe != 0} {puts -nonewline $fd "\f"}
+
+    set pgno 1
+    updateheader $pgno
+    
+    puts $fd $head
+
+    set ln 8
+    set i 0
+    while {[set line [$base.list.left.box get $i $i] ] != ""} {
+	set cost [string range $line 1 7]
+	set cost [string trimright $cost]
+	strfill cost 5 0
+	set nr [string range $line 8 14]
+	strfill nr 6 " "
+	set betr [string range $line 15 49]
+        fixlongline line 50 14 betr
+	set betr [string trimright $betr]
+	intelsplit betr betr2 18
+	#strfill betr 20 " "
+	set anm [string range $line 50 68]
+	strfill anm 13 " "
+	set bem [string range $line 69 [expr [string length $line] - 2] ]
+	set bem [string trimright $bem]
+	intelsplit bem bem2 [expr $lnln - 48]
+
+	set entry "|$cost|$nr|$betr|$anm|$bem|\n"
+	set eln 1
+	while { "$betr2" != "" || "$bem2" != "" } {
+	    append entry "|     |      |"
+	    set betr $betr2 
+	    set bem $bem2
+	    intelsplit betr betr2 18
+	    intelsplit bem bem2 [expr $lnln - 48]
+	    append entry $betr "|             |" $bem "|\n"
+	    incr eln
+	}
+	
+	if {[expr $ln + $eln] <= $pgln} {
+	    puts -nonewline $fd $entry
+	    incr ln $eln
+	} else {
+	    set ln 8
+	    puts -nonewline $fd $foot
+	    incr pgno
+	    updateheader $pgno
+	    puts -nonewline $fd "\f"
+	    puts $fd $head
+	    puts -nonewline $fd $entry
+	    incr ln $eln
+	}
+	incr i
+    }
+    puts -nonewline $fd $foot
+    #puts -nonewline $fd "\f"
+    close $fd
+}
+
 
 # Show "Warnung"