+
−#----------------------------------------------------------------------------- 
+
−#  Project :  XPAN
+
−#  Modul   :  xpanel.tcl
+
−#----------------------------------------------------------------------------- 
+
−#  Copyright 2002 Texas Instruments Berlin, AG 
+
−#                 All rights reserved. 
+
−# 
+
−#                 This file is confidential and a trade secret of Texas 
+
−#                 Instruments Berlin, AG 
+
−#                 The receipt of or possession of this file does not convey 
+
−#                 any rights to reproduce or disclose its contents or to 
+
−#                 manufacture, use, or sell anything it may describe, in 
+
−#                 whole, or in part, without the specific written consent of 
+
−#                 Texas Instruments Berlin, AG. 
+
−#----------------------------------------------------------------------------- 
+
−#|  Purpose :	This modul provides the framework of the xPanel frontend and
+
−#              its main entry point.  
+
−#----------------------------------------------------------------------------- 
+
−
+
−
+
−#*==== CONSTANTS ===================================================*#
+
−set TEXT_DSPL_UPDATE  50
+
−set GRAPH_DSPL_UPDATE  50
+
−
+
−#*==== VARIABLES ===================================================*#
+
−# initial screen image
+
−set m_initscreen_img "initscreen.ppm" 
+
−set m_screen_img "screen.ppm" 
+
−set m_displ_type D
+
−set m_displtext "                            "
+
−set m_displwidth [expr 21*8]
+
−
+
−#*==== EXPORTS =====================================================*#
+
−# function for use in the c-backend:
+
−
+
−# proc set_initparams {x y w h wtitle} 
+
−#   .. send init-params which will be set by TCL (curr. initial size and window title) 
+
−# proc displ_update {} 
+
−#   .. updates display
+
−# proc load_prim {fname} 
+
−#   .. load primitives form a given file named -fname-, 
+
−#   if fname="" a file dialog will be provided
+
−# proc set_comm_mode {mode}
+
−#	.. set communication mode varibale for dialog
+
−# proc set_comport {port}
+
−# .. sets comport varibale for dialog
+
−#*==== IMPLEMENTATION ==============================================*#
+
−
+
−#foreach i [winfo child .] {
+
−#	catch {destroy $i}
+
−#}
+
−
+
−#------------------------------------------
+
−# create the frontend
+
−#------------------------------------------
+
−
+
−# ... the menu
+
−menu .menubar
+
−. config -menu .menubar
+
−foreach m {File Config Display Cmd} {
+
−  set $m [menu .menubar.m$m]
+
−  .menubar add cascade -label $m -menu .menubar.m$m
+
−}
+
−$File add command -label "Load Layout ..." -command {load_layout ""}
+
−$File add separator
+
−$File add command -label Exit -command {destroy .}
+
−$Config add checkbutton -variable m_setcomm \
+
−  -label "Configure test interface" -command {enable_setcomm $m_setcomm}
+
−set m_comm_menu1 [$Config add command -label "Change communication mode ..." -command {dlg_comm_mode}]
+
−set m_comm_menu2 [$Config add command -label "Reset test interface" -command {c_reset}]
+
−$Display add radio -variable m_displ_type -value T \
+
−  -label Text -command {c_setdispl T}
+
−$Display add radio -variable m_displ_type -value G \
+
−  -label Graphical -command {c_setdispl G}
+
−$Display add radio -variable m_displ_type -value D \
+
−  -label "\[Disabled\]" -command {c_setdispl D}
+
−$Display add separator 
+
−$Display add command -label "Zoom in" -command {c_zoom 1} 
+
−$Display add command -label "Zoom out" -command {c_zoom 0} 
+
−$Cmd add command -label "Input system primitive ..." -command input_prim  
+
−$Cmd add command -label "Load system primitives ..." -command {load_prim ""}
+
−$Cmd add separator
+
−$Cmd add command -label "Input AT command ..." -command input_at  
+
−$Cmd add command -label "Load AT commands ..." -command load_at
+
−
+
−# ... the frame
+
−frame .frame -relief flat 
+
−pack .frame -side top -fill y -anchor center
+
−
+
−catch {file copy -force $m_initscreen_img $m_screen_img}
+
−catch {file attributes $m_screen_img -readonly 0}
+
−
+
−# set tcl_traceExec 3
+
−
+
−#image create bitmap main_icon -file "xpan.bmp"
+
−#wm iconbitmap . main_icon 
+
−
+
−
+
−
+
−#------------------------------------------
+
−# define tcl functions
+
−#------------------------------------------
+
−
+
−############################################################
+
−# GUI RELATED FUNCTIONS
+
−############################################################
+
−
+
−
+
−############################################
+
−# load_layout                              #
+
−############################################
+
−# PURPOSE : called to load a new layout 
+
−#
+
−# PARAM: lo_fname ... name of layout file
+
−#
+
−# RETURNS:
+
−############################################
+
−proc load_layout {lo_fname} {
+
−  global m_initscreen_img
+
−  global m_displtext
+
−
+
−  if {$lo_fname == ""} {
+
−    set lo_fname [tk_getOpenFile -filetypes {{{"Layout-Files"} {*lo.tcl}}} \
+
−              -title "Please choose an Layout-File:"]
+
−  }
+
−
+
−  if {$lo_fname != ""} {
+
−    c_set_lofile $lo_fname
+
−
+
−    puts [format "loading layout from %s ..." $lo_fname]
+
−
+
−    # special layout
+
−    if {[winfo exists .keys]} {
+
−      foreach i [winfo child .keys] {
+
−      	catch {destroy $i}
+
−      }
+
−      catch {destroy .keys}
+
−    }
+
−    source $lo_fname
+
−    
+
−    # the "screen"
+
−    catch {image delete screen}
+
−    catch {destroy .frame.screen}
+
−    catch {image create photo screen -file $m_initscreen_img} 
+
−    if { [catch {label .frame.screen -image screen -font systemfixed \
+
−                 -background $DISPL_BG -foreground $DISPL_FG }] } {
+
−      label .frame.screen -text $m_displtext -font systemfixed \
+
−        -background $DISPL_BG -foreground $DISPL_FG 
+
−    }
+
−    pack .frame.screen -side top -anchor w
+
−  }
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# load_at                                  #
+
−############################################
+
−# PURPOSE : called to open a file containing
+
−#           AT-Command strings and execute 
+
−#           them 
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc load_at {} {
+
−  set fname [tk_getOpenFile -filetypes {{{"At-Command-Files"} {.atc}}} \
+
−              -title "Please choose an AT-Command-File:"]
+
−  
+
−  if {$fname != ""} {
+
−    set file [open $fname r]
+
−    while {![eof $file]} { 
+
−      c_exec_at [gets $file] 0
+
−    }
+
−    close $file
+
−  }
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# set_usart_config                         #
+
−############################################
+
−# PURPOSE : called to set the usart 
+
−#           configuration shown in the GUI
+
−#
+
−# PARAMS: port .. com port used
+
−#         baudrate ...
+
−#         flowctrl ... N,R,...
+
−#
+
−# RETURNS:
+
−############################################
+
−proc set_usart_config {port baudrate flowctrl} {
+
− 	global modeinput_dlg
+
−  set modeinput_dlg(port) $port
+
−  set modeinput_dlg(baudrate) $baudrate
+
−  set modeinput_dlg(flowctrl) $flowctrl
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# set_hostname                             #
+
−############################################
+
−# PURPOSE : called to set the hostname 
+
−#           shown in the GUI
+
−#
+
−# PARAMS: hostname ... host string
+
−#
+
−# RETURNS:
+
−############################################
+
−proc set_host {hostname} {
+
−  global modeinput_dlg
+
−  set modeinput_dlg(host) $hostname
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# enable_setcomm                           #
+
−############################################
+
−# PURPOSE : called to enable/disable setting
+
−#           of tst communication
+
−#
+
−# PARAMS:  enable ... 0 or 1
+
−#
+
−# RETURNS:
+
−############################################
+
−proc enable_setcomm {enable} {
+
−  global m_setcomm 
+
−
+
−  set m_setcomm $enable
+
−
+
−  c_enable_setcom $enable
+
−  if {$enable == 1} {
+
−    .menubar.mConfig entryconfigure 2 -state normal
+
−    .menubar.mConfig entryconfigure 3 -state normal
+
−    c_reset
+
−  } else {
+
−    .menubar.mConfig entryconfigure 2 -state disabled
+
−    .menubar.mConfig entryconfigure 3 -state disabled
+
−  }
+
−}
+
−#------------------------------------------
+
−
+
−
+
−
+
−############################################
+
−# set_comm_mode                            #
+
−############################################
+
−# PURPOSE : called to set the communication 
+
−#           mode shown in the GUI
+
−#
+
−# PARAMS: mode ... SOCKET, REAL, SIM
+
−#
+
−# RETURNS:
+
−############################################
+
−proc set_comm_mode {mode} {
+
−  global modeinput_dlg
+
−  set modeinput_dlg(mode) $mode
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# dlg_comm_mode                            #
+
−############################################
+
−# PURPOSE : called to show a dialog
+
−#           for communication settings
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc dlg_comm_mode {} {
+
−  global modeinput_dlg
+
−  set f .modeinput_dlg
+
−  if [Dialog_Create $f "Communication mode choice" -borderwidth 10] {
+
−    message $f.msg -text "Please select the mode to use:" -aspect 1000
+
−    set m [frame $f.modes]
+
−    radiobutton $m.radioSOCKET -text "Sockets " -variable modeinput_dlg(mode) \
+
−      -value SOCKET
+
−    radiobutton $m.radioREAL -text "USART (COM-port) " -variable modeinput_dlg(mode) \
+
−      -value REAL
+
−    radiobutton $m.radioSIM -text "USART (simulation)" -variable modeinput_dlg(mode) \
+
−      -value SIM
+
−    pack $m.radioSOCKET $m.radioREAL $m.radioSIM -side left -anchor n
+
−    set b [frame $f.buttons -borderwidth 5]
+
−    set s [frame $f.settings -relief sunken]
+
−    set x [frame $f.xtras]
+
−    checkbutton $x.check_pcon -text "Use PCON" -variable modeinput_dlg(pcon)
+
−    checkbutton $x.old_tstheader -text "Use old TST-Header" -variable modeinput_dlg(oldtst)
+
−    pack $x.check_pcon $x.old_tstheader -side left -anchor n 
+
−
+
−	  pack $f.msg -side top
+
−	  pack $f.modes -side top
+
−    pack $f.settings -side top 
+
−    pack $f.xtras -side top
+
−    pack $f.buttons -side bottom -anchor w
+
−
+
− 	  button $b.ok -text Ok -command {set modeinput_dlg(ok) 1} -default active
+
−    button $b.cancel -text Cancel \
+
−	    -command {set modeinput_dlg(ok) 0}
+
−  	pack $b.ok -side left
+
−	  pack $b.cancel -side right
+
−
+
−    foreach i [winfo child $f] {
+
−      foreach j [winfo child $i] {
+
−	  	  bind $j <Return> {set modeinput_dlg(ok) 1}
+
−  	  	bind $j <Escape> {set modeinput_dlg(ok) 0}
+
−      }
+
−   	  bind $i <Return> {set modeinput_dlg(ok) 1}
+
−    	bind $i <Escape> {set modeinput_dlg(ok) 0}
+
−    }
+
−	  bind $f <Return> {set modeinput_dlg(ok) 1}
+
−  	bind $f <Escape> {set modeinput_dlg(ok) 0}
+
−  }
+
−  # save old settings
+
−  set mode $modeinput_dlg(mode)
+
−  catch {set hostname $modeinput_dlg(host)}
+
−  catch {
+
−    set port $modeinput_dlg(port)
+
−    set baudrate $modeinput_dlg(baudrate)
+
−    set flowctrl $modeinput_dlg(flowctrl)
+
−  }
+
−
+
−  set s $f.settings
+
−	set modeinput_dlg(ok) -1
+
−
+
−  focus $f
+
−  catch {tkwait visibility $top}
+
−	catch {grab $f}
+
−  set oldmode {}
+
−  while {$modeinput_dlg(ok)==-1 && [winfo exists $f]} {
+
−    after 10
+
−    update 
+
−
+
−    if {$modeinput_dlg(mode) != $oldmode} {
+
−      foreach i [winfo child $s] {
+
−        catch {destroy $i}
+
−      }
+
−
+
−      switch $modeinput_dlg(mode) {
+
−		    SOCKET {
+
−          message $s.msg -text "Hostname:" -aspect 1000
+
−          entry $s.host -width 30 -textvariable modeinput_dlg(host)
+
−          pack $s.msg $s.host -side left -anchor w
+
−          message $s.msg2 -text "Port:" -aspect 1000
+
−	  	    entry $s.socket_port -width 5 -textvariable modeinput_dlg(socket_port)
+
−          pack $s.msg2 $s.socket_port -side left -anchor w
+
−		    }
+
−  	  	REAL {
+
−          message $s.msg -text "COM-Port:" -aspect 1000
+
−	  	    entry $s.comport -width 2 -textvariable modeinput_dlg(port)
+
−          pack $s.msg $s.comport -side left -anchor w
+
−          message $s.msg2 -text "Baudrate:" -aspect 1000
+
−	  	    entry $s.baudrate -width 8 -textvariable modeinput_dlg(baudrate)
+
−          pack $s.msg2 $s.baudrate -side left -anchor w
+
−          message $s.msg3 -text "Flowcontrol:" -aspect 1000
+
−	  	    entry $s.flowctrl -width 2 -textvariable modeinput_dlg(flowctrl)
+
−          pack $s.msg3 $s.flowctrl -side left -anchor w
+
−        }
+
−  	  	SIM {
+
−          checkbutton $s.checkSTX -text "STX" -variable modeinput_dlg(stx)
+
−          pack $s.checkSTX -side left -anchor w
+
−        }
+
−	    }
+
−      foreach j [winfo child $s] {
+
−	   	  bind $j <Return> {set modeinput_dlg(ok) 1}
+
−  	    bind $j <Escape> {set modeinput_dlg(ok) 0}
+
−      }
+
−      set oldmode $modeinput_dlg(mode)
+
−    }
+
−  }
+
−  if {![winfo exists $f]} {
+
−    set modeinput_dlg(ok) 0
+
−  }
+
−	catch {grab release $f}
+
−
+
−  Dialog_Dismiss $f
+
−  if {$modeinput_dlg(ok)==0} {
+
−    # restore old settings
+
−    set modeinput_dlg(mode) $mode 
+
−    catch {set modeinput_dlg(host) $hostname}
+
−    catch {
+
−      set modeinput_dlg(port) $port 
+
−      set modeinput_dlg(baudrate) $baudrate
+
−      set modeinput_dlg(flowctrl) $flowctrl
+
−    }
+
−    return
+
−  }
+
−  c_set_comm_mode $modeinput_dlg(mode) $modeinput_dlg(stx) 
+
−  switch $modeinput_dlg(mode) {
+
−    SOCKET { c_config_socket $modeinput_dlg(host) $modeinput_dlg(socket_port) }
+
−    REAL { c_config_usart $modeinput_dlg(port) $modeinput_dlg(baudrate) $modeinput_dlg(flowctrl) }
+
−    SIM { c_config_usart $modeinput_dlg(port) $modeinput_dlg(baudrate) $modeinput_dlg(flowctrl) }
+
−  }
+
−  c_setpcon $modeinput_dlg(pcon)
+
−  c_setoldtst $modeinput_dlg(oldtst)
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# input_at                                 #
+
−############################################
+
−# PURPOSE : called to show a dialog
+
−#           for input of at-command strings
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc input_at {} {
+
−	global atinput_dlg
+
−	set f .atinput_dlg
+
−	if [Dialog_Create $f "AT commands" -borderwidth 10] {
+
−		message $f.msg -text "Please input an AT command:" -aspect 1000
+
−		entry $f.entry -textvariable atinput_dlg(result)
+
−		set b [frame $f.buttons]
+
−		pack $f.msg $f.entry $f.buttons -side top -fill x
+
−		pack $f.entry -pady 5
+
−
+
−    checkbutton $f.check_raw -text "Use raw mode" -variable atinput_dlg(raw)
+
−    pack $f.check_raw -side left -anchor w
+
−
+
−		button $b.ok -text SEND -command {set atinput_dlg(ok) 1}
+
−		button $b.cancel -text Cancel \
+
−			-command {set atinput_dlg(ok) 0}
+
−		pack $b.ok -side left
+
−		pack $b.cancel -side right
+
−		bind $f.entry <Return> {set atinput_dlg(ok) 1 ; break}
+
−		bind $f.entry <Escape> {set atinput_dlg(ok) 0 ; break}
+
−	}
+
−	set atinput_dlg(ok) 0
+
−	Dialog_Wait $f atinput_dlg(ok) $f.entry
+
−	Dialog_Dismiss $f
+
−	if {$atinput_dlg(ok)} {
+
−    c_exec_at $atinput_dlg(result) $atinput_dlg(raw)
+
−	} 
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# load_prim                                #
+
−############################################
+
−# PURPOSE : called to open a file containing
+
−#           ATsystem primitives and execute 
+
−#           them 
+
−#
+
−# PARAMS: fname .. name of primitive file,
+
−#                  if empty -> dialog will 
+
−#                  be shown
+
−#
+
−# RETURNS:
+
−############################################
+
−proc load_prim {fname} {
+
−  if {$fname == ""} {
+
−    set fname [tk_getOpenFile -filetypes {{{"Primitive-Files"} {.pri}}} \
+
−              -title "Please choose an Primitive-File:"]
+
−  }
+
−
+
−  if {$fname != ""} {
+
−    set file [open $fname r]
+
−    if {![eof $file]} {
+
−      puts [format "executing primitives from %s ..." $fname]
+
−    }
+
−    while {![eof $file]} { 
+
−      set receiver [gets $file]
+
−      set slist [split $receiver]
+
−      puts $slist
+
−      puts [lindex $slist 0]
+
−      if {[lindex $slist 0]=="sleep"} {
+
−        after [lindex $slist 1]
+
−      } else {
+
−        c_send_prim $receiver [gets $file]
+
−      }
+
−    }
+
−    close $file
+
−  }
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# input_prim                               #
+
−############################################
+
−# PURPOSE : called to show a dialog
+
−#           for input of system primitives
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc input_prim {} {
+
−	global priminput_dlg
+
−	set f .priminput_dlg
+
−	if [Dialog_Create $f "Primitives" -borderwidth 10] {
+
−		message $f.msg -text "Please input a receiver:" -aspect 1000
+
−		entry $f.entry -width 5 -textvariable priminput_dlg(receiver)
+
−    $f.entry insert 0 MMI
+
−		message $f.msg2 -text "Please input a primitive:" -aspect 1000
+
−		entry $f.entry2 -width 0 -textvariable priminput_dlg(prim)
+
−    $f.entry2 insert 0 "TRACECLASS FF"
+
−		set b [frame $f.buttons]
+
−		pack $f.msg $f.entry -side top 
+
−		pack $f.msg2 $f.entry2 $f.buttons -side top -fill x
+
−		pack $f.entry -pady 5
+
−		pack $f.entry2 -pady 7
+
−		button $b.ok -text SEND -command {set priminput_dlg(ok) 1}
+
−		button $b.cancel -text Cancel \
+
−			-command {set priminput_dlg(ok) 0}
+
−		pack $b.ok -side left
+
−		pack $b.cancel -side right
+
−		bind $f.entry <Return> {set priminput_dlg(ok) 1 ; break}
+
−		bind $f.entry <Escape> {set priminput_dlg(ok) 0 ; break}
+
−	}
+
−	set priminput_dlg(ok) 0
+
−	Dialog_Wait $f priminput_dlg(ok) $f.entry
+
−	Dialog_Dismiss $f
+
−	if {$priminput_dlg(ok)} {
+
−    c_send_prim $priminput_dlg(receiver) $priminput_dlg(prim)
+
−	} 
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# set_windim                               #
+
−############################################
+
−# PURPOSE : set dimension of GUI-Window
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc set_windim {x y w h} {
+
−  wm geometry . [format "%ix%i+%i+%i" $w $h $x $y]
+
−  #wm geometry . [format "+%i+%i" $x $y]
+
−}
+
−#------------------------------------------
+
−
+
−############################################
+
−# set_initparams                           #
+
−############################################
+
−# PURPOSE : called from c-backend to 
+
−#           send init-params which will be set by TCL 
+
−#           (curr. initial size and window title)
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc set_initparams {x y w h wtitle} {
+
−  after 500 set_windim $x $y $w $h
+
−  after 500 wm title . $wtitle
+
−  after 500 wm deiconify . 
+
−}
+
−#------------------------------------------
+
−
+
−############################################
+
−# send_windim                              #
+
−############################################
+
−# PURPOSE : called to send 
+
−#           dimension of GUI-Window to
+
−#           c-backend
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc send_windim {} {
+
−  set geo [wm geometry .]
+
−  c_windim $geo
+
−}  
+
−bind .menubar.mFile <Destroy> {send_windim}
+
−#------------------------------------------
+
−
+
−
+
−
+
−
+
−
+
−############################################################
+
−# DISPLAY RELATED FUNCTIONS
+
−############################################################
+
−
+
−
+
−############################################
+
−# displ_text                               #
+
−############################################
+
−# PURPOSE : asks c-backend for current
+
−#           content of text display and
+
−#           shows it
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc displ_text {} {
+
−  global m_displ_type
+
−  global m_displtext 
+
−  global m_displwidth
+
−
+
−  set m_displtext [c_get_displtext]
+
−  catch [.frame.screen configure -image "" -text $m_displtext] 
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# displ_img                                #
+
−############################################
+
−# PURPOSE : asks c-backend for current
+
−#           display image to be used and
+
−#           shows it
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc displ_img {} {
+
−  catch [.frame.screen configure -image screen]
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# displ_update                             #
+
−############################################
+
−# PURPOSE : periodically called to update
+
−#           the display screen depending
+
−#           on set display mode (m_displ_type)
+
−#
+
−# PARAMS: 
+
−#
+
−# RETURNS:
+
−############################################
+
−proc displ_update {} {
+
−  global m_displ_type
+
−  global m_displtext 
+
−  global m_displwidth
+
−  global GRAPH_DSPL_UPDATE
+
−  global TEXT_DSPL_UPDATE
+
−
+
−  switch $m_displ_type {
+
−    "T" {
+
−      displ_text
+
−      after $TEXT_DSPL_UPDATE displ_update
+
−    } 
+
−    "D" {
+
−      displ_text
+
−#      after $TEXT_DSPL_UPDATE displ_update
+
−    } 
+
−    "G" {
+
−      displ_img
+
−      after $GRAPH_DSPL_UPDATE displ_update
+
−    } 
+
−  }
+
−}
+
−#------------------------------------------
+
−
+
−
+
−
+
−
+
−
+
−
+
−############################################################
+
−# INTERNAL FUNCTIONS
+
−############################################################
+
−
+
−
+
−############################################
+
−# Dialog_Create                            #
+
−############################################
+
−# PURPOSE : internal function for
+
−#           creating a dialog window
+
−#
+
−# PARAMS: top ... variable for dialog window
+
−#         title ... dialog title
+
−#         args ... argument to dialog
+
−#
+
−# RETURNS:
+
−############################################
+
−proc Dialog_Create {top title args} {
+
−  global dialog
+
−  if [winfo exists $top] {
+
−    switch -- [wm state $top] {
+
−      normal {
+
−        # Raise a buried window
+
−        raise $top
+
−      }
+
−      withdrawn -
+
−      iconified {
+
−        # Open and restore geometry
+
−        wm deiconify $top
+
−        catch {wm geometry $top $dialog(geo,$top)}
+
−      }
+
−    }
+
−    return 0
+
−  } else {
+
−    eval {toplevel $top} $args
+
−    wm title $top $title
+
−    set g [wm geometry .]
+
−    set pos [string first + $g] 
+
−    set g2 [string range $g $pos [string length $g]]
+
−
+
−    catch {wm geometry $top $g2}
+
−    return 1
+
−  }
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# Dialog_Wait                              #
+
−############################################
+
−# PURPOSE : internal function for
+
−#           waiting for state of a varibale
+
−#           of a modal dialog
+
−#
+
−# PARAMS: top ... variable of dialog window
+
−#         varName ... variable to be checked
+
−#         focus ... sub window to get focus
+
−#
+
−# RETURNS:
+
−############################################
+
−proc Dialog_Wait {top varName {focus {}}} {
+
−  upvar $varName var
+
−
+
−  # Poke the variable if the user nukes the window
+
−  bind $top <Destroy> [list set $varName $var]
+
−
+
−  # Grab focus for the dialog
+
−  if {[string length $focus] == 0} {
+
−    set focus $top
+
−  }
+
−  set old [focus -displayof $top]
+
−  focus $focus
+
−  catch {tkwait visibility $top}
+
−  catch {grab $top}
+
−
+
−  # Wait for the dialog to complete
+
−  tkwait variable $varName
+
−  catch {grab release $top}
+
−  focus $old
+
−}
+
−#------------------------------------------
+
−
+
−
+
−############################################
+
−# Dialog_Dismiss                           #
+
−############################################
+
−# PURPOSE : internal function for
+
−#           closing a dialog window
+
−#
+
−# PARAMS: top ... variable of dialog window
+
−#
+
−# RETURNS:
+
−############################################
+
−proc Dialog_Dismiss {top} {
+
−  global dialog
+
−  # Save current size and position
+
−  catch {
+
−    # window may have been deleted
+
−    set dialog(geo,$top) [wm geometry $top]
+
−    wm withdraw $top
+
−  }
+
−}
+
−#------------------------------------------
+
−