#!/usr/bin/wish8.3
#############################################################################
# Visual Tcl v1.20 Project
#

#################################
# GLOBAL VARIABLES
#
global Bulle; 
global DialupRetrieval; 
global FaxReception; 
global Standalone; 
global VoiceReception; 
global device; 
global gui; 
global heap; 
global heaplist; 
global stat; 
global widget; 
    set widget(ModemMenu) {.top17.cpd21.03.04}
    set widget(faxnumlabel) {.top17.fra29.lab35}
    set widget(memcanvas) {.top17.fra29.can18}
    set widget(printdialog) {.top21}
    set widget(progresscanvas) {.top17.fra29.can20}
    set widget(radio4rings) {.top17.cpd21.03.04.men36}
    set widget(rev,.top17.cpd21.03.04) {ModemMenu}
    set widget(rev,.top17.cpd21.03.04.men36) {radio4rings}
    set widget(rev,.top17.fra22.but23) {stopbutton}
    set widget(rev,.top17.fra22.but28) {playbutton}
    set widget(rev,.top17.fra24.tex25) {text}
    set widget(rev,.top17.fra29.can18) {memcanvas}
    set widget(rev,.top17.fra29.can20) {progresscanvas}
    set widget(rev,.top17.fra29.lab33) {voicenumlabel}
    set widget(rev,.top17.fra29.lab35) {faxnumlabel}
    set widget(rev,.top21) {printdialog}
    set widget(stopbutton) {.top17.fra22.but23}
    set widget(text) {.top17.fra24.tex25}
    set widget(voicenumlabel) {.top17.fra29.lab33}

#################################
# USER DEFINED PROCEDURES
#
proc init {argc argv} {
#
# TkUsr v0.80
#
# Copyright (C) 1998-2003 Ludovic Drolez (ldrolez@free.fr)
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.       
#
# done:
# fax printing
# 
# todo: 
# save new, save all (with command line only option)
# save the size of the GUI
# progress for download
# stop the building of stats with one click (for the impatient)
# Built-in GSM decoding in Tcl ? (maybe on a K9 16GHz ?)
#
    global device stat gui heaplist

#
# modify the device name or init string if you want below
#
    set device(device) /dev/modem
    set device(initstring) "AT&H1&R2E0V1"    
    #set device(initstring) "ATI4"
    #set device(initstring) "ATE0V1"
    # set to 0 for non blocking IO: much faster but may hang
    set device(blocking) 0
#
# end of user modifyable settingd
#
    set device(buffer) {}
    set device(data) 0
    set device(dev) ""
    set device(lastreset) 0
    set device(auto) 0
    set device(binary) 0
    set device(test) 1
    set device(lastvaliddate) [clock seconds]
    # AT command to go to Self Mode
    set device(MCS) "+MCS"
    
    set stat(0) ""
    set stat(0.type) 2
    set stat(255.type) 2

    set gui(version) 0.80
    set gui(textback) lightgrey
    set gui(textfore) #A2FFAC

    # 
    set gui(print.to) "file"
    set gui(print.file) "fax.ps"
    set gui(print.command) "lpr -Plp"

    # variables which contain balloon help
    set gui(mem.balloon) ""
    set gui(voice.balloon) ""
    set gui(fax.balloon) ""
     
    set gui(play.img) {
	R0lGODlhDQAPAMIAAJSVlAAAAAD/Ff///////////////////yH+Dk1hZGUg
	d2l0aCBHSU1QACH5BAEKAAQALAAAAAANAA8AAAMuCLrUTiBICV6LIuf6sN5d
	8GkcJI6giZLqmg3eOrToTH/2/YZjfp07C2BAJFoaCQA7
    }
    set gui(stop.img) {
	R0lGODlhDQAPAMIAAJSVlAAAAI6Ojv////8AAP///////////yH+Dk1hZGUg
	d2l0aCBHSU1QACH5BAEKAAcALAAAAAANAA8AAAMoCLrM8TCKAQK5GM+a+7ad
	RoEh8ZXXiaolG7reiJryOgp4rlND7/+9BAA7
    }  
    set gui(newmess.img) {
	R0lGODlhCQAHAMIAAMXCxQCCAIOBgwD/AAA0Of///////////yH+Dk1hZGUg
	d2l0aCBHSU1QACH5BAEKAAcALAAAAAAJAAcAAAMWeBon+mGQBssI08VxMY2B
	5yzio2RPAgA7
    }
    set gui(oldmess.img) {
	R0lGODlhCQAHAMIAAMXCxQCCAIOBgwD/AAA0Of///////////yH5BAEKAAcA
	LAAAAAAJAAcAAAMWeCrHuoC0JwoQkgnABZ6bl1Gf84xKAgA7
    }
    image create photo play -data $gui(play.img)
    image create photo stop -data $gui(stop.img)
    image create photo newmess -data $gui(newmess.img)
    image create photo oldmess -data $gui(oldmess.img)

    # balloon bindings
    bind Bulle <Enter> {
	set mess $Bulle(%W)
	if {[string index $mess 0] == "&"} {
	    upvar #0 [string range $mess 1 end] var
	    set mess $var
	}
    
        set Bulle(set) 0
	set Bulle(first) 1
	set Bulle(id) [after 200 {balloon %W $mess %X %Y}]
    }

    bind Bulle <Button> {
	set Bulle(first) 0
	kill_balloon
    }

    bind Bulle <Leave> {
	set Bulle(first) 0
	kill_balloon
    }

    bind Bulle <Motion> {
	if {$Bulle(set) == 0} {
	    set mess $Bulle(%W)
	    if {[string index $mess 0] == "&"} {
		upvar #0 [string range $mess 1 end] var
		set mess $var
	    }
    	    after cancel $Bulle(id)
    	    set Bulle(id) [after 200 {balloon %W $mess %X %Y}]
	}
    }
    #
    if {$device(blocking)} {
	set device(maxbytes) 2
    } else {
	set device(maxbytes) 1024
    }

    # fax G3 decoding
    set heaplist { 1 105 2 93 3 55 4 37 5 27 6 24 7 22 8 21 -32768 9 10 16
  11 13 -1792 12 -1984 -2048 14 15 -2112 -2176 -2240 -2304 17 18
  -1856 -1920 19 20 -2368 -2432 -2496 -2560 -29 -30 23 -22 -45
  -46 25 -13 -23 26 -47 -48 28 34 29 31 -20 30 -33 -34 32 33
  -35 -36 -37 -38 35 -1 -19 36 -31 -32 38 48 39 42 -12 40 41
  -26 -53 -54 43 46 44 45 -39 -40 -41 -42 47 -21 -43 -44 49
  -10 50 52 -28 51 -61 -62 53 54 -63 0 -320 -384 56 75 57 65
  -11 58 59 61 -27 60 -59 -60 62 -18 63 64 -1472 -1536 -1600
  -1728 66 71 67 69 -24 68 -49 -50 70 -25 -51 -52 72 -192 73
  74 -55 -56 -57 -58 76 -2 77 82 -1664 78 79 80 -448 -512 81
  -640 -704 -768 83 89 84 86 -576 85 -832 -896 87 88 -960 -1024
  -1088 -1152 90 -256 91 92 -1216 -1280 -1344 -1408 94 100 95 97
  -3 96 -128 -8 98 -4 -9 99 -16 -17 101 104 -5 102 103 -64
  -14 -15 -6 -7 106 208 107 207 108 206 109 204 110 183 111
  158 112 125 -32768 113 114 120 115 117 -1792 116 -1984 -2048
  118 119 -2112 -2176 -2240 -2304 121 122 -1856 -1920 123 124
  -2368 -2432 -2496 -2560 126 142 127 133 -18 128 129 131 -52
  130 -640 -704 132 -55 -768 -832 134 139 135 137 -56 136 -1280
  -1344 138 -59 -1408 -1472 140 -24 -60 141 -1536 -1600 143 151
  144 147 -25 145 146 -320 -1664 -1728 148 149 -384 -448 150 -53
  -512 -576 152 -64 153 155 -54 154 -896 -960 156 157 -1024
  -1088 -1152 -1216 159 171 -13 160 161 167 162 164 -23 163 -50
  -51 165 166 -44 -45 -46 -47 168 -16 169 170 -57 -58 -61 -256
  172 -14 173 177 -17 174 175 176 -48 -49 -62 -63 178 181 179
  180 -30 -31 -32 -33 182 -22 -40 -41 184 185 -10 -11 186 -12
  187 194 -15 188 189 192 190 191 -128 -192 -26 -27 193 -19 -28
  -29 195 201 196 198 -20 197 -34 -35 199 200 -36 -37 -38 -39
  202 0 -21 203 -42 -43 205 -7 -9 -8 -6 -5 -1 -4 -3 -2
    }

    # force default colors
    option add *Background		#d9d9d9
    option add *Foreground		black
    option add *activeBackground	#ececec
    option add *activeForeground	black
    option add *selectColor		#b03060
    option add *selectBackground	#c3c3c3
    option add *troughColor		#c3c3c3
    option add *disabledForeground	#a3a3a3
}

init $argc $argv


proc {ByteStuff} {data} {
#
# Escape DLE (0x10) codes from data:
#   DLE DLE <= DLE
#   DLE SUB(0x1A) <= DLE DLE
#   DLE ETX(0x03) = end of page
# 
# I: data: data to decode
# R: escaped data
#
    set out ""
    while 1 {
	set id [string first "\x10" $data]
	if {$id == -1} break
	append out [string range $data 0 [expr $id - 1]]
	set nextchar [string index $data [expr $id+1]]
	set data [string range $data [expr $id+2] end]
	switch $nextchar {
	    "\x10" { append out \x10\x1A }
	    default { append out \x10\x10$nextchar }
	}
    }
    # add end of data
    append out $data\x10\x03
    
    return $out
}

proc {ByteUnstuff} {data array} {
#
# Unescape DLE (0x10) codes from data:
#   DLE DLE => DLE
#   DLE SUB(0x1A) => DLE DLE
#   DLE ETX(0x03) = end of page, the data is put in another hash
# 
# I: data: data to decode
# O: array: contains one or more pages of data (array(1), array(2)...)
# R: number of pages 
#
    upvar $array adata

    set numpage 1
    set out ""
    while 1 {
	set id [string first "\x10" $data]
	if {$id == -1} break
	append out [string range $data 0 [expr $id - 1]]
	set nextchar [string index $data [expr $id+1]]
	set data [string range $data [expr $id+2] end]
	switch $nextchar {
	    "\x10" { append out \x10 }
	    "\x1A" { append out \x10\x10 }
	    "\x03" { set adata($numpage) $out
		    set out ""
		    incr numpage
		    # end of page 
	    }	    
	    default { append out \x10$nextchar }
	}
    }
	set adata($numpage) $out$data
	return $numpage
}

proc {CheckLockedDevice} {dev} {
#
# Try to check if the serial port is locked by another process
# returns: 1=locked   0=ok
#
    set locked 1

    set fid [open $dev {RDWR NONBLOCK}]
    fconfigure $fid -translation binary

    set i 0
    # the modem shound respond in less than 2 seconds
    while { $i < 25 } {
	if {($i == 0) || ($i == 10)} {
	    puts -nonewline $fid "AT\r\r"
	    flush $fid
	}
	set l [gets $fid]
	if {[regexp OK $l]} {set locked 0;break}  
	incr i
	after 100
    }
    close $fid

    return $locked
}

proc {ClearModem} {} {
#
# clear modem's memory
#
    global env widget gui
    
    set gui(status) "Clearing Memory..."
    # clear messages
    SendGetOK "AT+MEM\r"
    # reset the modem clock
    ModemClockReset
    # clear the text widget
    set gui(status) ""
    UIReload
}

proc {CloseModem} {} {
#
# save modem settings
#
    global device
    # save setings
    if {[info exists device(faxreception.changed)]} {
	if {$device(faxreception.changed)} {
	    SendGetOK "AT+MCF=$device(faxreception)\r"	    
	}
	if {$device(voicereception.changed)} {
	    SendGetOK "AT+MCV=$device(voicereception)\r"	    
	}
	if {$device(dialupretrieval.changed)} {
	    SendGetOK "AT+MCD=$device(dialupretrieval)\r"	    
	}
	if {$device(rings) != $device(rings.old)} {
	    SendGetOK "AT+MCR=$device(rings)\r"	    
	}
	# 
	if {$device(clockwasreset)} {
	    ModemClockReset
	}
	SendGetOK "AT$device(MCS)=$device(auto)\r"
    }
}

proc {DateFormat} {d h m} {
#
# 
#    
    global device
    
    if {($d != 255) && ($device(lastreset) != 0)} {
	set cl [clock scan "$d day $h hour $m minute" -base $device(lastreset)]
	# try to detect if the modem has been reset
	if {$cl > $device(lastvaliddate)} {
	    set device(lastvaliddate) 0
	    return "(invalid date)"
	}
	if {$cl <= [clock seconds]} {
	    set device(lastvaliddate) $cl
	    return [clock format $cl -format "%a %b %d %H:%M"]
	}
    } else {
	return "(unknown date)"
    }
}

proc {Debug} {debuglevel string} {
global gui
    
    if {$gui(debug) >= $debuglevel} {
	puts $string
    }
}

proc {DebugSetLevel} {level} {
global gui

    set gui(debug) $level
}

proc {FaxPrint} {w} {
#
# convert a fax to postscript
#
    global gui widget

    set w $gui(print.canvas)

    if {$gui(print.to) == "file"} {
	$w postscript -file $gui(print.file) -pagex 0.i -pagey 11.i -pageanchor nw -pagewidth 8i -pageheight 11i
    } else {
	# must have at least tcl8.3 to print to a channel ?
	set out [open "|$gui(print.command)" r+]
	$w postscript -channel $out -pagex 0.i -pagey 11.i -pageanchor nw -pagewidth 8i -pageheight 11i
	close $out
    }
    destroy $widget(printdialog)
}

proc {G3BuildCanvas} {{title {}}} {
#
# open a window and set up the canvas that will display the fax
#
    global gui

    set w [toplevel .top[clock clicks]]
    set c "$w.can"
    set gui(print.canvas) $c

    frame $w.grid
    frame $w.grid.bottom -relief raised
    scrollbar $w.hscroll -orient horiz -command "$c xview"
    scrollbar $w.vscroll -command "$c yview"
    canvas $c -relief sunken -borderwidth 2 -scrollregion {0 0 1728 1159}  -height 1159 -width 864 -xscrollcommand "$w.hscroll set"  -yscrollcommand "$w.vscroll set"
    button $w.lp -text Print -command {Window show $widget(printdialog)} -width 30
    button $w.quit -text Close -command "destroy $w" -width 30
    pack $w.grid -expand yes -fill both -padx 1 -pady 1
    grid rowconfig    $w.grid 0 -weight 1 -minsize 0
    grid columnconfig $w.grid 0 -weight 1 -minsize 0
    grid $c -padx 1 -in $w.grid -pady 1  -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
    grid $w.vscroll -in $w.grid -padx 1 -pady 1  -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
    grid $w.hscroll -in $w.grid -padx 1 -pady 1  -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
    grid $w.grid.bottom -in $w.grid -padx 1 -pady 1  -row 2 -column 0 -rowspan 1 -columnspan 2 -sticky ew

    grid $w.lp -in $w.grid.bottom -padx 1 -pady 1  -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
    grid $w.quit -in $w.grid.bottom -padx 1 -pady 1  -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news

    wm title $w $title
    
    tkwait visibility $w
    return $c
}

proc {G3CheckBit} {bitref binstream} {
upvar $bitref bit
    set i [string index $binstream $bit]
    incr bit
    return $i
}

proc {G3DecodeInit} {} {
global heap heaplist

    # transform the list in an array
    set i 0
    foreach { a b } $heaplist {
	set heap($i,0) $a
	set heap($i,1) $b
	incr i
    }
}

proc {G3Display} {stream canvas} {
## 1st version: directly translated from c (PIII 600MHz): 104 sec
## optimized version: 7.5 sec
## with creation of ppm files: 8 sec (no display) 9.5 (display)
## width/2: 10.1sec (no disp) 11.5 sec (disp)
    global heap
    
    #
    set o ""
    
    set w 1728
    set bandh 256
    set h 2560
    set count 0
    
    # 
    set pix(0) ""
    set pix(1) ""
    for {set i 0} {$i <= $w} {incr i} {
	append pix(0) "\xFF"
	append pix(1) "\x0"
    }
    # read the file and convert it to binary string
    binary scan $stream B* binstream
    set len [string length $binstream]
    set bit 0
    
    while {[G3CheckBit bit $binstream]} { }
    
    set linecnt 0
    set eolcnt 0
    
    while {$eolcnt < 5 && $linecnt < 2560} {
	
	while {![G3CheckBit bit $binstream]} {}
	set linelen 0
	set j 0
	
	set outbuf ""	
	while {1} {
	    set i $heap(0,$j)
	    while {$i > 0} {
		# checkbit inlined
		set i $heap($i,[string index $binstream $bit])
		incr bit
	    }
	    
	    if {$len <= $bit || $i == -32768}  break
	    set i [string trimleft $i -]
	    set k $i
	    
	    if {$k + $linelen > 1728} {
		set k [expr 1728 - $linelen]
	    }
	    # put ($k) white or black dots 
	    append outbuf [string range $pix($j) 1 $k]
	    incr linelen $k
	    if {$i < 64} {
		if {$j} {
		    set j 0
		} else {
		    set j 1
		}
	    }
	}
	if {$linelen == 0} {
	    incr eolcnt
	} else {
	    set eolcnt 0
	}
	
	# output 
	append o $outbuf
	# 
	if {$linelen < $w} {
	    append o [string range $pix(1) 1 [expr $w - $linelen]]
	}

	incr linecnt
	
	# show progress
	if {($linecnt % 40) == 0} {
	    set f [open "/tmp/tkusr.pgm" w]
	    puts $f "P5"
	    puts $f "$w 40"
	    puts $f "255"
	    puts $f $o
	    close $f

	    #
	    # exec cat /tmp/x.pgm | pgmtopbm | pbmtoxbm > /tmp/x.xbm
	    #
	    set im [image create photo]
	    $im read /tmp/tkusr.pgm
#	    set im [image create bitmap -file /tmp/x.xbm ]
#	    set im2 [image create photo]
#	    $im2 copy $im -subsample 2 2
	    $canvas create image 0 $linecnt -image $im -anchor sw
	    update
	    update idletasks
	    set o ""
	    file delete /tmp/tkusr.pgm
	}
	
    }
    if {$eolcnt} {
	set linecnt [expr $linecnt - $eolcnt]
    }    
    set h $linecnt
    
    return $o
}

proc {G3DisplayDiv2} {stream canvas} {
## 1st version: directly translated from c (PIII 600MHz): 104 sec
## optimized version: 7.5 sec
## with creation of ppm files: 8 sec (no display) 9.5 (display)
## width/2: 10.1sec (no disp) 11.5 sec (disp)
    global heap
    
    #
    set o ""
    
    set w 864
    set bandh 256
    set h 2560
    set count 0
    
    # 
    set pix(0) ""
    set pix(1) ""
    for {set i 0} {$i <= $w} {incr i} {
	append pix(0) "\xFF"
	append pix(1) "\x0"
    }
    # read the file and convert it to binary string
    binary scan $stream B* binstream
    set len [string length $binstream]
    set bit 0
    
    while {[G3CheckBit bit $binstream]} { }
    
    set linecnt 0
    set eolcnt 0
    
    while {$eolcnt < 5 && $linecnt < 2560} {
	
	while {![G3CheckBit bit $binstream]} {}
	set linelen 0
	set j 0
	
	set outbuf ""	
	while {1} {
	    set i $heap(0,$j)
	    while {$i > 0} {
		# checkbit inlined
		set i $heap($i,[string index $binstream $bit])
		incr bit
	    }
	    
	    if {$len <= $bit || $i == -32768}  break
	    set i [string trimleft $i -]
	    set k $i
	    
	    if {$k + $linelen > 1728} {
		set k [expr 1728 - $linelen]
	    }
	    # put ($k) white or black dots 
	    append outbuf [string range $pix($j) 1 [expr $k/2]]
	    if {($k % 2) == 1} {
		incr count
		if {$count == 2} {
		    append outbuf \x80
		    set count 0
		}
	    }
	    incr linelen $k
	    if {$i < 64} {
		if {$j} {
		    set j 0
		} else {
		    set j 1
		}
	    }
	}
	if {$linelen == 0} {
	    incr eolcnt
	} else {
	    set eolcnt 0
	}
	
	# output 
	append o $outbuf
	# 
	if {$linelen < $w} {
	    append o [string range $pix(1) 1 [expr $w - $linelen]]
	}

	incr linecnt
	
	# show progress
	if {($linecnt % 40) == 0} {
	    set f [open "/tmp/tkusr.pgm" w]
	    puts $f "P5"
	    puts $f "$w 40"
	    puts $f "255"
	    puts $f $o
	    close $f

	    #
	    # exec cat /tmp/x.pgm | pgmtopbm | pbmtoxbm > /tmp/x.xbm
	    #
	    set im [image create photo]
	    $im read /tmp/tkusr.pgm 
#	    set im [image create bitmap -file /tmp/x.xbm ]
#	    set im2 [image create photo]
#	    $im2 copy $im -subsample 2 2
	    $canvas create image 0 $linecnt -image $im -anchor sw
	    update
	    update idletasks
	    set o ""
	    file delete /tmp/tkusr.pgm
	}
	
    }
    if {$eolcnt} {
	set linecnt [expr $linecnt - $eolcnt]
    }    
    set h $linecnt
    
    return $o
}

proc {G3DisplayFD} {fd canvas} {
fconfigure $fd -translation binary
    set stream [read $fd]
    return [G3Display $stream $canvas]
}

proc {G3DisplayFDdiv2} {fd canvas} {
fconfigure $fd -translation binary
    set stream [read $fd]
    return [G3DisplayDiv2 $stream $canvas]
}

proc {G3LoadAndDisplay} {{mode {}}} {
#
    set name [tk_getOpenFile -defaultextension g3 ]
    if {$name == ""} return
    set fd [open $name]

    set c [G3BuildCanvas $name]
    if {$mode == "view2" } {
	G3DisplayFDdiv2 $fd  $c
    } else {
	G3DisplayFD $fd  $c
    }
    close $fd
}

proc {GetFax} {number {disp save}} {
#
# retreive a fax in g3 format, and view or save it
#
    global device stat

    # is it really a fax ?
    if {![info exists stat($number.type)]} {
	return
    }
    if {$stat($number.type) != 1} {
	return
    }
       
    set startpage $stat($number.page) 
    # download the 1st page
    set d [GetMemPage $startpage]
    set addr [expr $stat($number.hi)*256 + $stat($number.lo) + 2]

    set header [string range $d $addr [expr $addr+34]]
    set data [string range $d [expr $addr+34] end]
    # extract the data from the header
    binary scan $header cccccccca20cScS h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr
    set h_naddr [expr ($h_naddr + 0x10000) % 0x10000]
    set h_paddr [expr ($h_paddr + 0x10000) % 0x10000]
    foreach v {h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr} {
	Debug 3 "header $v: [set $v]"
    }

    # one or more pages ?
    if {$startpage == $h_npage} {
	# only one page
	set data [string range $data 0 [expr $h_naddr - 1]]
    } else {
	# get the following pages
	incr startpage
	while {$startpage <= $h_npage} {
	    set d [GetMemPage $startpage]
	    # remove the checksum
	    if {$h_npage == $startpage} {
		set end [expr $h_naddr - 1]
	    } else {
		set end end
	    }
	    append data [string range $d 2 $end]
	    incr startpage
	}
    }

    set pages(0) ""
    # decode the data and split into pages
    set num [ByteUnstuff $data pages]
    if { $disp == "save" } {
	# do we have 1 page or more ?
	if {$stat($number.sec) > 1} {
	    set ext .1.g3
	} else {
	    set ext .g3
	}
	# get the file name    
	set name [tk_getSaveFile -defaultextension g3 -initialfile "fax$number$ext"]
	if {$name != ""} {
	    # save one or more pages
	    for {set i 1} {$i <= $stat($number.sec)} {incr i} {
		regsub "\\.\[0-9]+\\.g3" $name ".$i.g3" name
		if {[catch {open $name w} f]} {
		    Debug 0 $f
		} else {
		    catch { puts -nonewline $f $pages($i) }
		    close $f  
		}
	    }
	}
    } else {
	# view one or more pages
	for {set i 1} {$i <= $stat($number.sec)} {incr i} {
	    set can [G3BuildCanvas "fax \#$number page $i/$stat($number.sec)"]
	    switch $disp {
		view { G3Display $pages($i) $can }
		default { G3DisplayDiv2 $pages($i) $can }
	    }
	}
    }
}

proc {GetLineCONNECT} {} {
#
# get data until the next 'CONNECT' or 'ERROR'
#
    global device
    
    set result {}
    set last ""
    set dlast $device(data)
    while {[string first "CONNECT" $last] && [string first "ERROR" $last]== -1} {
	if {[llength $device(buffer)] == 0} {
	    tkwait variable device(data)
	    set device(data) 0
	}
	set last [lindex $device(buffer) 0]
	set device(buffer) [lrange $device(buffer) 1 1000]
	if {$last != ""} {
	    lappend result $last
	}
	if {$last != ""} {
	    Debug 2 "$dlast>$last"
	}
    }
    return $result
}

proc {GetLineOK} {} {
#
# get data until the next 'OK' or 'ERROR'
#
    global device
    
    set result {}
    set last ""
    set dlast $device(data)
    while {[string first "OK" $last] && [string first "ERROR" $last]== -1} {
	if {[llength $device(buffer)] == 0} {
	    tkwait variable device(data)
	    set device(data) 0
	}
	set last [lindex $device(buffer) 0]
	set device(buffer) [lrange $device(buffer) 1 1000]
	if {$last != ""} {
	    lappend result $last
	}
	if {$last != ""} {
	    Debug 2 "$dlast>$last"
	}
    }
    return $result
}

proc {GetMemPage} {page} {
#
# get a memory page and cache it for fast retrieving
#
    global device gui

    set device(d) ""
    if {[info exists device(cache.$page)]} {
	return $device(cache.$page)
    }
    # download a page
    set device(binary) 1
    fconfigure $device(dev) -translation binary
    # get the page
    set device(data) 0
    Send "AT+MTP=$page\r"

    # wait for data 
    set gui(status) "Getting data..."
    tkwait variable device(data)
    set gui(status) ""
    set device(buffer) ""
#Debug 2 "##"
    # cache the page
    set device(cache.$page) $device(d)
    # cancel binary mode
    fconfigure $device(dev) -translation auto
    set device(binary) 0
    
    return $device(d)
}

proc {GetMess} {number} {
#
# retreive and save a message in GSM format
#
    global device stat

    # is it really a message ?
    if {![info exists stat($number.type)]} {
	return
    }
    if {$stat($number.type) != 2} {
	return
    }
    
    set startpage $stat($number.page) 
    # download the 1st page
    set d [GetMemPage $startpage]
    set addr [expr $stat($number.hi)*256 + $stat($number.lo) + 2]

    set header [string range $d $addr [expr $addr+34]]
    set data [string range $d [expr $addr+34] end]
    # extract the data from the header
    binary scan $header cccccccca20cScS h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr

    set h_naddr [expr ($h_naddr + 0x10000) % 0x10000]
    set h_paddr [expr ($h_paddr + 0x10000) % 0x10000]
    foreach v {h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr} {
	Debug 3 "header $v: [set $v]"
    }
    # one or more pages ?
    if {$startpage == $h_npage} {
	# only one page
	set data [string range $data 0 [expr $h_naddr - 1]]
    } else {
	# get the following pages
	incr startpage
	while {$startpage <= $h_npage} {
	    set d [GetMemPage $startpage]
	    # remove the checksum
	    if {$h_npage == $startpage} {
		set end [expr $h_naddr - 1]
	    } else {
		set end end
	    }
	    append data [string range $d 2 $end]
	    Debug 2 "datalen:[string length $data]" 
	    incr startpage
	}
    }

    # unstuff data, $num should always be 1
    set pages(0) ""
    set num [ByteUnstuff $data pages]
    # write the file
    set name [tk_getSaveFile -defaultextension .gsm -initialfile "message$number.gsm"]
    if {$name != ""} {
	set f [open $name w]
	puts -nonewline $f $pages(1)
	close $f  
    }
}

proc {GetModemFaxIDString} {} {
#
# query the fax id string 
#
    global device

    if {$device(faxidstring) == ""} {
	set device(faxidstring) [string trim [lindex [SendGetOK "AT+MFI?\r"] 0] \"]
	set device(faxidstring.changed) 0
    }
}

proc {GetModemOtherStats} {} {
#
# Get less important information
#
    global device Standalone FaxReception VoiceReception DialupRetrieval

    # number of rings before reply
    set device(rings) [lindex [SendGetOK "AT+MCR?\r"] 0]
    set device(rings.old) $device(rings)
    # 
    set device(dialupretrieval) [lindex [SendGetOK "AT+MCD?\r"] 0]
    set device(dialupretrieval.changed) 0
    set DialupRetrieval $device(dialupretrieval) 
    set device(faxreception) [lindex [SendGetOK "AT+MCF?\r"] 0]
    set device(faxreception.changed) 0
    set FaxReception $device(faxreception) 
    set device(voicereception) [lindex [SendGetOK "AT+MCV?\r"] 0]
    set device(voicereception.changed) 0
    set VoiceReception $device(voicereception)
    set device(controllocal) [lindex [SendGetOK "AT+MCL?\r"] 0]
    set device(controlmonitor) [lindex [SendGetOK "AT+MCM?\r"] 0]
}

proc {GetModemRetrievalPassword} {} {
#
# query the retrieval password 
#
    global device

    if {$device(retrievalpassword) == ""} {
	set device(retrievalpassword) [lindex [SendGetOK "AT+MCP?\r"] 0]
	set device(retrievalpassword.changed) 0
    }
}

proc {GetModemStats} {num} {
#
# Return a list containing informations for message 'num'
#
    set l [split [lindex [SendGetOK "AT+MSR=$num\r"] 0] , ]

    # check for garbage in the fax/phone id field
    if {$num != 0} {
	if { [string length [lindex $l 8]] != 20 } {
	    # garbage !!
	    Debug 2 "FaxId contains garbage !"
	    set l "[lrange $l 0 8] [lrange $l [expr [llength $l]-4] end ]" 
	}
    }
    return $l 
}

proc {GetModemVoiceDuration} {} {
#
# query max voice duration
#
    global device

    if {$device(voiceduration) == ""} {
	set device(voiceduration) [lindex [SendGetOK "AT+MVD?\r"] 0]
	set device(voiceduration.changed) 0
    }
}

proc {InitDevice} {dev} {
#
# open the device file and set callbacks
#
    global device
    
    set m "115200,n,8,1"
    if {$device(blocking)} {
	set device(dev) [open $dev {RDWR}]
    } else {
	set device(dev) [open $dev {RDWR NONBLOCK}]
    }

    fconfigure $device(dev) -mode $m -buffering none -translation auto -blocking $device(blocking)
    fileevent $device(dev) readable {Reader}
    set device(data) 0
    set test [fconfigure $device(dev) -mode]
    if {$test != $m} {
	# buggy tcl (RH6.1 6.2)
	tk_messageBox -icon error -title "Buggy Tcl" -type ok -message "
The serial test returned '$test'.

Your Tcl version seems to be bugged and this program is unable to
configure your serial port. (You're probably using RH6.1 or RH6.2)

You can use a 'stty' command to set serial port parameters or get
a static binary version of TkUsr at http://www.drolez.com/ .

Please report your Tcl version and distribution to <ldrolez@free.fr>"
	 
	exit
    }
}

proc {ModemClockReset} {} {
#
# Reset the modem's clock and save the current time to ~/.tkusrrc
#
    global env

    SendGetOK "AT+MCC\r"
    set sec [clock seconds]
    exec echo $sec > $env(HOME)/.tkusrrc
}

proc {ModemGetClock} {} {
#
# get the value of the modem's internal clock
#
    global device

    set clk [split [lindex [SendGetOK "AT+MCC?\r"] 0] ,]
    set d [ToDec [lindex $clk 0]]
    set h [ToDec [lindex $clk 1]]
    set m [ToDec [lindex $clk 2]]
    set s [ToDec [lindex $clk 3]]
    if {$d == 255} {
	set device(clockwasreset) 1 
	set device(clock) 0 
    } else {
	set device(clockwasreset) 0
	set device(clock) 0
	catch {
	    set device(clock) [expr $d*3600*24 + $h*3600 + $m*60 + $s]
	}
    }
}

proc {ModemRecordMessage} {id} {
#
# record a message with mic
#
# id=0: Outgoing message
#    1: Mem Full message
#
    global device widget gui
    
    Send "AT+MVR=$id\r"
    set gui(status) Recording...
    $widget(stopbutton) configure -state normal
    GetLineOK
    $widget(stopbutton) configure -state disabled
    set gui(status) ""
}

proc {ModemSendMessage} {id} {
#
# put a message in the modem memory
#
# id=0: Outgoing message
#    1: Mem Full message
#
    global device widget gui

    set name [tk_getOpenFile]
    if {$name == ""} {
	return
    }
    if {[catch {open $name r} fid]} {
	Debug 0 $fid
	return
    } else {
	set data [read $fid] 
	close $fid  
	# check that the file is GSM encoded
	set i1 [string index $data 0]
	set i2 [string index $data 33]
#binary scan $i1 c ii1
#binary scan $i2 c ii2
#puts "$i1 $ii1 $i2 $ii2"
	if {($i1 < "\xD0") || ($i2 < "\xD0") || ($i1 > "\xDF") || ($i2 > "\xDF")} {
	    tk_messageBox -type ok -message "The selected file is not GSM !\n\nUse 'sox' or 'toast' to make GSM files."	    
	    return
	}
	
	#puts [string length $data]
	# encode data
	set data [ByteStuff $data]
	#puts [string length $data]
	
	# check that it has less than 32KB
	# what is the real limit ? 32000 ? 32500 ? 32768 ?
	set data [string range $data 0 32500]
	
	set gui(status) Uploading...


	Send "AT+MVC=$id\r"
	GetLineCONNECT
	puts -nonewline $device(dev) $data
	GetLineOK

	set gui(status) ""
    }
}

proc {OpenModem} {} {
#
# initialise the modem and get settings 
#
    global device Standalone FaxReception VoiceReception DialupRetrieval
    
    SendGetOK "$device(initstring)\r"
    # query the modem type
    set type [lindex [SendGetOK "ATI3\r"] 0]
    # extract rom version
    set ver ""
    regexp {Rev. ([0-9]+\.[0-9]+)} $type trash ver
    if {[regexp -nocase pro $type]} {
	# professional message modem
	set device(MCS) "+MCA"
    } elseif {$ver >= 14.8} {
	set device(MCS) "+MCA"
    } else {
	if {![regexp -nocase message $type]} {
	    tk_messageBox -icon error -title "Unknown Modem" -type ok -message "
Your modem is not an USR/3COM Message modem, so please, do not blame me if TkUsr does not work.

If It works, report your modem's type to <ldrolez@free.fr>"
	}
    }
    
    # check if the modem is in SM
    set device(auto) [lindex [SendGetOK "AT$device(MCS)?\r"] 0]
    # fix this
    # set device(auto) 1
    set Standalone $device(auto) 
    # Go to SM
    SendGetOK "AT$device(MCS)=1\r"
    # show global stats
    UIUpdateGlobalStat
    # clock query
    ModemGetClock
}

proc {PlayMess} {num} {
#
# play a voice message
#
    global widget gui stat

    # is it really a message ?
    if {![info exists stat($num.type)] && ($num != 0) && ($num != 255)} {
	return
    }
    if {$stat($num.type) != 2} {
	return
    }
    Send "AT+MVP=$num\r"
    set gui(status) Playing...
    $widget(stopbutton) configure -state normal
    GetLineOK
    $widget(stopbutton) configure -state disabled
    set gui(status) ""
}

proc {Popup} {num x y} {
#
# contextual popup menu (on right click)
#
    global stat

    if {![info exists stat($num.type)]} {
	return
    } 

    catch { destroy .popup }
    menu .popup -tearoff 0

    
    switch $stat($num.type) {
	1 {
	    .popup add command -label "View Fax" -command "GetFax $num view"
	    .popup add command -label "View Fax (width/2)" -command "GetFax $num view2"
	    .popup add command -label "Save Fax" -command "GetFax $num"
	    .popup add command -label "Info (not yet)" -command {}
	}
	2 {
	    .popup add command -label "Play Message" -command "PlayMess $num"  
	    .popup add command -label "Save Message" -command "GetMess $num"
	    .popup add command -label "Info (not yet)" -command {}
	}
    }
    # build the menu
    tk_popup .popup $x $y
}

proc {ProgressBind} {canvas variable} {
#
#
#
    global gui
    trace variable $variable w "ProgressUpdate"
    set gui($variable.canvas) $canvas
    $canvas create rect 0 0 0 0 -fill #80FF80 -outline #80FF80 -width 0 -tags bar
    set h [$canvas cget -height] 
    set w [$canvas cget -width] 
    $canvas create text [expr $w/2+2] [expr $h/2+2] -text "" -fill black -tags text
}

proc {ProgressUpdate} {var index op} {
#
#
#
    global gui

    # 
    set el "${var}($index).canvas"
    set canvas $gui($el)
    set h [$canvas cget -height] 
    set w [$canvas cget -width] 
    set value $gui($index)
    $canvas coords bar 2 2 [expr (($value*($w))/100)+2] [expr $h+2]
    $canvas itemconfigure text -text "$value %"
}

proc {Quit} {} {
# Quit the app 
    CloseModem
    exit 0
}

proc {Reader} {} {
#
# the device's file event
#
    global device
    
    # are we in binary mode ?
    if {$device(binary)} {
	set ch [read $device(dev) $device(maxbytes)]
	append device(d) $ch
	set l [string length $device(d)]
	
	if {[string range $device(d) [expr $l-6] end] == "\x0d\x0aOK\x0d\x0a"} {
	    set device(d) [string range $device(d) 0 [expr $l-7]]
	    incr device(data)
	}
    } else {
	gets $device(dev) line
	lappend device(buffer) $line
	incr device(data)
    }
}

proc {Send} {str} {
#
# send a simple string to the modem
#
    global device
    
    Debug 2 "<$str"
    puts $device(dev) $str
}

proc {SendGetOK} {str} {
#
# send a simple string to the modem and wait for a response
#
    global device
    
    Debug 2 "<$str"
    puts $device(dev) $str
    after 100
    return [ GetLineOK ]
}

proc {SetModemFaxIDString} {id} {
#
# set the fax id string 
#
    global gui

    set gui(status) "Setting ID..."
    SendGetOK "AT+MFI=\"[string range $id 0 19]\"\r"
    set gui(status) ""
}

proc {SetModemRetrievalPassword} {pass} {
#
# set the retrieval password 
#
    global gui
    
    set gui(status) "Setting password..."
    SendGetOK "AT+MCP=[string range $pass 0 3]\r"
    set gui(status) ""
}

proc {SetModemVoiceDuration} {d} {
#
# set max voice duration 
#
    SendGetOK "AT+MVD=$d\r"
}

proc {ToDec} {str} {
#
# remove the heading '0' 
# to avoid the automatic octal to decimal conversion by Tcl
#
    set result ""
    if {[string index $str 0] == " "} {
	set result [string trim $str]
    } else {
	scan $str %d result
    }
    return $result
}

proc {UIReload} {} {
#
# update stats
#
    global widget

    # clear the text widget
    $widget(text) delete 0.0 end

    UIUpdateGlobalStat
    UIUpdateStat
}

proc {UISetFaxIDString} {} {
#
# show the UI to set modem's fax ID
#
    Window show .top19
    GetModemFaxIDString
}

proc {UISetPassword} {} {
#
# show the UI to set modem's retrieval password
#
    Window show .top18
    GetModemRetrievalPassword
}

proc {UISetVoiceDuration} {} {
#
# show the UI to set modem's max message duration
#
    Window show .top20
    GetModemVoiceDuration
}

proc {UIUpdateGlobalStat} {} {
global device gui

    if $device(test) return
    
    set stat0 [GetModemStats 0]
    
    #
    set device(mem) [ToDec [lindex $stat0 1]]
    set device(numvoice) [ToDec [lindex $stat0 2]]
    set device(numvoiceu) [ToDec [lindex $stat0 3]]
    set device(numfax) [ToDec [lindex $stat0 4]]
    set device(numfaxu) [ToDec [lindex $stat0 5]]
    # update global stats
    set gui(mem) 0
    catch {
	set gui(mem) [expr 100-$device(mem)]
    }
    set gui(mem.balloon) "Free memory: $gui(mem) %"
    set gui(voice) "$device(numvoice)"
    set gui(voice.balloon) "Stored voice messages: $gui(voice)
Unreleased voice messages $device(numvoiceu)"
    set gui(fax) "$device(numfax)"
    set gui(fax.balloon) "Stored fax messages: $gui(fax)
Unreleased fax messages $device(numfaxu)"
}

proc {UIUpdateStat} {} {
#
# update the text widget
#
    global device stat gui widget

    $widget(text) tag configure back0 -background $gui(textback)
    $widget(text) tag configure back1 -background $gui(textfore)
    $widget(text) tag configure foo -tabs "1.2c center 2.7c numeric 5c left 11.5c left 12.5c left"

    set vf 0
    catch { set vf [expr $device(numvoice) + $device(numfax)] }

    for {set i $vf} {$i >= 1} {incr i -1} {
	set line ""

	set st [GetModemStats $i]
	set mess [ToDec [lindex $st 0]]
	set type [ToDec [lindex $st 1]]
	if {$mess == ""} {
	    # problem => let's skip
	    continue
	}
	switch $type {
	    1	{set type fax}
	    2	{set type voice}
	    3	{set type data}
	    default	{set type unkown}
	}
	set sec  [ToDec [lindex $st 2]]
	set attr [ToDec [lindex $st 3]]
	set stats [ToDec [lindex $st 4]]
	if {$stats == 98} {
	    set stats OK
	}
	set days  [ToDec [lindex $st 5]]		
	set hour [ToDec [lindex $st 6]]
	set min  [ToDec [lindex $st 7]]
	set callid  [string trim [lindex $st 8]]
	
	# save all these stats in an array
	set t [list num type sec attr status day hour min callid page hi lo checksum]
	set j 0
	foreach s $st {
	    set stat($i.[lindex $t $j]) [ToDec $s]  
	    incr j
	}

	append line "$mess\t$type"
	if {$type == "voice"} {
	    append line "\t$sec sec "
	} else {
	    append line "\t$sec pages from '$callid'"
	}
        append line "\tat [DateFormat $days $hour $min]"
	set img oldmess 
	switch -- $attr {
	    255 {
		set img newmess
	    }
	    252 -
	    253 {
		set img oldmess 
	    }
	}
	append line "\t \n"
	$widget(text) insert 1.0 $line  [list back[expr $mess%2] foo]
	$widget(text) image create 1.[expr [string length $line]-1] -image $img
	$widget(text) insert 1.[string length $line] "\tstat:$stats"  [list back[expr $mess%2] foo]
	$widget(text) see end 
	#if {$i == 2} break
    }
    # add mouse bindings to the text widget
    bind $widget(text) <Button-1> { PlayMess [expr int([lindex [$widget(text) dump -mark current] 2])] } 
    bind $widget(text) <Button-3> { Popup [expr int([lindex [$widget(text) dump -mark current] 2])] %X %Y }

    # show other stats
    GetModemOtherStats
}

proc {balloon} {target message {cx 0} {cy 0}} {
##############################################################################
# balloon.tcl - procedures used by balloon help
#
# Copyright (C) 1996-1997 Stewart Allen
# 
# This is part of vtcl source code
# Adapted for general purpose by 
# Daniel Roche <dan@lectra.com>
# version 1.1 ( Dec 02 1998 ) 
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

##############################################################################
#
global Bulle
    
    if {$Bulle(first) == 1 } {
        set Bulle(first) 2
	if { $cx == 0 && $cy == 0 } {
	    set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
	    set y [expr [winfo rooty $target] + [winfo height $target] + 4]
	} else {
	    set x [expr $cx + 4]
	    set y [expr $cy + 4]
	}
        toplevel .balloon -bg black
        wm overrideredirect .balloon 1
        label .balloon.l  -text $message -relief flat  -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
        pack .balloon.l -side left -padx 1 -pady 1
        wm geometry .balloon +${x}+${y}
        set Bulle(set) 1
    }
}

proc {kill_balloon} {} {
global Bulle
    after cancel $Bulle(id)
    if {[winfo exists .balloon] == 1} {
        destroy .balloon
    }
    set Bulle(set) 0
}

proc {set_balloon} {target message} {
global Bulle
    set Bulle($target) $message
    bindtags $target "[bindtags $target] Bulle"
}

proc {main} {argc argv} {
#
# main proc
#
    global device gui widget env uimem

    #	
    G3DecodeInit
    #

    # set the debug level (0-2)
    DebugSetLevel 2
    # other lines to overcome VTcl's limitations
    $widget(ModemMenu) entryconfigure 1 -label "Standalone mode"
    $widget(ModemMenu) entryconfigure 2 -label "Fax reception"
    $widget(ModemMenu) entryconfigure 3 -label "Voice reception"
    $widget(ModemMenu) entryconfigure 6 -label "Dialup retrieval"
    # modify default values set by VTcl
    wm geometry .top17 ""
    wm title .top17 "TkUsr $gui(version)"
    # handle WM close event
    wm protocol .top17 WM_DELETE_WINDOW Quit
    # allow resize
    grid rowconfigure .top17 3 -weight 1
    grid columnconfigure .top17 0 -weight 1
    grid rowconfigure .top17.fra24 0 -weight 1
    grid columnconfigure .top17.fra24 0 -weight 1

    # progress indicator
    ProgressBind $widget(memcanvas) gui(mem)
    # balloon help
    set_balloon $widget(memcanvas) &gui(mem.balloon)
    set_balloon $widget(voicenumlabel) &gui(voice.balloon)
    set_balloon $widget(faxnumlabel) &gui(fax.balloon)

    if [CheckLockedDevice $device(device)] {
        tk_messageBox -icon error -title "Unknown Modem" -type ok -message "Cannot talk to your modem !

Your serial port seems to be locked by another process.

Kill programs accessing the serial port and run TkUsr."
	exit
    }
    InitDevice $device(device)
    catch { set device(lastreset) [exec cat $env(HOME)/.tkusrrc] }
    OpenModem

    # update the stats area
    if {$device(test) == 0} {
	UIUpdateStat
    }
}

proc {Window} {args} {
global vTcl
    set cmd [lindex $args 0]
    set name [lindex $args 1]
    set newname [lindex $args 2]
    set rest [lrange $args 3 end]
    if {$name == "" || $cmd == ""} {return}
    if {$newname == ""} {
        set newname $name
    }
    set exists [winfo exists $newname]
    switch $cmd {
        show {
            if {$exists == "1" && $name != "."} {wm deiconify $name; return}
            if {[info procs vTclWindow(pre)$name] != ""} {
                eval "vTclWindow(pre)$name $newname $rest"
            }
            if {[info procs vTclWindow$name] != ""} {
                eval "vTclWindow$name $newname $rest"
            }
            if {[info procs vTclWindow(post)$name] != ""} {
                eval "vTclWindow(post)$name $newname $rest"
            }
        }
        hide    { if $exists {wm withdraw $newname; return} }
        iconify { if $exists {wm iconify $newname; return} }
        destroy { if $exists {destroy $newname; return} }
    }
}

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $base passive
    wm geometry $base 200x200+0+0
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm withdraw $base
    wm title $base "vt.tcl"
    ###################
    # SETTING GEOMETRY
    ###################
}

proc vTclWindow.top17 {base} {
    if {$base == ""} {
        set base .top17
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -cursor hand2 
    wm focusmodel $base passive
    wm geometry $base 446x231+269+205
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base "TkUsr"
    frame $base.cpd21 \
        -borderwidth 2 -height 30 -relief raised -width 30 
    menubutton $base.cpd21.01 \
        -activeforeground black -anchor w -foreground black \
        -menu .top17.cpd21.01.02 -padx 4 -pady 3 -text File 
    menu $base.cpd21.01.02 \
        -activeforeground black -cursor {} -foreground black 
    $base.cpd21.01.02 add command \
        -command {G3LoadAndDisplay view} -label {View G3 file} 
    $base.cpd21.01.02 add command \
        -command {G3LoadAndDisplay view2} -label {View G3 file (width/2)} 
    $base.cpd21.01.02 add separator
    $base.cpd21.01.02 add command \
        -command UIReload -label {Update stats} 
    $base.cpd21.01.02 add separator
    $base.cpd21.01.02 add command \
        -command Quit -label Quit 
    menubutton $base.cpd21.05 \
        -activeforeground black -anchor w -foreground black \
        -menu .top17.cpd21.05.06 -padx 4 -pady 3 -text Help -width 4 
    menu $base.cpd21.05.06 \
        -activeforeground black -foreground black -tearoff 0 
    $base.cpd21.05.06 add command \
        \
        -command {tk_messageBox -type ok -message "TkUsr $gui(version)\n\n Copyright (C) 1998-2003 Ludovic Drolez <ldrolez@free.fr>\n\nLicensed under GNU GPL."} \
        -label About 
    menubutton $base.cpd21.03 \
        -activeforeground black -anchor w -foreground black \
        -menu .top17.cpd21.03.04 -padx 4 -pady 3 -text Modem 
    menu $base.cpd21.03.04 \
        -activeforeground black -cursor {} -foreground black 
    $base.cpd21.03.04 add checkbutton \
        -variable Standalone -command {set device(auto) $Standalone} \
        -label {Standalone mode} 
    $base.cpd21.03.04 add checkbutton \
        -variable FaxReception \
        -command {set device(faxreception) $FaxReception;set device(faxreception.changed) 1} \
        -label {Fax reception} 
    $base.cpd21.03.04 add checkbutton \
        -variable VoiceReception \
        -command {set device(voicereception) $VoiceReception;set device(voicereception.changed) 1} \
        -label {Voice reception} 
    $base.cpd21.03.04 add cascade \
        -menu .top17.cpd21.03.04.men36 -label {Answer After} 
    $base.cpd21.03.04 add separator
    $base.cpd21.03.04 add checkbutton \
        -variable DialupRetrieval \
        -command {set device(dialupretrieval) $DialupRetrieval;set device(dialupretrieval.changed) 1} \
        -label {Dialup retrieval} 
    $base.cpd21.03.04 add command \
        -command UISetPassword -label {Set Password} 
    $base.cpd21.03.04 add command \
        -command UISetFaxIDString -label {Set Fax ID String} 
    $base.cpd21.03.04 add command \
        -command UISetVoiceDuration -label {Set Max Message Duration} 
    $base.cpd21.03.04 add command \
        -command {SendGetOK "AT+MCW\r"} -label {Write Settings to NVRAM} 
    $base.cpd21.03.04 add separator
    $base.cpd21.03.04 add separator
    $base.cpd21.03.04 add command \
        -command ClearModem -label {Clear memory} 
    menu $base.cpd21.03.04.men36 \
        -activeforeground black -foreground black -tearoff 0 
    $base.cpd21.03.04.men36 add radiobutton \
        -value 3 -variable device(rings) -command {set device(rings) 3} \
        -label {3 rings} 
    $base.cpd21.03.04.men36 add radiobutton \
        -value 4 -variable device(rings) -command {set device(rings) 4} \
        -label {4 rings} 
    $base.cpd21.03.04.men36 add radiobutton \
        -value 5 -variable device(rings) -command {set device(rings) 5} \
        -label {5 rings} 
    $base.cpd21.03.04.men36 add radiobutton \
        -value 6 -variable device(rings) -command {set device(rings) 6} \
        -label {6 rings} 
    menubutton $base.cpd21.men19 \
        -activeforeground black -foreground black -menu .top17.cpd21.men19.m \
        -padx 4 -pady 3 -text Messages 
    menu $base.cpd21.men19.m \
        -activeforeground black -cursor {} -foreground black 
    $base.cpd21.men19.m add command \
        -command {PlayMess 0} -label {Play Outgoing Message} 
    $base.cpd21.men19.m add command \
        -command {PlayMess 255} -label {Play Mem Full Message} 
    $base.cpd21.men19.m add separator
    $base.cpd21.men19.m add command \
        -command {ModemSendMessage 0} -label {Upload Outgoing Message} 
    $base.cpd21.men19.m add command \
        -command {ModemSendMessage 1} -label {Upload Mem Full Message} 
    $base.cpd21.men19.m add command \
        -command {ModemRecordMessage 0} -label {Record Outgoing Message} 
    $base.cpd21.men19.m add command \
        -command {ModemRecordMessage 1} -label {Record Mem Full Message} 
    frame $base.fra22 \
        -borderwidth 2 -height 75 -width 125 
    button $base.fra22.but23 \
        -activeforeground black -borderwidth 1 \
        -command {Send " ";$widget(stopbutton) configure -state disabled} \
        -foreground black -image stop -padx 9 -pady 3 -state disabled 
    button $base.fra22.but28 \
        -activeforeground black -borderwidth 1 -foreground black -image play \
        -padx 9 -pady 3 -state disabled 
    frame $base.fra24 \
        -borderwidth 2 -height 75 -relief groove -width 125 
    text $base.fra24.tex25 \
        -background lightgrey -cursor hand2 -font { helvetica 12 } \
        -foreground black -height 10 -insertbackground black \
        -selectforeground #d9d9d9 -width 60 -wrap none \
        -yscrollcommand {.top17.fra24.scr26 set} 
    bind $base.fra24.tex25 <Button-1> {
        PlayMess [expr int([lindex [$widget(text) dump -mark current] 2])]
    }
    bind $base.fra24.tex25 <Button-3> {
        Popup [expr int([lindex [$widget(text) dump -mark current] 2])] %X %Y
    }
    scrollbar $base.fra24.scr26 \
        -borderwidth 1 -command {.top17.fra24.tex25 yview} -width 10 
    frame $base.fra29 \
        -borderwidth 1 -height 75 -relief sunken -width 125 
    label $base.fra29.lab30 \
        -activeforeground black -borderwidth 1 -foreground black -text Mem: 
    label $base.fra29.lab32 \
        -activeforeground black -borderwidth 1 -foreground black \
        -text {   Voice:} 
    label $base.fra29.lab33 \
        -activeforeground black -borderwidth 1 -foreground black \
        -relief sunken -text 0 -textvariable gui(voice) 
    label $base.fra29.lab34 \
        -activeforeground black -borderwidth 1 -foreground black \
        -text {   Fax:} 
    label $base.fra29.lab35 \
        -activeforeground black -borderwidth 1 -foreground black \
        -relief sunken -text 0 -textvariable gui(fax) 
    label $base.fra29.lab18 \
        -activeforeground black -borderwidth 1 -foreground black \
        -textvariable gui(status) 
    canvas $base.fra29.can18 \
        -borderwidth 1 -height 14 -insertbackground black -relief sunken \
        -selectforeground #d9d9d9 -width 48 
    canvas $base.fra29.can20 \
        -borderwidth 1 -height 14 -insertbackground black -relief raised \
        -selectforeground #d9d9d9 -width 100 
    ###################
    # SETTING GEOMETRY
    ###################
    grid columnconf $base 0 -weight 1
    grid rowconf $base 3 -weight 1
    grid $base.cpd21 \
        -in .top17 -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew 
    pack $base.cpd21.01 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side left 
    pack $base.cpd21.05 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side right 
    pack $base.cpd21.03 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side left 
    pack $base.cpd21.men19 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side left 
    grid $base.fra22 \
        -in .top17 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.fra22.but23 \
        -in .top17.fra22 -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 8 \
        -ipady 2 
    grid $base.fra22.but28 \
        -in .top17.fra22 -column 1 -row 0 -columnspan 1 -rowspan 1 -ipadx 8 \
        -ipady 2 
    grid $base.fra24 \
        -in .top17 -column 0 -row 3 -columnspan 1 -rowspan 1 -sticky nesw 
    grid columnconf $base.fra24 0 -weight 1
    grid rowconf $base.fra24 0 -weight 1
    grid $base.fra24.tex25 \
        -in .top17.fra24 -column 0 -row 0 -columnspan 1 -rowspan 1 \
        -sticky nesw 
    grid $base.fra24.scr26 \
        -in .top17.fra24 -column 1 -row 0 -columnspan 1 -rowspan 1 \
        -sticky nesw 
    grid $base.fra29 \
        -in .top17 -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky ew 
    grid columnconf $base.fra29 6 -weight 2
    grid $base.fra29.lab30 \
        -in .top17.fra29 -column 0 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.lab32 \
        -in .top17.fra29 -column 2 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.lab33 \
        -in .top17.fra29 -column 3 -row 0 -columnspan 1 -rowspan 1 -ipadx 4 
    grid $base.fra29.lab34 \
        -in .top17.fra29 -column 4 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.lab35 \
        -in .top17.fra29 -column 5 -row 0 -columnspan 1 -rowspan 1 -ipadx 4 
    grid $base.fra29.lab18 \
        -in .top17.fra29 -column 6 -row 0 -columnspan 1 -rowspan 1 -ipadx 4 
    grid $base.fra29.can18 \
        -in .top17.fra29 -column 1 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.can20 \
        -in .top17.fra29 -column 7 -row 0 -columnspan 1 -rowspan 1 -sticky e 
}

proc vTclWindow.top18 {base} {
    if {$base == ""} {
        set base .top18
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 171x55+307+247
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base "Set Retrieve Password"
    label $base.lab19 \
        -activeforeground black -borderwidth 1 -foreground black \
        -text Password: 
    entry $base.ent20 \
        -foreground black -insertbackground black -selectforeground #d9d9d9 \
        -textvariable device(retrievalpassword) -width 4 
    button $base.but21 \
        -activeforeground black \
        -command {SetModemRetrievalPassword $device(retrievalpassword);destroy .top18} \
        -foreground black -padx 9 -pady 3 -text Set -width 8 
    button $base.but22 \
        -activeforeground black -command {destroy .top18} -foreground black \
        -padx 9 -pady 3 -text Cancel -width 8 
    ###################
    # SETTING GEOMETRY
    ###################
    grid $base.lab19 \
        -in .top18 -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky e 
    grid $base.ent20 \
        -in .top18 -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.but21 \
        -in .top18 -column 0 -row 2 -columnspan 1 -rowspan 1 
    grid $base.but22 \
        -in .top18 -column 1 -row 2 -columnspan 1 -rowspan 1 -pady 4 
}

proc vTclWindow.top19 {base} {
    if {$base == ""} {
        set base .top19
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 222x56+421+203
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base "Set FaxID String"
    label $base.lab19 \
        -activeforeground black -borderwidth 1 -foreground black \
        -text {Fax ID:} 
    entry $base.ent20 \
        -foreground black -insertbackground black -selectforeground #d9d9d9 \
        -textvariable device(faxidstring) 
    button $base.but21 \
        -activeforeground black \
        -command {SetModemFaxIDString $device(faxidstring);destroy .top19} \
        -foreground black -padx 9 -pady 3 -text Set -width 11 
    button $base.but22 \
        -activeforeground black -command {destroy .top19} -foreground black \
        -padx 9 -pady 3 -text Cancel -width 11 
    ###################
    # SETTING GEOMETRY
    ###################
    grid $base.lab19 \
        -in .top19 -column 0 -row 0 -columnspan 2 -rowspan 1 -sticky w 
    grid $base.ent20 \
        -in .top19 -column 0 -row 0 -columnspan 2 -rowspan 1 -sticky e 
    grid $base.but21 \
        -in .top19 -column 0 -row 2 -columnspan 1 -rowspan 1 
    grid $base.but22 \
        -in .top19 -column 1 -row 2 -columnspan 1 -rowspan 1 -pady 4 
}

proc vTclWindow.top20 {base} {
    if {$base == ""} {
        set base .top20
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 170x56+329+203
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base "Set Max Voice Duration"
    label $base.lab19 \
        -activeforeground black -borderwidth 1 -foreground black \
        -text {Duration (in sec):} 
    entry $base.ent20 \
        -foreground black -insertbackground black -selectforeground #d9d9d9 \
        -textvariable device(voiceduration) -width 3 
    button $base.but21 \
        -activeforeground black \
        -command {SetModemVoiceDuration $device(voiceduration);destroy .top20} \
        -foreground black -padx 9 -pady 3 -text Set -width 8 
    button $base.but22 \
        -activeforeground black -command {destroy .top20} -foreground black \
        -padx 9 -pady 3 -text Cancel -width 8 
    ###################
    # SETTING GEOMETRY
    ###################
    grid $base.lab19 \
        -in .top20 -column 0 -row 0 -columnspan 2 -rowspan 1 -sticky w 
    grid $base.ent20 \
        -in .top20 -column 1 -row 0 -columnspan 2 -rowspan 1 -sticky e 
    grid $base.but21 \
        -in .top20 -column 0 -row 2 -columnspan 1 -rowspan 1 
    grid $base.but22 \
        -in .top20 -column 1 -row 2 -columnspan 1 -rowspan 1 -pady 4 
}

proc vTclWindow.top21 {base} {
    if {$base == ""} {
        set base .top21
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 287x104+339+394
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base "Print to..."
    frame $base.fra22 \
        -borderwidth 2 -height 75 -relief groove -width 125 
    label $base.fra22.lab23 \
        -activeforeground black -borderwidth 1 -foreground black \
        -text {Print command:} 
    entry $base.fra22.ent24 \
        -foreground black -insertbackground black -selectforeground #d9d9d9 \
        -textvariable gui(print.command) -width 15 
    label $base.fra22.lab25 \
        -activeforeground black -anchor e -borderwidth 1 -foreground black \
        -text File: 
    entry $base.fra22.ent26 \
        -foreground black -insertbackground black -selectforeground #d9d9d9 \
        -textvariable gui(print.file) -width 15 
    button $base.fra22.but27 \
        -activeforeground black -command {FaxPrint $gui(print.canvas)} -foreground black \
        -text Print 
    button $base.fra22.but28 \
        -activeforeground black -command {destroy $widget(printdialog)} \
        -foreground black -text Cancel 
    label $base.fra22.lab29 \
        -activeforeground black -borderwidth 1 \
        -font {Helvetica -12 {bold italic}} -foreground black \
        -text {Print to:} 
    radiobutton $base.fra22.rad30 \
        -activeforeground black -foreground black -text printer \
        -variable gui(print.to) -value "printer"
    radiobutton $base.fra22.rad31 \
        -activeforeground black -anchor e -foreground black -text file \
        -variable gui(print.to) -value "file"
    ###################
    # SETTING GEOMETRY
    ###################
    grid $base.fra22 \
        -in .top21 -column 0 -row 0 -columnspan 1 -rowspan 1 
    grid columnconf $base.fra22 0 -minsize 140
    grid columnconf $base.fra22 1 -minsize 140
    grid $base.fra22.lab23 \
        -in .top21.fra22 -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky e 
    grid $base.fra22.ent24 \
        -in .top21.fra22 -column 1 -row 1 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.fra22.lab25 \
        -in .top21.fra22 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky e 
    grid $base.fra22.ent26 \
        -in .top21.fra22 -column 1 -row 2 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.fra22.but27 \
        -in .top21.fra22 -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky ew 
    grid $base.fra22.but28 \
        -in .top21.fra22 -column 1 -row 4 -columnspan 1 -rowspan 1 -sticky ew 
    grid $base.fra22.lab29 \
        -in .top21.fra22 -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky e 
    grid $base.fra22.rad30 \
        -in .top21.fra22 -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.fra22.rad31 \
        -in .top21.fra22 -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky e 
}

Window show .
Window show .top17

main $argc $argv