reader.tcl

genesis 2000 v9.1软件下载

#---------------------------------------------------
#
#  Module : reader.tcl
#  Author : MK
#  Date   : 20 Sep 1997
#
#  Description :
#
#  This is the main module for the Frontline Literature Reader.
#
#---------------------------------------------------
#
# Global variables which can be overwritten by the defaults file
#
global READG
global LI_NAME LI_TYPE LI_FILE LI_PRODUCTS LI_ABSTRACT NUM_LI
set READG(VERSION)		"1.2"
set READG(PRODUCT)		"Genesis"
set READG(TYPE)			"Articles"
set READG(ACROBAT_COMMAND)      "acroread -useFrontEndProgram"
set READG(CUR_INDEX)            "-1"
set READG(W)                    ".w"   
set READG(W_MESSAGE)		".w.main.wmessage"
set READG(W_LCOUNT)             ""
set READG(W_TITLES)             ""
set READG(W_ABSTRACT)           ""
   
set READG(PRODUCTS) [list \
         Genesis General
	]
set READG(TYPES) [list \
         Advertisements Articles "Fact Sheets" \
	 Manuals
	]  	
set READG(PRODUCTS_LC)  [list]
foreach ITEM $READG(PRODUCTS) {
   lappend READG(PRODUCTS_LC) [string tolower $ITEM]
}

set READG(TYPES_LC)  [list]
foreach ITEM $READG(TYPES) {
   lappend READG(TYPES_LC) [string tolower $ITEM]
}

proc reader.main {} {     
  global READG 
  
  tclu_set_tools_dir $READG(TOOLS_PATH)
  tclu_set_os $READG(OS)
  tku_set_tools_dir $READG(TOOLS_PATH)
  tku_set_os $READG(OS)
  reader.set_unix_commands  
  
  set READG(USER_DIR)      [file join [tclu_get_home] .valor_install]
  set READG(DEFAULTS_PATH) [file join $READG(USER_DIR) reader_defaults]  
  set READG(LOG_PATH)      [file join $READG(USER_DIR) reader_log]  
  set READG(C_BG)	   [c_dblue]

  catch {file mkdir $READG(USER_DIR)}

  set READG(COPY_DIR)      [tclu_get_tmp_dir]
  tclu_log_set_path $READG(LOG_PATH)
  tclu_log_newline 
  tclu_log_message "Starting Reader Version $READG(VERSION)"
  reader.load_user_defaults $READG(DEFAULTS_PATH)
  set READG(LIT_PATH) [file join [pwd] literature]
  reader.set_default_resources
  set READG(HEIGHT) [winfo screenheight .]
  if { $READG(HEIGHT) < 768 } {
     puts " Window size is reduced for a small screen " 
  }
  reader.show_toplevel  
  reader.read_index_file
  reader.update_display
  tku_override_tk_getOpenFile 
  tku_cursor_normal       
}

##################################################################
proc reader.load_user_defaults {PATH} {
   global READG
   
   catch {source $PATH}
}

##################################################################
proc reader.save_user_defaults {PATH} {
  global READG 
  set VAR_LIST [list \
       PRODUCT  TYPE  ACROBAT_COMMAND COPY_DIR
  ]
    
   if {[catch {open $PATH w} FP]} {
      puts "Defaults cannot be written to $PATH"
      return 
   } 
   
   foreach VAR $VAR_LIST {
      set VALUE $READG($VAR)    
      if [string length $VALUE] {
	 set COMMAND [format "set READG(%s) \"%s\"" $VAR $VALUE]
      } else { 
         set COMMAND [format "set READG(%s) \"\"" $VAR]
      }
      puts $FP $COMMAND
   }
   close $FP   
}

##################################################################
proc reader.set_default_resources {} {
  option add *foreground [c_black]
  option add *font [cbr14]
}

##################################################################
proc reader.read_index_file {} {
    global READG
    global LI_NAME LI_TYPE LI_FILE LI_PRODUCTS LI_ABSTRACT
    global env

    set SHOW_MISSING_FILES 0
    if [info exists env(SHOW_MISSING_FILES)] {
       set SHOW_MISSING_FILES 1
    }
    
    tku_cursor_watch       
    tku_message "Reading index file..."   
    set INDEX_PATH [file join $READG(LIT_PATH) index.txt]
    
    if { [catch {open $INDEX_PATH RDONLY} FP] } {
       tku_popup_message error ok $FP
       return 1
    }
    set INDEX  0
    set LCOUNT 0
    while { ! [eof $FP] } {
       gets $FP LINE
       incr LCOUNT
       if { [string index $LINE 0] != "@" } {
	  continue 
       }
       set COMMAND [string index $LINE 1]
       switch -- $COMMAND {
	  "N" {
	     set NAME [string range $LINE 3 end]
	     set LI_NAME($INDEX) [string trim $NAME]
	  }
	  "T" {
	     set TYPE [string tolower [string range $LINE 3 end]]
	     set LI_TYPE($INDEX) [string trim $TYPE]
	     if { [lsearch $READG(TYPES_LC) $LI_TYPE($INDEX)] < 0 } {
	        puts "Illegal type $LI_TYPE($INDEX) at line $LCOUNT\
		    \n   Document: $LI_NAME($INDEX)"
	     }
	  }
	  "F" {
	     set FILE [string tolower [string range $LINE 3 end]]
	     set LI_FILE($INDEX) [string trim $FILE]	     
             set FPATH [get_li_file_path $INDEX]
	     if { ! [file exists $FPATH] && $SHOW_MISSING_FILES } {
	        puts "Missing: $FPATH"
	     }
	  }
	  "P" {
	     set LI_PRODUCTS($INDEX) \
	         [split [string tolower [string range $LINE 3 end]]]
	     foreach PRODUCT $LI_PRODUCTS($INDEX) {
	        if { [lsearch $READG(PRODUCTS_LC) $PRODUCT] < 0 } {
	           puts "Illegal product $PRODUCT at line $LCOUNT\
	               \n   Document: $LI_NAME($INDEX)"
	        }
	     }
	  }
	  "A" {
 	     reader.add_abstract_to_lit_item $FP $INDEX LCOUNT
	     incr INDEX
	     set LI_NAME($INDEX) ""
	     set LI_TYPE($INDEX) ""
	     set LI_FILE($INDEX) ""
	     set LI_PRODUCTS($INDEX) [list]
             set LI_ABSTRACT($INDEX) ""
	  }
	  default {
	     set MESSAGE \
	       "Illegal code in line $LCOUNT\
	      \nof file $INDEX_PATH."
	      puts $MESSAGE
	  }
       }
    }
    close $FP
    set READG(NUM_TITLES) $INDEX
    tku_message " "   
    return 0
}
##################################################################
proc reader.add_abstract_to_lit_item { FP INDEX LCOUNT_VAR} {
    global READG
    global LI_NAME LI_TYPE LI_FILE LI_PRODUCTS LI_ABSTRACT
    upvar $LCOUNT_VAR LCOUNT
    
    set LI_ABSTRACT($INDEX) ""
    while { ! [eof $FP] } {
       gets $FP LINE
       incr LCOUNT
       if { [string index $LINE 0] != "@" } {
	  append LI_ABSTRACT($INDEX) "$LINE\n"
	  continue
       } else {
         break
       }
    }        
}

##################################################################
proc reader.show_toplevel {} {
  global READG 
  global env
  
  wm title . \
    "Frontline Literature Reader .... [tclu_get_user]@[info hostname] ($READG(OS))" 
  
  set W $READG(W)
  frame $W -bg $READG(C_BG)
  set WMAIN $W.main
  frame $WMAIN -bg $READG(C_BG)
  frame $WMAIN.f_header  -bg $READG(C_BG) -relief groove -bd 2
  frame $WMAIN.f_product  -bg $READG(C_BG) -relief sunken -bd 2 
  frame $WMAIN.f_gt   -bg $READG(C_BG) -relief sunken -bd 2
  frame $WMAIN.f_abstract -bg $READG(C_BG) -relief sunken -bd 2
  frame $WMAIN.f_acro_command -bg $READG(C_BG) -relief groove -bd 2
  frame $WMAIN.f_control -bg $READG(C_BG) -relief groove -bd 2 
  pack  $WMAIN.f_control -side bottom -expand true -fill both
  label $READG(W_MESSAGE) -bg [c_yellow] -font [tbr14] \
                        -relief groove -bd 3 -text " \n  "
  pack $READG(W_MESSAGE) -side bottom -fill x -expand 1
  pack $WMAIN.f_acro_command -side bottom -fill x -expand 1
  pack  $WMAIN.f_header $WMAIN.f_product $WMAIN.f_gt $WMAIN.f_abstract \
        -side top -expand true -fill both
  reader.show_f_header $WMAIN.f_header
  reader.show_f_product $WMAIN.f_product
  reader.show_f_gt $WMAIN.f_gt
  reader.show_f_abstract     $WMAIN.f_abstract
  reader.show_f_acro_command $WMAIN.f_acro_command
  reader.show_f_control $WMAIN.f_control
  pack $WMAIN -fill both -expand 1
  pack $W -fill both -expand 1
  tku_long_command_set_wmessage $READG(W_MESSAGE)  
}

##################################################################
proc reader.show_f_header {W} {
  global READG 
  
  image create photo frontline_gif -file [file join install frontline.gif]
  frame $W.l -bg $READG(C_BG)
  label $W.l.main -image frontline_gif -bg $READG(C_BG) -bd 1 
  
  set LVERSION "Literature Reader - Version $READG(VERSION)"
  label $W.l.version -text $LVERSION -bg $READG(C_BG) \
        -font [tmi18]
  pack  $W.l.main $W.l.version -side left -fill x 
  pack $W.l -side top -fill x  
}

##################################################################
proc reader.show_f_product {W} {
  global READG 
     
  frame $W.type  -bg $READG(C_BG)
  set I 0
  foreach PRODUCT $READG(PRODUCTS) {
    set UC_PRODUCT [string toupper $PRODUCT]
    set READG($UC_PRODUCT) 1
    checkbutton $W.type.rb$I -text $PRODUCT \
                -variable READG($UC_PRODUCT) \
                -highlightbackground [c_dblue] \
                -bg $READG(C_BG) -font [tbi18] \
		-command reader.f_product_cb
    pack $W.type.rb$I -side left -fill x -padx 0
    incr I
  }  
  pack $W.type -expand 1 -fill both
}

proc reader.f_product_cb {} {
   reader.update_display
}

##################################################################
proc reader.show_f_gt {W} {
  global READG 

  frame $W.types  -bg $READG(C_BG)
  set I 0
  foreach TYPE $READG(TYPES) {
    radiobutton $W.types.rb$I -text $TYPE \
                -variable READG(TYPE) \
                -highlightbackground [c_dblue] \
                -value $TYPE \
                -bg $READG(C_BG) -font [tku_font tbr12] -height 1 \
		-command reader.f_type_cb
    pack $W.types.rb$I -side top -anchor w -pady 0
    incr I
  }  
  
  set THEIGHT 8
  set TFONT [cbr14]
  if { $READG(HEIGHT) < 768 } {
    set THEIGHT 5 
    set TFONT [tku_font cbr12] 
  }
  frame $W.titles  -bg $READG(C_BG)
  set W_LCOUNT $W.titles.count
  label $W_LCOUNT -bg [c_aqua] -relief groove -bd 2 \
                  -font [cbi14] -text " " 
  set READG(W_LCOUNT) $W_LCOUNT
  set WFL $W.titles.f_list
  set W_TITLES [tku_scrolled_listbox $WFL \
	        "-bg [c_aqua] -height $THEIGHT" \
	        "-bg [c_aqua]"]
  $WFL.list configure -font $TFONT     
  set READG(W_TITLES) $W_TITLES
  pack $W_LCOUNT $WFL -expand 1 -fill both
  bind $W_TITLES <ButtonRelease-1>  [list reader.f_list_cb]
  
  pack $W.types -side left 
  pack $W.titles  -side right 	-expand 1 -fill both
}

proc reader.f_type_cb {} {
   reader.update_display
}

proc reader.f_list_cb {} {
   reader.update_abstract
}

##################################################################
proc reader.show_f_abstract {W} {
  global READG 

  set AHEIGHT 11
  set AFONT [tbr14]
  if { $READG(HEIGHT) < 768 } {
    set AHEIGHT 6 
    set AFONT [tku_font tbr12]
  }
  set WFL $W.label
  if { $READG(HEIGHT) >= 768 } {
    label $WFL -font [tbi18] -bg [c_yellow] -bd 2 -relief groove \
               -text "ABSTRACT" 
    pack $WFL
  }
  set WFT $W.text
  frame $WFT  -bg $READG(C_BG)
  text $WFT.t -yscrollcommand "$WFT.scroll set" \
        -font $AFONT -bg [c_yellow]  -height 11 
  $WFT.t tag configure title \
      -foreground [c_black] -underline 1 -font [tbr18]
  scrollbar $WFT.scroll -command "$WFT.t yview" -bg [c_yellow]
  pack $WFT.scroll -side right -fill y 
  pack $WFT.t -expand 1 -fill both
  set READG(W_ABSTRACT) $WFT.t
  
  pack $WFT    -side top -expand 1 -fill both
}

##################################################################
proc reader.show_f_acro_command {W} {
  global READG 

  set WFACRO $W.acrobat
  frame $WFACRO  -bg $READG(C_BG)
  label $WFACRO.l -text "Acrobat Reader Command :"  \
     -highlightbackground [c_dblue] \
     -bg [c_yellow] -font [cbr14] 
  entry  $WFACRO.e -bg [c_yellow] -font [cbr14] \
         -textvariable READG(ACROBAT_COMMAND) -width 60
  button $WFACRO.b -text "Browse..."  \
     -highlightbackground [c_dblue] \
     -command reader.acro_command_cb \
     -bg [c_yellow] -font [cbr14] 
  pack $WFACRO.b -side right
  pack $WFACRO.l $WFACRO.e -side left -expand 1
       
  pack $WFACRO -side bottom -expand 1 -fill both
}

#####################################################################
proc reader.acro_command_cb {} {
  global READG 
  
  set INITIALDIR "/usr/Acrobat4/bin"
  if { ! [tclu_is_path_dir $INITIALDIR] } {
     set INITIALDIR "/"
  }
  if { $READG(OS) == "nt" } {
     set INITIALDIR "c:/Progra~1/Adobe/Acroba~1.0/Reader"
     if { ! [tclu_is_path_dir $INITIALDIR] } {
        set INITIALDIR "C:/"
     }
  }
  set PATH [tk_getOpenFile -initialdir $INITIALDIR]
  if { [string length $PATH] > 0 } { 
    if { $READG(OS) == "nt" } {
       set READG(ACROBAT_COMMAND) $PATH
    } else {
       set READG(ACROBAT_COMMAND) "$PATH -useFrontEndProgram"
    }
  }
}


##################################################################
proc reader.show_f_control {W} {
  global READG 
  set BFONT [tbr14]
  button $W.b_view    \
         -highlightbackground [c_dblue] \
         -text "View" \
         -bg [c_aqua]  -bd 1 -font [tbr14] \
        -command {reader.cb_b_view}
  button $W.b_copy \
        -text "Copy" \
         -highlightbackground [c_dblue] \
        -bg [c_aqua] -bd 1 -font [tbr14] \
        -command {reader.cb_b_copy}
  button $W.b_help    \
         -highlightbackground [c_dblue] \
         -text "Help" \
         -bg [c_aqua]  -bd 1 -font $BFONT \
        -command {reader.cb_b_help}
  button $W.b_showlog \
        -text "Show Log" \
         -highlightbackground [c_dblue] \
        -bg [c_aqua] -bd 1 -font $BFONT \
        -command {reader.cb_b_showlog}
  button $W.b_quit    \
        -text "Quit"            \
         -highlightbackground [c_dblue] \
        -bg [c_aqua] -bd 1 -font $BFONT \
        -command {reader.cb_b_quit}
  pack  $W.b_view              \
        $W.b_copy              \
	$W.b_help              \
        $W.b_showlog           \
        $W.b_quit              \
        -side left -expand 1
}

#................................................................#
proc reader.cb_b_view {} {
  global READG
  global LI_NAME LI_TYPE LI_FILE LI_PRODUCTS LI_ABSTRACT
   
  reader.save_user_defaults $READG(DEFAULTS_PATH)
  set STATUS [check_if_selected]
  if { $STATUS != 0 } {
     return 
  }
  set FPATH [get_li_file_path $READG(CUR_INDEX)]
  set EXTENSION [file extension $FPATH]
  tclu_log_message "Viewing document $FPATH"     
  switch -- $EXTENSION {
     ".pdf" {
       if { $READG(OS) != "nt" } {
          set COMMAND_LIST [split $READG(ACROBAT_COMMAND)]
          set COMMAND [lindex $COMMAND_LIST 0]
       } else {
          set COMMAND_LIST $READG(ACROBAT_COMMAND)
          set COMMAND $READG(ACROBAT_COMMAND)
       }
       if { ! [tclu_is_path_executable $COMMAND] } {
          set STATUS [install_acrobat_reader COMMAND]
	  if { $STATUS != 0 } {
	    return 
	  }
	  set NEW_COMMAND_LIST $COMMAND
	  if { [llength $COMMAND_LIST] > 1 } {
	     set NEW_COMMAND_LIST \
	        "$NEW_COMMAND_LIST [lrange $COMMAND_LIST 1 end]"
	  }
	  set READG(ACROBAT_COMMAND) $NEW_COMMAND_LIST
          set CHOICE [tku_popup_message info okcancel \
	       "Press OK when installation is complete !"]
          if { $CHOICE != "ok" } {