#=================================================================== # Wrouser -- The Tcl Web browser with Weather status display # by Mike Doyle # # 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. # # # # #=================================================================== ######################################### # Fetch the weather map # proc fetch_map {} { global weather fetcherr wm title .rouser "WRouser: Fetching weather map" catch "fetchURL -url http://www.weatherpoint.com/wximages/jotrad.gif -outfile weathermap.gif" if {[info exists $weather]} {image delete $weather} catch "set weather [image create photo -file "weathermap.gif" -gamma 1 -height 484 -width 756 -palette 5/5/4]" .rouser.main.top.buttons.show_weather.win.label configure -image $weather wm title .rouser "WRouser: The Tcl weather center" after 900000 fetch_map } proc show_time {} { wm title .rouser.main.top.buttons.show_weather.win "Doppler Radar: Illinois -- Updates every 15 minutes -- [clock format [clock seconds]]" after 1000 show_time } source spynergy.tcl ############################## # Rouser Configuration Section # This section allows you to set several configuration options, such as the default # URL that the browser loads at satartup, 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 weather # -- Rouser configuration variables for .rouser.f1 set ROUSERURL(1) "http://www.eolas.com" 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 Name .rouser catch "destroy .rouser" toplevel $Name -background LightGray wm title $Name "Wrouser, the Tcl Web browser" wm geometry $Name 624x447 wm geometry $Name +20+20 wm withdraw $Name 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 gray40 \ -command "HB_back $Parent.main.top.buttons.back" \ -disabledforeground LightGray \ -foreground White \ -highlightbackground LightGray \ -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 gray40 \ -command "HB_forward $Parent.main.top.buttons.forward" \ -disabledforeground LightGray \ -foreground White \ -highlightbackground LightGray \ -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 gray40 \ -command "HB_home $Parent.main.top.buttons.home" \ -disabledforeground LightGray \ -foreground White \ -highlightbackground LightGray \ -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 gray40 \ -command "HB_go_form $Parent.main.top.buttons.go" \ -disabledforeground LightGray \ -foreground White \ -highlightbackground LightGray \ -highlightcolor LightGray \ -padx 5 \ -pady 1 \ -text Go pack $Name -anchor nw \ -fill none \ -side left ############################## #-----The Show Weather button----- # set Name $Parent.main.top.buttons.show_weather set show_weather 1 set weather "" button $Name -activebackground gray40 \ -activeforeground green \ -background gray40 \ -command { if {$show_weather} { wm deiconify .rouser.main.top.buttons.show_weather.win raise .rouser.main.top.buttons.show_weather.win .rouser.main.top.buttons.show_weather configure -text "Hide Weather" set show_weather 0 } else { wm withdraw .rouser.main.top.buttons.show_weather.win .rouser.main.top.buttons.show_weather configure -text "Show Weather" set show_weather 1 } } \ -disabledforeground LightGray \ -foreground White \ -highlightbackground LightGray \ -highlightcolor LightGray \ -padx 5 \ -pady 1 \ -text "Show Weather" pack $Name -anchor nw -fill none -side left toplevel $Name.win -background LightGray wm title $Name.win "Rouser Doppler Radar -- Updates every 15 minutes" wm withdraw $Name.win show_time label $Name.win.label -border 0 pack $Name.win.label $Name.win.label configure -image $weather button $Name.win.closebut -text Close -command { wm withdraw .rouser.main.top.buttons.show_weather.win pack forget .rouser.main.top.buttons.hide_weather pack .rouser.main.top.buttons.show_weather -anchor nw -fill none -side left \ -before .rouser.main.top.buttons.stop } pack $Name.win.closebut -side right -anchor e button $Name.win.refresh -text "Refresh Now" -command { fetchURL -url http://www.weatherpoint.com/wximages/jotrad.gif -outfile weathermap.gif image delete $weather set weather [image create photo -file "weathermap.gif" -gamma 1 -height 484 -width 756 -palette 5/5/4] .rouser.main.top.buttons.show_weather.win.label configure -image $weather } pack $Name.win.refresh -side left -anchor e fetch_map ################################ #-----The Stop button----- # set Name $Parent.main.top.buttons.stop button $Name -activebackground gray40 \ -activeforeground red \ -background gray40 \ -command "HB_Stop $Parent.main.top.buttons.stop" \ -disabledforeground LightGray \ -foreground White \ -highlightbackground LightGray \ -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 Exit button----- set Name $Parent.main.top.buttons.exit button $Name -activebackground lavender \ -background gray40 \ -command exit \ -foreground white \ -highlightbackground LightGray \ -text Exit 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 ############################## # Sets the global _url variables to use # with the Spynergy Toolkit procedures # ------------------------------------- set win $Parent.main.txt.win 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 ------- # wm deiconify .rouser 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 >-----