#=================================================================== # help.tcl -- Web Rouser as an online help system # # Copyright (c) 1997 Eolas Technologies Inc. # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details #=================================================================== # # # This program calls upon several procedures in the "spynergy.tcl" # toolkit to handle rendering and navigation of Web pages from within # a standard test widget. # # These procedures include: # # HB_init {win}: Called with the name of the # text window to be used for rendering the Web page. It sets up # a group of variables that allow GUI widgets to be attached to # the various URL navigational functions in the Spynergy library. # # HB_resolve_url {win url}: Transforms relative URL # pathnames into absolute pathnames that the HTML library functions # can handle. The relative URL is passed as an argument, and the # procedure returns the absolute URL in string form. # # HB_load_url {win url}: Loads the given URL into # the text widget defined by "win" # # HB_home {button_path}: Loads the default home URL # into the text widget specified in HB_init # # HB_back {button_path}: Causes re-loading of the URL which # immediatly preceded the URL being currently viewed, if applicable # # HB_forward {button_path}: If the Back button has been pushed, this # causes re-loading of the URL which immediately follows the URL being # currently viewed # # HB_go_form {button_path}: Causes the display of a scrolling listbox # that displays a "history list" of all of the URLs that the user has # visited. Clicking on any URL in the list will cause that URL to be # immediately fetched and rendered into the text widget defined by HB_init # # HB_Stop {button_path}: This procedure will interrupt the fetching # and rendering of HTML data into the Web browser text widget. # # # # #=================================================================== source spynergy.tcl #global env auto_path num_images images Menu_string # set align_list "" ############################## # Rouser Configuration Section # This section allows you to set several configuration options, such as the default # URL that the browser loads at startup, Whether or not to display the navigation # buttons and URL window, the default color of the HTML document background, # the default color and width of the frame surrounding the Web page, and whether # or not to display a scrollbar at the right of the document window. global ROUSERURL BASE BUTFLAG BORDWID BG global FRMBG SCROLFLAG FILLAREA # -- Rouser configuration variables for .rouser.f1 set ROUSERURL(1) "file://[pwd]/edhelp.htm" set BASE(1) .rouser.main set BUTFLAG(1) "1" set BORDWID(1) "0" set FILLAREA(1) "0" set BG(1) "white" set FRMBG(1) "LightGray" set SCROLFLAG(1) "1" ### End of Rouser Configuration Section ############################## # -- embed_arg override processing for Rouser defaults from within plugin # global embed_args if {[info exists embed_args]} { foreach key [array names embed_args] { set embed_args([string toupper $key]) $embed_args($key) } foreach em_url [array names embed_args ROUSERURL*] { if {$em_url == "ROUSERURL"} { set ROUSERURL(1) "$embed_args($em_url)" } else { set i [string range $em_url 12 end] set ROUSERURL($i) "$embed_args($em_url)" } } unset em_url foreach em_butf [array names embed_args BUTTONS*] { if {$em_butf == "BUTTONS"} { set BUTFLAG(1) "$embed_args($em_butf)" } else { set i [string range $em_butf 7 end] set BUTFLAG($i) "$embed_args($em_butf)" } } unset em_butf foreach em_bord [array names embed_args BORDERWIDTH*] { if {$em_bord == "BORDERWIDTH"} { set BORDWID(1) "$embed_args($em_bord)" } else { set i [string range $em_bord 11 end] set BORDWID($i) "$embed_args($em_bord)" } } unset em_bord foreach em_bg [array names embed_args BACKGROUND*] { if {$em_bg == "BACKGROUND"} { set BG(1) "$embed_args($em_bg)" } else { set i [string range $em_bg 10 end] set BG($i) "$embed_args($em_bg)" } } unset em_bg foreach em_frmbg [array names embed_args FRAMEBACKGROUND*] { if {$em_frmbg == "FRAMEBACKGROUND"} { set FRMBG(1) "$embed_args($em_frmbg)" } else { set i [string range $em_frmbg 15 end] set FRMBG($i) "$embed_args($em_frmbg)" } } unset em_frmbg foreach em_srf [array names embed_args SCROLLBARS*] { if {$em_srf == "SCROLLBARS"} { set SCROLFLAG(1) "$embed_args($em_srf)" } else { set i [string range $em_srf 3 end] set SCROLFLAG($i) "$embed_args($em_srf)" } } unset em_srf foreach em_fill [array names embed_args FILLAREA*] { if {$em_fill == "FILLAREA"} { set FILLAREA(1) "$embed_args($em_fill)" } else { set i [string range $em_fill 8 end] set FILLAREA($i) "$embed_args($em_fill)" } } unset em_srf } ############################## #-----This section sets up the GUI----- #set_option_pattern rouser set Name .rouser catch "destroy .rouser" toplevel $Name -background LightGray wm title $Name "Rouser, the Tcl Web browser" wm geometry $Name 624x447 wm geometry $Name +20+20 set Parent $Name ############################## set Name $Parent.main frame $Name -relief ridge pack $Name -anchor nw -side top -expand yes -fill both set Name $Parent.main.top frame $Name -background LightGray \ -borderwidth 2 \ -height 50 \ -relief raised \ -width 50 pack $Name -side top set Name $Parent.main.top.buttons frame $Name -background LightGray pack $Name -anchor nw \ -expand 1 \ -fill x \ -side top ############################## #-----The Back button----- # set Name $Parent.main.top.buttons.back button $Name -activebackground gray40 \ -activeforeground green \ -background LightGray \ -command "HB_back $Parent.main.top.buttons.back" \ -disabledforeground white \ -foreground black \ -highlightbackground white \ -highlightcolor LightGray \ -padx 5 \ -pady 1 \ -text Back pack $Name -anchor nw \ -fill none \ -side left ############################## #-----The Forward button----- # set Name $Parent.main.top.buttons.forward button $Name -activebackground gray40 \ -activeforeground green \ -background LightGray \ -command "HB_forward $Parent.main.top.buttons.forward" \ -disabledforeground white \ -foreground black \ -highlightbackground white \ -highlightcolor LightGray\ -padx 5 \ -pady 1 \ -text Forward pack $Name -anchor nw \ -fill none \ -side left ############################## #-----The Home button----- # set Name $Parent.main.top.buttons.home button $Name -activebackground gray40 \ -activeforeground green \ -background LightGray \ -command "HB_home $Parent.main.top.buttons.home" \ -disabledforeground white \ -foreground black \ -highlightbackground white \ -highlightcolor LightGray \ -padx 5 \ -pady 1 \ -text Home pack $Name -anchor nw \ -fill none \ -side left ############################## #-----The Go button (pops up the history listbox)----- # set Name $Parent.main.top.buttons.go button $Name -activebackground gray40 \ -activeforeground green \ -background LightGray \ -command "HB_go_form $Parent.main.top.buttons.go" \ -disabledforeground white \ -foreground black \ -highlightbackground white \ -highlightcolor LightGray \ -padx 5 \ -pady 1 \ -text Go pack $Name -anchor nw \ -fill none \ -side left #-----The Stop button----- # set Name $Parent.main.top.buttons.stop button $Name -activebackground gray40 \ -activeforeground red \ -background LightGray \ -command "HB_Stop $Parent.main.top.buttons.stop" \ -disabledforeground white \ -foreground black \ -highlightbackground white \ -highlightcolor LightGray \ -padx 5 \ -pady 1 \ -text Stop pack $Name -anchor nw \ -fill none \ -side left set Name $Parent.main.top.buttons.l22 label $Name -anchor w \ -background LightGray \ -foreground white \ -justify left pack $Name -anchor nw \ -fill none \ -side left set Name $Parent.main.top.buttons.status label $Name -anchor w \ -background LightGray \ -foreground white \ -justify left pack $Name -anchor nw \ -fill none \ -side left ############################## # -----The Close button----- set Name $Parent.main.top.buttons.exit button $Name -activebackground lavender \ -background LightGray \ -command {wm withdraw .rouser} \ -foreground black \ -highlightbackground LightGray \ -text Close pack $Name -anchor nw -side right set Name $Parent.main.top.ubar frame $Name -background LightGray pack $Name -anchor nw \ -expand 1 \ -fill x \ -side top ############################## #-----The URL label to the left of the URL entry widget----- # set Name $Parent.main.top.ubar.l13 label $Name -background LightGray \ -foreground black \ -text URL: pack $Name -anchor w \ -side left ############################## #----The URL entry widget------ # set Name $Parent.main.top.ubar.url entry $Name -background white \ -highlightbackground LightGray \ -highlightcolor cyan \ -selectbackground skyblue \ -width 0 pack $Name -anchor nw \ -expand yes \ -fill x \ -side left set Name $Parent.main.txt frame $Name -background LightGray \ -borderwidth 2 \ -highlightbackground lightgray \ -relief raised pack $Name -anchor nw \ -expand 1 \ -fill both \ -side top ############################## #-----The text widget that displays the Web document----- # set Name $Parent.main.txt.win text $Name -background white \ -cursor arrow \ -foreground black \ -height 100 \ -highlightbackground lightgray \ -insertbackground black \ -selectbackground LightGray \ -selectforeground black \ -takefocus 0 \ -width 20 \ -yscrollcommand "$Parent.main.txt.scroll set" $Name insert end { } pack $Name -anchor nw \ -expand 1 \ -fill both \ -padx 2 \ -pady 2 \ -side left set Name $Parent.main.txt.scroll scrollbar $Name -activebackground plum \ -activerelief sunken \ -background LightGray \ -command "$Parent.main.txt.win yview" \ -highlightbackground LightGray \ -troughcolor gray40 -width 16 pack $Name -anchor center \ -fill y \ -padx 2 \ -pady 2 \ -side right set win $Parent.main.txt.win global _url set base .rouser.main set _url($win~~statuslabel) "$base.top.buttons.status" set _url($win~~entrywidget) "$base.top.ubar.url" set _url($win~~backbut) "$base.top.buttons.back" set _url($win~~forwardbut) "$base.top.buttons.forward" set _url($win~~homebut) "$base.top.buttons.home" set _url($win~~gobut) "$base.top.buttons.go" set _url($win~~stopbut) "$base.top.buttons.stop" ############################## # ----- Load HTML into the browser text widget ------- # proc LoadHTML {w url} { global _url HB_init $w if {$url != ""} { $_url($w~~entrywidget) configure -text $url update set urllist [HB_resolve_url $w $url] HB_load_url $w [lindex $urllist 0] [lindex $urllist 1] 1 if {[lindex $urllist 1] != ""} {HMgoto [lindex $urllist 1]} } } ############################## # ----- Post browser text widget ------- # if {!$BUTFLAG(1)} { pack forget .rouser.main.top } else { pack .rouser.main.top -before .rouser.main.txt -anchor nw -expand 1 -fill x -side top } if {!$SCROLFLAG(1)} { pack forget .rouser.main.txt.scroll } else { pack .rouser.main.txt.scroll -after .rouser.main.txt.win -anchor center -expand 0 -fill y -padx 2 -pady 2 -side right } .rouser.main configure -borderwidth $BORDWID(1) .rouser.main.txt configure -background $FRMBG(1) .rouser.main.txt.win configure -background $BG(1) if {$FILLAREA(1)} { place .rouser.f1 -x 0 -y 0 -width 0 -height 0 -relx 0 -rely 0 -relwidth 1.0 -relheight 1.0 -anchor nw } update if {$ROUSERURL(1) != ""} { LoadHTML .rouser.main.txt.win "$ROUSERURL(1)" } # #------< End of File >-----