install.tcl

genesis 2000 v9.1软件下载

#---------------------------------------------------
#
#  Module : install.tcl
#  Author : MK
#  Date   : 20 Aug 1997
#
#  Description :
#
#  This is the main module for the Frontline Pro-Installer.
#
# Version 3.3  04 Dec 2003
#---------------------------------------------------

# Global variables which can be overwritten by the defaults file
#
global VPIG
   
set VPIG(VERSION)		"Genesis9.1d1"
set VPIG(SOURCE)		"CDROM"
set VPIG(CDROM_PATH)		""
set VPIG(FTP_SERVER)		"ftp-us.frontline-pcb.com"
set VPIG(DAT_DEVICE)		"/dev/rmt/0m"
set VPIG(DISK_PATH)		""
set VPIG(PRODUCTS_OR_BEANS)	"products"
set VPIG(NAME) 			""
set VPIG(NAME_VERSION) 		""
set VPIG(NAME_OS)      		""
set VPIG(TOOLS_PATH)		""
set VPIG(INSTALL_PATH)		""
set VPIG(PRODUCT_PATH)		""
set VPIG(DEFAULTS_PATH)		""
set VPIG(LOG_PATH)		""
set VPIG(INSTALL_STATE)	        0
set VPIG(W)                     ".w"   
set VPIG(WMAIN)			".w.main"
set VPIG(WPLUGIN)		".w.plugin"
set VPIG(WPLUGIN_EMPTY)		".w.plugin.empty"
set VPIG(WPLUGIN_FRAME)		".w.plugin.frame"
set VPIG(WMESSAGE)		".wmessage"
set VPIG(FTP_USER)		"ftp"
set VPIG(FTP_LOCATIONS)       \
   { "ftp-us.frontline-pcb.com" "Frontline mirror (U.S.)" "/pub/release" \
     "ftp.frontline-pcb.com"    "Frontline R&D (Israel)"  "/pub/release" }
#

proc vpi.main {} {     
  global VPIG 
  
  tclu_set_tools_dir $VPIG(TOOLS_PATH)
  tclu_set_os $VPIG(OS)
  tku_set_tools_dir $VPIG(TOOLS_PATH)
  tku_set_os $VPIG(OS)
  vpi.set_unix_commands  
  
  set VPIG(USER_DIR)      [file join [tclu_get_home] .valor_install]
  set VPIG(DEFAULTS_PATH) [file join $VPIG(USER_DIR) defaults]  
  set VPIG(LOG_PATH)      [file join $VPIG(USER_DIR) log]  
  set VPIG(C_BG)	  [c_dblue]
  
  catch {file mkdir $VPIG(USER_DIR)}

  tclu_log_set_path $VPIG(LOG_PATH)
  tclu_log_newline 
  tclu_log_message "Starting Pro-Installer Version $VPIG(VERSION)"
  vpi.load_user_defaults $VPIG(DEFAULTS_PATH)
  vpi.set_default_resources
  vpi.show_toplevel
  tku_override_tk_getOpenFile 
  
  trace variable VPIG(NAME)         w vpi.name_change_cb
  trace variable VPIG(NAME_VERSION) w vpi.name_version_change_cb
  trace variable VPIG(NAME_OS)      w vpi.name_os_change_cb
  
}

##################################################################
proc vpi.load_user_defaults {PATH} {
   global VPIG
            
   catch {source $PATH}
   
   if { [string length $VPIG(CDROM_PATH)] == 0 } {
      set VPIG(CDROM_PATH) [pwd]
   }
}
##################################################################
proc vpi.save_user_defaults {PATH} {
  global VPIG 
  set VAR_LIST [list \
     SOURCE 		\
     CDROM_PATH 	FTP_SERVER		DAT_DEVICE	DISK_PATH  \
     PRODUCTS_OR_BEANS	\
     NAME 		NAME_VERSION 		NAME_OS \
  ]
    
   if {[catch {open $PATH w} FP]} {
      puts "Defaults cannot be written to $PATH"
      return 
   } 
   
   foreach VAR $VAR_LIST {
      set VALUE $VPIG($VAR)    
      if [string length $VALUE] {
	 set VALUE [tclu_quote_backslashes $VALUE]
	 set COMMAND [format "set VPIG(%s) %s" $VAR $VALUE]
      } else { 
         set COMMAND [format "set VPIG(%s) \"\"" $VAR]
      }
      puts $FP $COMMAND
   }
   close $FP   
}
   
##################################################################
proc vpi.set_default_resources {} {
  option add *foreground [c_black]
}

##################################################################
proc vpi.show_toplevel {} {
  global VPIG 
  global env
  
  wm title . "Frontline Pro Installer  .... [tclu_get_user]@[info hostname] ($VPIG(OS))" 
  
  set W $VPIG(W)
  frame $W -bg $VPIG(C_BG)
  set WMAIN $VPIG(WMAIN)        
  frame $WMAIN -bg $VPIG(C_BG)
  frame $WMAIN.f_header  -bg $VPIG(C_BG) -relief groove -bd 2
  frame $WMAIN.f_source  -bg $VPIG(C_BG) -relief sunken -bd 2 
  frame $WMAIN.f_name    -bg $VPIG(C_BG) -relief sunken -bd 2
  frame $WMAIN.f_action  -bg $VPIG(C_BG) -relief sunken -bd 2 
  frame $WMAIN.f_control -bg $VPIG(C_BG) -relief groove -bd 2 
  pack  $WMAIN.f_header $WMAIN.f_source $WMAIN.f_name \
        $WMAIN.f_action $WMAIN.f_control \
        -expand true -fill x

  vpi.show_f_header $WMAIN.f_header

  vpi.show_f_source $WMAIN.f_source

  vpi.show_f_name   $WMAIN.f_name

  vpi.show_f_action $WMAIN.f_action

  vpi.show_f_control $WMAIN.f_control
  frame $VPIG(WPLUGIN) -relief sunken -bg [c_dblue] -bd 5
  label $VPIG(WPLUGIN_EMPTY) -text "中国人就爱中文！" -width 50 \
                      -font [tbi18] -bg [c_dblue]
  pack $VPIG(WPLUGIN_EMPTY) -fill both -expand 1
     
  pack $WMAIN $VPIG(WPLUGIN) -side left -fill y -expand 1
  label $VPIG(WMESSAGE) -bg [c_yellow] -font [tbr14] \
                        -relief groove -bd 3 -text " \n  "
  pack $W $VPIG(WMESSAGE) -side top -fill x -expand 1
  tku_long_command_set_wmessage $VPIG(WMESSAGE)
}

##################################################################
proc vpi.show_f_header {W} {
  global VPIG 
  
  set WMAIN $VPIG(WMAIN)

  image create photo frontline_gif -file [file join install frontline.gif]
  label $W.l_main -image frontline_gif -bg $VPIG(C_BG) -bd 1 

  set LVERSION "我们致力为PCB提供动力！ $VPIG(VERSION)"
  label $W.l_version -text $LVERSION -bg $VPIG(C_BG) \
        -font [tmi18]

  set WS $W.f_source
  frame $WS -bg $VPIG(C_BG) -relief sunken -bd 2
  label $WS.l_source -text "Source" -bg $VPIG(C_BG)  -bd 3 \
        -font [tmr18] -relief groove 
  pack $WS.l_source -pady 3
  
  frame $WS.f_radio -bg $VPIG(C_BG)
#  
  frame $WS.f_radio1 -bg $VPIG(C_BG)
  frame $WS.f_radio2 -bg $VPIG(C_BG)
  frame $WS.f_radio2.2l -bg $VPIG(C_BG)
  frame $WS.f_radio2.2l.t -bg $VPIG(C_BG)
  frame $WS.f_radio2.2l.b -bg $VPIG(C_BG)
  frame $WS.f_radio2.2r -bg $VPIG(C_BG)
#  
  radiobutton $WS.f_radio1.rb -text CDROM \
                -value CDROM \
                -variable VPIG(SOURCE) \
                -highlightbackground [c_dblue] \
                -bg $VPIG(C_BG) -font [tku_font tbr12 u] \
                -command [list cb_source $WMAIN]
  canvas $WS.f_radio1.a -width 7.7c -height 1c -bg $VPIG(C_BG) \
         -highlightbackground [c_dblue]
  $WS.f_radio1.a create line 0c 0.5c 2.6c 0.5c -width 3
  $WS.f_radio1.a create text 2.7c 0.5c -font [tbi14] -anchor w \
                 -text "Install"   
  $WS.f_radio1.a create line 4.2c 0.5c 7.7c 0.5c -arrow last -width 3
  pack $WS.f_radio1.rb $WS.f_radio1.a  -side left
#  
  radiobutton $WS.f_radio2.2l.t.rb -text FTP \
                -value FTP \
                -variable VPIG(SOURCE) \
                -highlightbackground [c_dblue] \
                -bg $VPIG(C_BG) -font [tku_font tbr12 u] \
                -command [list cb_source $WMAIN]
  pack $WS.f_radio2.2l.t.rb -side left 
#  
  radiobutton $WS.f_radio2.2l.b.rb -text DAT \
                -value DAT \
                -variable VPIG(SOURCE) \
                -highlightbackground [c_dblue] \
                -bg $VPIG(C_BG) -font [tku_font tbr12 u] \
                -command [list cb_source $WMAIN]
  pack $WS.f_radio2.2l.b.rb -side left 
#
  canvas $WS.f_radio2.2r.c1 -width 3.5c -height 2c -bg $VPIG(C_BG) \
         -highlightbackground [c_dblue]
  $WS.f_radio2.2r.c1 create line 0c 0.5c 0.5c 0.5c -width 3 -cap round	 
  $WS.f_radio2.2r.c1 create line 0c 1.5c 0.5c 1.5c -width 3 -cap round	 
  $WS.f_radio2.2r.c1 create line 0.5c 0.5c 0.5c 1.5c -width 3 -cap round	 
  $WS.f_radio2.2r.c1 create line 0.5c 1c 1c 1c -width 3	 
  $WS.f_radio2.2r.c1 create text 1.1c 1c -font [tbi14] -anchor w \
                 -text "Retrieve"   
  $WS.f_radio2.2r.c1 create line 3.0c 1c 3.5c 1c -width 3 -arrow last	 
  radiobutton $WS.f_radio2.2r.rb -text DISK \
                -value DISK \
                -variable VPIG(SOURCE) \
                -highlightbackground [c_dblue] \
                -bg $VPIG(C_BG) -font [tku_font tbr12 u] \
                -command [list cb_source $WMAIN]
  canvas $WS.f_radio2.2r.c2 -width 3c -height 2c -bg $VPIG(C_BG) \
         -highlightbackground [c_dblue]
  $WS.f_radio2.2r.c2 create line 0c 1c 0.7c 1c -width 3
  $WS.f_radio2.2r.c2 create text 0.8c 1c -font [tbi14] -anchor w \
                 -text "Install"   
  $WS.f_radio2.2r.c2 create line 2.3c 1c 3c 1c -width 3 -arrow last	 
  pack  $WS.f_radio2.2r.c1 $WS.f_radio2.2r.rb $WS.f_radio2.2r.c2 -side left 
#
  pack $WS.f_radio2.2l.t $WS.f_radio2.2l.b  -side top 
  pack $WS.f_radio2.2l $WS.f_radio2.2r -side left 
#  
  pack $WS.f_radio1 $WS.f_radio2 -side top 
  pack $WS.f_radio
  pack $W.l_main $W.l_version $WS -fill x
}
#................................................................#
proc cb_source {W} {
  vpi.show_f_source $W.f_source
  vpi.show_f_action $W.f_action
}

##################################################################
proc vpi.show_f_source {W} {
  global VPIG 
 
  set CHILDREN [winfo children $W]
  foreach CHILD $CHILDREN {
    if { [string length $CHILD] > 0 } {
      destroy $CHILD
    }
  }

  switch -- $VPIG(SOURCE) {
    CDROM { vpi.show_f_source_cdrom $W }
    FTP   { vpi.show_f_source_ftp   $W }
    DAT   { vpi.show_f_source_dat   $W }
    DISK  { vpi.show_f_source_disk  $W }
    default { bgerror "Switch error install.tcl (0)"}
  }
}

#................................................................#
proc vpi.show_f_source_cdrom {W} {
  global VPIG 
  set WF $W.f_source
  frame $WF -bg $VPIG(C_BG)
  pack $WF
     
  set DIRTYPES [list \
        Products 	products \
	Beans   	beans	\
	]
  frame $WF.cdrom  -bg $VPIG(C_BG)
  button $WF.cdrom.b -text "安装路径:"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14] \
     -command vpi.cb_cdrom_path
  entry  $WF.cdrom.e -bg [c_yellow] -font [cbr14] \
         -textvariable VPIG(CDROM_PATH) -width 30
  pack $WF.cdrom.b $WF.cdrom.e -side left -fill x  
  frame $WF.type  -bg $VPIG(C_BG)
  set I 0
  foreach {DTTEXT DT} $DIRTYPES {
    radiobutton $WF.type.rb$I -text $DTTEXT \
                -variable VPIG(PRODUCTS_OR_BEANS) \
                -highlightbackground [c_dblue] \
                -value $DT \
                -bg $VPIG(C_BG) -font [tku_font tbr12]
    pack $WF.type.rb$I -side left -fill x -padx 0
    incr I
  }       
  button $WF.type.list -text "List..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.list_contents_cb
  pack $WF.type.list -side right
  pack $WF.cdrom $WF.type -fill x	   
}

proc vpi.cb_cdrom_path {} {
  global VPIG 
  
   set PATH [tk_getOpenFile -initialdir \
             [tclu_get_dir_for_file $VPIG(CDROM_PATH)]]
   if { [string length $PATH] > 0 } { 
      set VPIG(CDROM_PATH) $PATH
   }
}

#................................................................#
proc vpi.show_f_source_ftp {W} {
  global VPIG 
  set WF $W.f_source
  frame $WF -bg $VPIG(C_BG)
  pack $WF
     
  set DIRTYPES [list \
        Products 	products \
	Beans   	beans	\
	]
  frame $WF.ftp  -bg $VPIG(C_BG)
  button $WF.ftp.b -text "FTP Server :"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14] \
     -command vpi.cb_ftp_server
  entry  $WF.ftp.e -bg [c_yellow] -font [cbr14] \
         -textvariable VPIG(FTP_SERVER)  -width 30
  pack $WF.ftp.b $WF.ftp.e -side left -fill x  
#     
  frame $WF.disk  -bg $VPIG(C_BG)
  button $WF.disk.b -text "DISK  Path :"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14]  \
     -command vpi.cb_disk_path
  entry  $WF.disk.e -bg [c_yellow] -font [cbr14] \
         -textvariable VPIG(DISK_PATH)  -width 30
  pack $WF.disk.b $WF.disk.e -side left -fill x  
#
  frame $WF.type  -bg $VPIG(C_BG)
  set I 0
  foreach {DTTEXT DT} $DIRTYPES {
    radiobutton $WF.type.rb$I -text $DTTEXT \
                -variable VPIG(PRODUCTS_OR_BEANS) \
                -highlightbackground [c_dblue] \
                -value $DT \
                -bg $VPIG(C_BG) -font [tku_font tbr12]
    pack $WF.type.rb$I -side left -fill x -padx 0
    incr I
  }       
  button $WF.type.list -text "List..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.list_contents_ftp_cb
  pack $WF.type.list -side right
  pack $WF.ftp $WF.disk $WF.type -fill x	   
}

#................................................................#
proc vpi.cb_ftp_server {} {
  global VPIG 
  
  set IND 0
  foreach {SERVER TITLE DIR} $VPIG(FTP_LOCATIONS) {  
     set FTP_SERVERS($IND) \
       [format "%-22s----> %s" $SERVER $TITLE]
     incr IND
  }
  vpi.popup_list FTP_SERVERS 3
}

#................................................................#
proc vpi.show_f_source_dat {W} {
  global VPIG 
  set WF $W.f_source
  frame $WF -bg $VPIG(C_BG)
  pack $WF
     
  frame $WF.dat  -bg $VPIG(C_BG)
  button $WF.dat.b -text "DAT Device :"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14] \
     -command vpi.cb_dat_device
  entry  $WF.dat.e -bg [c_yellow] -font [cbr14] \
         -textvariable VPIG(DAT_DEVICE)  -width 30
  pack $WF.dat.b $WF.dat.e -side left -fill x  
#     
  frame $WF.disk  -bg $VPIG(C_BG)
  button $WF.disk.b -text "DISK  Path :"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14] \
     -command vpi.cb_disk_path
  entry  $WF.disk.e -bg [c_yellow] -font [cbr14] \
         -textvariable VPIG(DISK_PATH)  -width 30
  pack $WF.disk.b $WF.disk.e -side left -fill x  
#
  frame $WF.type  -bg $VPIG(C_BG)
  button $WF.type.list -text "List..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.list_contents_dat_cb
  pack $WF.type.list -side right
  pack $WF.dat $WF.disk $WF.type -fill x	   
}

#................................................................#
proc vpi.cb_dat_device {} {
  global VPIG 
  
  set DEVICE_LIST [glob "/dev/rmt/*"]
  set J 0
  foreach DEVICE $DEVICE_LIST {
    set DAT_DEVICES($J) $DEVICE
    incr J
  }
  vpi.popup_list DAT_DEVICES 4
}


#................................................................#
proc vpi.show_f_source_disk {W} {
  global VPIG
  set WF $W.f_source
  frame $WF -bg $VPIG(C_BG)
  pack $WF
     
  set DIRTYPES [list \
	Products 	products \
	Beans   	beans \
	]
  frame $WF.disk  -bg $VPIG(C_BG)
  button $WF.disk.b -text "DISK  Path :"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14] \
     -command vpi.cb_disk_path
  entry  $WF.disk.e -bg [c_yellow] -font [cbr14] \
         -textvariable VPIG(DISK_PATH)  -width 30
  pack $WF.disk.b $WF.disk.e -side left -fill x  
  frame $WF.type  -bg $VPIG(C_BG)
  set I 0
  foreach {DTTEXT DT} $DIRTYPES {
    radiobutton $WF.type.rb$I -text $DTTEXT \
                -variable VPIG(PRODUCTS_OR_BEANS) \
                -value $DT \
                -highlightbackground [c_dblue] \
                -bg $VPIG(C_BG) -font [tku_font tbr12] \
                -command [list vpi.show_f_action $VPIG(WMAIN).f_action]
    pack $WF.type.rb$I -side left -fill x -padx 0
    incr I
  }       
  button $WF.type.list -text "List..." -font [tbr14] -bg [c_aqua] \
                           -highlightbackground [c_dblue] \
                           -command vpi.list_contents_cb
  pack $WF.type.list -side right
  pack $WF.disk $WF.type -fill x	   
}

proc vpi.cb_disk_path {} {
  global VPIG 
  
   set INITIAL_DIR $VPIG(DISK_PATH)
   set VPIG(DISK_PATH) [string trim $VPIG(DISK_PATH)]
   if { $VPIG(DISK_PATH) == "" } {
      set INITIAL_DIR [file join [tclu_get_tmp_dir]]
   }
   set PATH [tk_getOpenFile \
             -initialdir [tclu_get_dir_for_file $INITIAL_DIR]]
   if { [string length $PATH] > 0 } { 
      set VPIG(DISK_PATH) $PATH
   }
}

##################################################################
proc vpi.list_contents_cb {} {
  global VPIG 
   
  set PATH [vpi.get_dir]
  set NAME_TITLE [vpi.get_dir_type]
     
  if { ! [tclu_is_path_dir $PATH] } {
     tku_popup_message warning ok [format "Illegal directory : \n%s" $PATH]
     return
  }
  
  set TMP_PATH [tclu_get_tmp_name "vpi_list"]
  if {[catch {open $TMP_PATH w} FP]} {
     tku_popup_message error ok [format "Cannot open file\n%s" $TMP_PATH]
     return
  }
  puts $FP [format "()title List of %s in %s\n" $NAME_TITLE $PATH]
  if [catch { glob [file join $PATH *]} NAME_LIST ] {
     set NAME_LIST ""     
  }
  foreach  PATH_NAME $NAME_LIST {
    set NAME [file tail $PATH_NAME]