tku.tcl

genesis 2000 v9.1软件下载

#---------------------------------------------------
#
#  Module : tku.tcl
#  Author : MK
#  Date   : 20 Aug 1997
#
#  Description :
#
#  This module provides Tk utilities needed by the Frontline Pro-Installer
#  module and the various installation plug-ins.
#  All the public procedures are called tku_<name>
#  All the private procedures are called tku.<name> - should never be called
#
#  List of public procedures in this module:
#
#  tku_set_tools_dir  -|---- Initialization routines
#  tku_set_os         -|
#  tku_long_command   - Perform long commands allowing user stop
#  tku_message        - Writes a message to the message line
#  tku_override_tk_getOpenFile - Changes slightly the builtin tk_getOpenFile
#  tku_popup_file     -	Opens a popup displaying a file in it
#  tku_popup_log_open -	| 
#  tku_popup_log      -	| Routines for opening a logging popup and adding data	
#  tku_popup_log_show - | to it
#  tku_is_root        - Pops up a 'you are not root' message
#  tku_popup_message  -	Pops up a dialog window in various modes
#  tku_cursor_watch   - Changes the cursor to a timepiece and updates
#  tku_cursor_normal  - Changes the cursor to left pointer and updates
#  tku_center         - Finds the center of the main window
#  tku_center_on_window - Position one window on top of another
#  tku_scrolled_listbox - Creates a list box w/2 scrollbars
#  tku_color - 		Converts rrggbb to Tk color scheme
#  c_<name> -		Common colors creation
#  tku_font - 		Converts xyznn fonts to Tk font scheme
#  xyznn - 		Common font creation
#---------------------------------------------------
#
#  Change History 
#  --------------
#  970820 - First Version
#  970906 - Documentation
#
set    TKU_G(WCOUNTER)     0
set    TKU_G(AFTER_ID)     -1
set    TKU_G(BLINK_STATE)  -1
set    TKU_G(BLINK_OFFSET) 0 
set    TKU_G(COMMAND_MESSAGE)  "" 
set    TKU_G(COMMAND_MODE)     "abort" 
set    TKU_G(COMMAND_LOG_PATH) "" 
set    TKU_G(COMMAND_LOG_FP)   "" 
set    TKU_G(COMMAND_PERCENT) 0 
set    TKU_G(COMMAND_DONE) 0
set    TKU_G(GRAB_CURRENT) ""
set    TKU_G(MESSAGE_RES)  ""
set    TKU_G(PROG_FILE)    ""
set    TKU_G(STOP_FILE)    ""
set    TKU_G(LOCAL_STOP_FILE)    ""
set    TKU_G(INPUT_PIPE)   ""
set    TKU_G(COMMAND_WMESSAGE) ""
set    TKU_G(ENTRY_VAR)    ""
set    TKU_G(COPY_DIR)     ""

#*******************************************************
#
# Name :	tku_set_tools_dir
#
# Description :	
#   Sets the locations of the tools directory 
#
# Input	:	TOOLS_DIR - location of the tools
# Output :	None
# Return Value:	None
#
#*******************************************************
#
proc tku_set_tools_dir {TOOLS_DIR} {
  global TKU_G
  
  set TKU_G(TOOLS) $TOOLS_DIR
}

#*******************************************************
#
# Name :	tku_set_os
#
# Description :	
#   Sets the operating system
#
# Input	:	OS - name of operating system
# Output :	None
# Return Value:	None
#
#*******************************************************
#
proc tku_set_os {OS} {
  global TKU_G
  
  set TKU_G(OS) $OS
}

################ LONG COMMANDS EXECUTION #########################
#*******************************************************
#
# Name :	tku_long_command
#
# Description :	
#   Executes a long command, showing the caller a progress message
#   and letting him stop the process.
#
# Input	:	COMMAND - The command to process
#               MESSAGE - The message to display while the command executes
#               WMESSAGE - The widget in which to display the message and the
#                         stop button
#               MODE    - abort  - Abort if command produced any output
#                         choice - Show output and give user choice
#                         ignore - Do not show output and continue
#               PROG_FILE - Name of a progress file to display in message line
#               STOP_FILE - Name of a file to stop the comamnd on
# Output :	None
# Return Value:	ok for success
#               error for command error
#               cancel for operator stop
#*******************************************************
#
proc tku_long_command { COMMAND MESSAGE {WMESSAGE ""}
			{MODE "abort"} {PROG_FILE ""} {STOP_FILE ""} } {
  global TKU_G
  set LOG_TEMP_PATH  [file join [tclu_get_home] .valor_install log_temp]  

  set TKU_G(COMMAND_MODE) $MODE 
  set TKU_G(COMMAND_MESSAGE) $MESSAGE 
  set TKU_G(PROG_FILE) $PROG_FILE
  set TKU_G(STOP_FILE) $STOP_FILE
  
  #
  # NT backslashes
  #
  set COMMAND1 [tclu_path_back_to_fore $COMMAND]
  set COMMAND $COMMAND1
  
  if { [string length $WMESSAGE] == 0 } {
    set WMESSAGE $TKU_G(COMMAND_WMESSAGE)
  }
  #
  # Progress file handling
  #
  if { [string length  $TKU_G(PROG_FILE)] > 0} {
    catch { file delete $TKU_G(PROG_FILE) } 
  }
  
  #
  # External stop file file handling
  #
  if { [string length  $TKU_G(STOP_FILE)] > 0} {
    if [tclu_file_exists $TKU_G(STOP_FILE)] {
      file delete $TKU_G(STOP_FILE)
    }
  }
  #
  #  Preparing the local command log
  #
  set LOG_PATH [tclu_log_get_path]
  set TKU_G(COMMAND_LOG_PATH) ${LOG_PATH}.tmp  
  if [tclu_file_exists $TKU_G(COMMAND_LOG_PATH)] {
    file delete $TKU_G(COMMAND_LOG_PATH)
  }
  if [catch {open $TKU_G(COMMAND_LOG_PATH) {RDWR CREAT} 0777} \
	  TKU_G(COMMAND_LOG_FP)] { 
    puts "$TKU_G(COMMAND_LOG_FP)"
    set TKU_G(COMMAND_LOG_FP) -1 
  }   
  #
  #  Local stop file is used by the pipe_out executable to signal
  #  that the background ended. This is due to some NT TCL/TK 
  #  limitations.
  #
  set TKU_G(LOCAL_STOP_FILE) [tclu_get_tmp_name tku_local_stop]
  if [tclu_file_exists $TKU_G(LOCAL_STOP_FILE)] {
      file delete -force $TKU_G(LOCAL_STOP_FILE)
  }
  #
  #  Prepare the pipe_out executable suffix
  #
  set PIPE_OUT_EXE [file join $TKU_G(TOOLS) pipe_out.exe]
  set PIPE_OUT_COMMAND \
       "$PIPE_OUT_EXE $TKU_G(COMMAND_LOG_PATH) $TKU_G(LOCAL_STOP_FILE)"
  #
  #  ################ Command is executed here !!!!!!!!!!!!!!
  #
  tclu_log_message [format "Long Command:\n%s" [tclu_break_line $COMMAND 60]]
  set TKU_G(COMMAND_DONE) ""
  if [catch {open "|$COMMAND |& $PIPE_OUT_COMMAND"} RESPONSE] {
    set WLOGS \
	[tku_popup_log_open "Command Failure" \
	     "-height 12"]
    set WLOG [lindex $WLOGS 0]
    set WT   [lindex $WLOGS 1]
    tku_popup_log $WT normal "[tclu_break_line $COMMAND 60]\n"
    tku_popup_log $WT error  " [tclu_break_line " --> $RESPONSE" 60]\n"
    tclu_log_message [tclu_break_line "--> $RESPONSE" 60] "error"
    return "error"
  } else {
    . configure -cursor watch
    set TKU_G(INPUT_PIPE) $RESPONSE
    fconfigure $TKU_G(INPUT_PIPE) -blocking 0
    set W_STOP_FRAME \
	[tku.stop_popup $WMESSAGE]
    while { $TKU_G(COMMAND_DONE) == "" } {
       vwait TKU_G(COMMAND_DONE)
    }
  }
  if { $TKU_G(COMMAND_DONE) == "error"} {
    switch -- $TKU_G(COMMAND_MODE) {
       "abort" {
         set MESSAGE "The command :\
 	         \n\n[tclu_break_line $COMMAND 60]\
	         \n\nproduced error messages."
	 tku_popup_message error ok $MESSAGE $TKU_G(COMMAND_LOG_PATH)	 
       }
       "choice" {
         set MESSAGE "The command :\
 	         \n\n[tclu_break_line $COMMAND 60]\
	         \n\nproduced error messages.\
	       \n\nAre you sure you wish to continue?"	       
         set CHOICE [tku_popup_message warning yesno $MESSAGE
		    $TKU_G(COMMAND_LOG_PATH) ]
         switch -- $CHOICE {
           "yes" {
   	     set TKU_G(COMMAND_DONE) ok
	    }
	   "no" {
	     set TKU_G(COMMAND_DONE) error
	    }
            default { bgerror "Switch error tku.tcl (0)" }
         }
       }
       default {
       }
     }
   }
   return $TKU_G(COMMAND_DONE)
}

proc tku_long_command_set_wmessage {WMESSAGE} {
  global TKU_G
  
  set TKU_G(COMMAND_WMESSAGE) $WMESSAGE
}

proc tku_message { TEXT } {
  global TKU_G
  if { $TKU_G(COMMAND_WMESSAGE) != "" } {
     $TKU_G(COMMAND_WMESSAGE) configure -text $TEXT
     update idletasks
  } else {
     puts $TEXT 
  }
}
  
#................................................................#
proc tku.stop_popup {WMESSAGE} {
  global TKU_G
  
  if { [string length $WMESSAGE] == 0 } {
    return ""
  }
  
  set W_STOP_FRAME $WMESSAGE.frame
  
  if { ! [winfo exists $W_STOP_FRAME] } {
    frame $W_STOP_FRAME -bg [c_yellow] 
    label $W_STOP_FRAME.l -bg [c_yellow] -font [tbr14] -justify left -bd 1
    label $W_STOP_FRAME.p -bg [c_yellow] -font [tbr14] -justify left -bd 1 \
	-text "  0%"
    button $W_STOP_FRAME.b -text "Stop" -bg [c_aqua] -font [tbr14] \
	-highlightbackground [c_yellow] \
	-command [list tku.stop_long_command \
		      "cancel" $W_STOP_FRAME ]
    pack $W_STOP_FRAME.b -side right 
    pack $W_STOP_FRAME.p -side right 
    pack $W_STOP_FRAME.l -side left -fill x
  }
  $W_STOP_FRAME.b configure -text "Stop"
  $W_STOP_FRAME.p configure -text " "
  $W_STOP_FRAME.l configure -text $TKU_G(COMMAND_MESSAGE)
  pack $W_STOP_FRAME  -expand 1 -fill x
  catch {grab $W_STOP_FRAME}
  
  set TKU_G(BLINK_STATE)  0
  set TKU_G(BLINK_OFFSET) 0
  tku.long_command_blink $W_STOP_FRAME [string length $TKU_G(COMMAND_MESSAGE)]
  return $W_STOP_FRAME
}

#................................................................#
proc tku.long_command_blink {W LEN } {
  global TKU_G

  set RENEW_TIMER 1
  
  switch -- $TKU_G(BLINK_STATE) {
    {0} {
      set COLOR [c_red]
    }
    {1} {
      set COLOR [c_aqua]
    }
    default { bgerror "Switch error tku.tcl (1)" }
  }
  $W.b configure -bg $COLOR
  set PROGRESS "    "
  if [tclu_file_exists $TKU_G(PROG_FILE)] {
    if { ![catch {open $TKU_G(PROG_FILE) RDONLY} FP] } {
      set PROGRESS [read $FP]
      catch {close $FP}
    }
  }
  $W.p configure -text $PROGRESS
  update idletasks
  
  set TKU_G(BLINK_STATE) [expr 1-$TKU_G(BLINK_STATE)]
  incr TKU_G(BLINK_OFFSET)
  if { $TKU_G(BLINK_OFFSET) > 60 } {
    set TKU_G(BLINK_OFFSET) 0 
  }

  #
  # STOP_FILEs are used by commands which read from DAT to make a long
  # tar stop
  if { [tclu_file_exists $TKU_G(STOP_FILE)] } {
    file delete -force $TKU_G(STOP_FILE)
    tku.stop_long_command "end" $W      
    set RENEW_TIMER 0
  } 
  #
  # LOCAL_STOP_FILEs are used by any command. They are written by the
  # pipe_out program (which is suffixed to all long commands) when the
  # input pipe to pipe_out is closed.
  #
  if { [tclu_file_exists $TKU_G(LOCAL_STOP_FILE)] } {
    # stop file was found, we simulate a normal completion
    catch {file delete -force $TKU_G(LOCAL_STOP_FILE)} 
    tku.stop_long_command "end" $W      
    set RENEW_TIMER 0
  } 
  
  if { $RENEW_TIMER } {
    set TKU_G(AFTER_ID) \
	[after 500 [list tku.long_command_blink $W $LEN]]   
  }
}

#................................................................#
proc tku.stop_long_command \
   {END_CONDITION W_STOP_FRAME} {
   global TKU_G
      
   set COMMAND_DONE "ok"
   if { $TKU_G(AFTER_ID) != -1 } {
     after cancel $TKU_G(AFTER_ID)
   }
   if {$END_CONDITION == "cancel" && [string length $W_STOP_FRAME] > 0 } {
      $W_STOP_FRAME.b configure -text "Stopping..."
      update idletasks
   }
   catch {close $TKU_G(COMMAND_LOG_FP)}
   if [tclu_file_exists $TKU_G(COMMAND_LOG_PATH)] {
      if { [file size $TKU_G(COMMAND_LOG_PATH)] > 0 } {
	 set COMMAND_DONE "error"
	 set LOG_MODE     "error"
         if { $TKU_G(COMMAND_MODE) == "ignore" } { 
	    set COMMAND_DONE "ok"
	    set LOG_MODE     "normal"
	 }
         tclu_log_message "Command produced messages below:" $LOG_MODE
         catch {tclu_log_file $TKU_G(COMMAND_LOG_PATH)}
         tclu_log_message "End of command message" $LOG_MODE	 
      }
   }
   set PIDS [split [pid $TKU_G(INPUT_PIPE)]]
   foreach PID $PIDS {
     if [catch {exec kill $PID} RESP] {
#        puts $RESP
     }
   }
   catch {close $TKU_G(INPUT_PIPE)}