Source code for the Web Rouser with GUI enhancements. This application requires the Spynergy Toolkit.

#===================================================================
# Web Rouser(TM) -- The Tcl Web browser
#  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.
# 
#
#
#
#===================================================================
source spynergy.tcl

# icon image data

set back {
R0lGODlhEAAQAPcAAAAAAAAAWgAAewAAqgAArQAA/wBKSgBzcwCUlACtrQC9vQDW1gD39wD/QgD/
/wgICBAQEBBCABBCEBBKABBKEBgYGBhCEBhKECEhISkpKSmMECmUECmUGDExMTGMEDGUGDk5OTm9
EDm9GDnGEEIhKUJCQkK9EELGEELWGEohKUrWIVpaWlpaY1pjWlrvMWNjY2PvMWPvOXNzc3t7e4SE
hIyMjJSMjJSMlJSUlJylpaWcpaWlpa3/lLWttbW1rbW1tbXOzrX/nL29vcbGrb+//8b/vcDAwN7e
3v8AAP//////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAEYALAAAAAAQABAA
AAhEAI0IHEiwoEGBAw4eHJBQIUGGDR0aYUgkokKKFSEyLIiRiMePFjt+BMlxwMiRFhGazKhxocmU
FzdKHChzJkKbOHMaCQgAOw==
}

set forward { 
R0lGODlhEAAQAPcAAAAAAAAAWgAAewAAqgAArQAA/wBKSgBzcwCUlACtrQC9vQDW1gD39wD/QgD/
/wgICBAQEBBCABBCEBBKABBKEBgYGBhCEBhKECEhISkpKSmMECmUECmUGDExMTGMEDGUGDk5OTm9
EDm9GDnGEEIhKUJCQkK9EELGEELWGEohKUrWIVpaWlpaY1pjWlrvMWNjY2PvMWPvOXNzc3t7e4SE
hIyMjJSMjJSMlJSUlJylpaWcpaWlpa3/lLWttbW1rbW1tbXOzrX/nL29vcbGrb+//8b/vc7Ozt7e
3v8AAMDAwP//////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAEkALAAAAAAQABAA
AAhEAJMIHEiwoMGBAw4qHJBQYUGGDR0KHECE4UGIEIlUjIhQo0ePFglS/Pgx5ESSIDkmwchQo8mF
GyVOfOmQZk2ZOHMODAgAOw==
}

set home {
R0lGODlhEAAQAPcAAAAAAAAAWgAAewAAqgAArQAA/wBKSgBzcwCUlACtrQC9vQDW1gD39wD/QgD/
/wgICBAQEBBCABBCEBBKABBKEBgYGBhCEBhKECEhISkpKSmMECmUECmUGDExMTGMEDGUGDk5OTm9
EDm9GDnGEEIhKUJCQkK9EELGEELWGEohKUrWIVpaWlpaY1pjWlrvMWNjY2PvMWPvOXNzc3t7e4SE
hIyMjJSMjJSMlJSUlJylpaWcpaWlpa3/lLWttbW1rbW1tbXOzrX/nL29vcbGrb+//8b/vcDAwN7e
3v8AAP//////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAEYALAAAAAAQABAA
AAhPAI0IHGhkAMGDBwcoFLgQYcEBRBY2TAiRSESFBila3IhR40aOGRlW/AhSJMmTEkeetNhQ5cqQ
KjF+hDlT4cyBMW1yxFkzJk6MQIM6HDowIAA7
}

set go {
R0lGODlhEAAQAPcAAAAAAAAAWgAAewAAnAAArQAA/wBKSgBzcwCUlACtrQC9vQDW1gD39wD/QgD/
/wgICBAQEBBCABBCEBBKABBKEBgYGBhCEBhKECEhISkpKSmMECmUECmUGDExMTGMEDGUGDk5OTm9
EDm9GDnGEEIhKUJCQkK9EELGEELWGEohKUrWIVpaWlpaY1pjWlrvMWNjY2PvMWPvOXNzc3t7e4SE
hIyMjJSMjJSMlJSUlJylpaWcpaWlpa3/lLWttbW1rbW1tbXOzrX/nMDAwMbGrcbG/8b/vc7Ozt7e
3v8AAP//////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAEIALAAAAAAQABAA
AAhRAIUIHEiwoEEaCBEaJEgDgEOHNBYKadigYkUAEQtStGgRI0MAHEN6FLgx5MWME0GaPDmwpMmR
KVeyJKlyJcyYL1G2rDnz4EOIEkkm1Bk0aEAAADs=
}

set stop {
R0lGODlhEAAQAPcAAAAAAAAAWgAAewAAnAAArQAA/wBKSgBzcwCUlACtrQC9vQDW1gD39wD/QgD/
/wgICBAQEBBCABBCEBBKABBKEBgYGBhCEBhKECEhISkpKSmMECmUECmUGDExMTGMEDGUGDk5OTm9
EDm9GDnGEEIhKUJCQkK9EELGEELWGEohKUrWIVpaWlpaY1pjWlrvMWNjY2PvMWPvOXNzc3t7e4SE
hIyMjJSMjJSMlJSUlJylpaWcpaWlpa3/lLWttbW1rbW1tbXOzrX/nMDAwMbGrcbG/8b/vc7Ozt7e
3v8AAP//////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAEIALAAAAAAQABAA
AAhRAIUIHEiwoEEaCBEaJEgDgEOHNBYKaYikYkUAEQtStGgRI0MAHEN6FLgx5MWME0GaPDmwpMmR
KVeyJKlyJcyYL1G2rDnz4EOIEkkm1Bk0aEAAADs=
}

set exit {
R0lGODlhEAAQAPcAAAAA/wgI/xAQ/yEh9ykp9zk572Nj3nNz3oyM1qWlzq2txrW1xsbGxtbW1v//
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////yH5BAEAAAwALAAAAAAQABAA
AAhvABksEEhwoMGCAxkoXMiw4cKEBBVCTGhwQcWDDw8AAICAAYKNBwRiZDAAgIAEAgAQcLgQ5caN
CRhaLKhxo4GHEAkWeFmgoESJH01u7BhxoYKUA0ia9Jlw50kGLnvmnCrT58+HV6tanMn16kiKBAMC
ADs=
}




##############################
# Web 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.

# http://www.eolas.com/spynergy/tcltk.htm

global ROUSERURL BASE BUTFLAG BORDWID BG
global FRMBG SCROLFLAG FILLAREA
# -- Web 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 Web Rouser Configuration Section


##############################
# -- embed_arg override processing for Web 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
}


proc construct_menu {Name label cmd_list} {
   global _ED

   menubutton $Name  -activebackground gray -activeforeground white \
       -background Lightgray -foreground black -relief flat -text $label  -underline 0
   
   incr _ED(menuCount);
   set newmenu $Name.m$_ED(menuCount)

   $Name configure -menu $newmenu

   ;# Delete any old window that may be around from previous runs
   catch "destroy $newmenu"
  
   ;# Create the new menu

   eval "menu $newmenu"

   eval [list add_items_to_menu $newmenu $cmd_list]

   $newmenu configure -activebackground gray -activeforeground white \
      -background Lightgray -foreground black
   pack $Name -anchor nw -expand 0 -ipadx 4 -ipady 0 -padx 0 \
         -pady 0 -side top

  }

proc add_items_to_menu {menubutton cmdList} {
	global _ED

  ;# Evaluate each line in the cmdList

  foreach cmd $cmdList {
    switch [lindex $cmd 0] {
      "separator" {
         set doit "$menubutton add separator [lindex $cmd 2]"
	 eval $doit
         }
      "tearoff"  {
         if {[string match [lindex $cmd 2] "no"]} {
	   $menubutton configure -tearoff no
	   }
         }
      "command"  {
         set doit "$menubutton add [lindex $cmd 0] -label {[lindex $cmd 1]} \
	     [lindex $cmd 2]"
	 eval $doit
         }
      "cascade"  {
         incr _ED(menuCount);
	 set newmenu $menubutton.m$_ED(menuCount)
         set doit "$menubutton add cascade -label {[lindex $cmd 1]} \
	 	-menu $newmenu"
	 eval $doit 
	 menu $newmenu
	 add_items_to_menu $newmenu [lindex $cmd 2]
         }
      }
    }
  }


proc construct_button {Name data file cmd} {

if {[catch "set im [image create photo -data $data -gamma 1 -height 16 -width 16 -palette 5/5/4]"]} { 
set im  [image create photo -file $file -gamma 1 -height 16 -width 16 -palette 5/5/4] 
	}	  
  
button $Name -background LightGray -foreground black -activebackground white -image $im \
         -relief raised -command "$cmd"
   pack $Name -anchor nw -side left -expand 0  -fill x 
  }



##############################

set Name .rouser
catch "destroy .rouser"
    toplevel $Name     -background LightGray
    wm title $Name "Web Rouser(TM), 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.menu
frame $Name     -background LightGray
pack $Name     -anchor nw \
    -expand 1 \
    -fill both \
    -side top





set _ED(menuCount) 1
set Name $Parent.main.top.menu.file
   set Menu_string($Name) {
     {{command} {Open File} {-command "open_file" -accelerator "Ctrl+F" -underline 0}}
     {{command} {Exit} {-command "exit" -accelerator "Ctrl+X" -underline 1}}
     }

construct_menu $Name File $Menu_string($Name)
pack $Name -side left



set Name $Parent.main.top.menu.go
   set Menu_string($Name) {
     {{command} {Back} {-command "HB_back .rouser.main.top.buttons.back" -accelerator "Ctrl+B" -underline 0}}
     {{command} {Forward} {-command "HB_forward .rouser.main.top.buttons.forward" -accelerator "Ctrl+F" -underline 0}}
     {{command} {Home} {-command "HB_home .rouser.main.top.buttons.home" -accelerator "Ctrl+H" -underline 0}}
     {{command}  {Go} {-command "HB_go_form .rouser.main.top.buttons.go" -accelerator "Ctrl+G" -underline 0}}
     {{command}  {Stop} {-command "HB_Stop .rouser.main.top.buttons.stop" -accelerator "Ctrl+P" -underline 0}}
	}

construct_menu $Name Go $Menu_string($Name)
pack $Name -side left


set Name $Parent.main.top.menu.options
set Menu_string($Name) {
     {{command} {Set Home URL} {-command "rouse_set_url" -accelerator "Ctrl+U" -underline 0}}
     {{command} {Colors} {-command "rouse_set_color" -accelerator "Ctrl+C" -underline 2}}
     {{command} {Hide Buttons} {-command "change_buttons" -accelerator "Ctrl+S" -underline 0}}
     }

construct_menu $Name Options $Menu_string($Name)
pack $Name -side left




set Name $Parent.main.top.buttons
frame $Name     -background LightGray
pack $Name     -anchor nw \
    -expand 1 \
    -fill x \
    -side top

##############################
#-----The Back button-----
#

construct_button $Parent.main.top.buttons.back $back r_back.ppm "HB_back $Parent.main.top.buttons.back" 

construct_button $Parent.main.top.buttons.forward $forward r_for.ppm "HB_forward $Parent.main.top.buttons.forward" 


construct_button $Parent.main.top.buttons.home $home r_home.ppm "HB_home $Parent.main.top.buttons.home" 

construct_button $Parent.main.top.buttons.go $go r_go.ppm "HB_go_form $Parent.main.top.buttons.go" 

construct_button $Parent.main.top.buttons.stop $stop r_stop.ppm "HB_Stop $Parent.main.top.buttons.stop" 

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

##############################

construct_button $Parent.main.top.buttons.exit $exit r_exit.ppm "exit" 
pack $Parent.main.top.buttons.exit -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 level

	set base .rouser.main 
	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]}
    }
}


proc rouse_set_url { } {

global ROUSERURL(1)

catch "destroy .url"

toplevel .url 
wm title .url "Set URL"


set Parent .url

set Name $Parent.f1
frame $Name -background lightgray
pack $Name -anchor nw -fill x -side top -padx 5
	
	#-------------------------------------------------------
	# Create an entry field for the user to enter a URL	
	#-------------------------------------------------------

	set Name $Parent.f1.e1
	entry $Name  -background aliceblue  \
			-highlightbackground LightGray     \
			-selectbackground blue \
			-selectforeground white -width 30
	pack $Name -anchor nw -side right

	#-------------------------------------------------------
	# Create a list of bindings to let user delete text
	#-------------------------------------------------------


	bind .url.f1.e1  {
		if [%W selection present] {
			%W delete sel.first sel.last
		} else {
			%W delete insert
		}
	}


	#-------------------------------------------------------
	# Bind the Return key to the same commands as the Get URL button	
	#-------------------------------------------------------

	bind .url.f1.e1  {
				set ROUSERURL(1) [.url.f1.e1 get]
                        destroy .url  
				 LoadHTML .rouser.main.txt.win "$ROUSERURL(1)"
				
			}

	#-------------------------------------------------------
	# Delete any text in the entry field	
	#-------------------------------------------------------

	$Name delete 0 end

	#-------------------------------------------------------
	# Create a frame that holds the buttons
	#-------------------------------------------------------

	set Name $Parent.mainwin
	frame $Name -background lightgray
	pack $Name -anchor nw -side top -fill x -padx 5 -pady 5


	set Name $Parent.mainwin.b1
	button $Name  -activebackground lavender -background navy \
			-command {
			   	set ROUSERURL(1)[.url.f1.e1 get]
				destroy .url
				 LoadHTML .rouser.main.txt.win "$ROUSERURL(1)"
				}  \
			-foreground white -highlightbackground LightGray \
			-text {Set Home URL}
	pack $Name -anchor nw -side left

	
	#-------------------------------------------------------
	# Creates Cancel button that destroys the dialog box
	#-------------------------------------------------------

	set Name $Parent.mainwin.b2
	button $Name  -activebackground Lavender -background navy \
			-command {destroy .url} -foreground white \
                        -highlightbackground LightGray -text Cancel
	pack $Name -anchor nw -side right

	#-------------------------------------------------------
	# Creates the geometry for the  window
	#-------------------------------------------------------

	set x [expr [winfo rootx .rouser] + 300]
	set y [expr [winfo rooty .rouser] + \
			[winfo height .rouser] - 300]
	wm geometry .url +$x+$y
	wm deiconify .url

	#-------------------------------------------------------
	# Raises the window to appear in front of the other 
	# windows
	#-------------------------------------------------------

	raise .url
	update
	wm minsize .url [winfo width .url] \
			[winfo height .url]
	wm maxsize .url [winfo width .url] \
				[winfo height .url]
}


proc open_file { } {

catch "destroy .openf"

toplevel .openf
wm title .openf "Open File"


set Parent .openf

set Name $Parent.f1
frame $Name -background lightgray
pack $Name -anchor nw -fill x -side top -padx 5
	
	set Name $Parent.f1.e1
	entry $Name  -background aliceblue  \
			-highlightbackground LightGray     \
			-selectbackground blue \
			-selectforeground white -width 30
	pack $Name -anchor nw -side right


	bind .openf.f1.e1  {
		if [%W selection present] {
			%W delete sel.first sel.last
		} else {
			%W delete insert
		}
	}


	#-------------------------------------------------------
	# Bind the Return key to the same commands as the Go to button	
	#-------------------------------------------------------

	bind .openf.f1.e1  {
				 LoadHTML .rouser.main.txt.win  [.openf.f1.e1 get]
				destroy .openf
			}

	#-------------------------------------------------------
	# Delete any text in the entry field	
	#-------------------------------------------------------

	$Name delete 0 end

	#-------------------------------------------------------
	# Create a frame that holds the buttons
	#-------------------------------------------------------

	set Name $Parent.mainwin
	frame $Name -background lightgray
	pack $Name -anchor nw -side top -fill x -padx 5 -pady 5


	set Name $Parent.mainwin.b1
	button $Name  -activebackground lavender -background navy \
			-command {
				 LoadHTML .rouser.main.txt.win  [.openf.f1.e1 get]
				destroy .openf
				} \
			-foreground white -highlightbackground LightGray \
			-text {Open File}
	pack $Name -anchor nw -side left

	
	#-------------------------------------------------------
	# Creates Cancel button that destroys the dialog box
	#-------------------------------------------------------

	set Name $Parent.mainwin.b2
	button $Name  -activebackground Lavender -background navy \
			-command {destroy .openf} -foreground white \
                        -highlightbackground LightGray -text Cancel
	pack $Name -anchor nw -side right

	#-------------------------------------------------------
	# Creates the geometry for the Get URL window
	#-------------------------------------------------------

	set x [expr [winfo rootx .rouser] + 300]
	set y [expr [winfo rooty .rouser] + \
			[winfo height .rouser] - 300]
	wm geometry .openf + $x + $y
	wm deiconify .openf

	#-------------------------------------------------------
	# Raises the Get URL window to appear in front of the other 
	# windows
	#-------------------------------------------------------

	raise .openf
	update
	wm minsize .openf [winfo width .openf] \
			[winfo height .openf]
	wm maxsize .url [winfo width .openf] \
				[winfo height .openf] \
}

set hide 1
proc change_buttons { } { 
global hide

if {!$hide} {
	pack .rouser.main.top.buttons -before .rouser.main.top.ubar -anchor nw -expand 1 -fill x -side top
     .rouser.main.top.menu.options.m4 entryconfigure 3 -label "Hide Buttons"
      set hide 1
} else {
    pack forget .rouser.main.top.buttons	
    .rouser.main.top.menu.options.m4 entryconfigure 3 -label "Show Buttons"
     set hide 0			
   }	
}


proc rouse_set_color { } {
catch "destroy .colorf"

toplevel .colorf
wm title .colorf "Change colors"


set Parent .colorf
wm withdraw .colorf

	set Name $Parent.radios
	frame $Name -background lightgray 
	pack $Name -side top -pady 5 -padx 5

	set Name $Parent.radios.mainwin1
	frame $Name -background lightgray
	pack $Name -anchor nw -side left -fill x -padx 5 -pady 5

	set Name $Parent.radios.mainwin2
	frame $Name -background lightgray
	pack $Name -anchor nw -side left -fill x -padx 5 -pady 5

	set Name $Parent.radios.mainwin1.label
	label $Name -background lightgray -text Background
	pack $Name -anchor nw -side top 

	set Name $Parent.radios.mainwin1.rb1
	radiobutton $Name  -background lightgray -text White -variable bgcolor -value white
	pack $Name -side top -anchor nw
	
	set Name $Parent.radios.mainwin1.rb2
	radiobutton $Name  -background lightgray -text Blue -variable bgcolor -value lightblue
	pack $Name -side top	 -anchor nw

	set Name $Parent.radios.mainwin1.rb3
	radiobutton $Name  -background lightgray -text Gray -variable bgcolor -value lightgray
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin1.rb4
	radiobutton $Name  -background lightgray -text Yellow -variable bgcolor -value yellow
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin1.rb5
	radiobutton $Name  -background lightgray -text Pink -variable bgcolor -value pink
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin1.rb6
	radiobutton $Name  -background lightgray -text Lavender -variable bgcolor -value lavender
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin1.b1
	button $Name  -activebackground lavender -background navy \
			-command {
				 .rouser.main.txt.win configure -background $bgcolor
				} \
			-foreground white -highlightbackground LightGray \
			-text {Select background}
	pack $Name -anchor sw -side left

	



	set Name $Parent.radios.mainwin2.label
	label $Name -background lightgray -text Frame
	pack $Name -anchor nw -side top 

	set Name $Parent.radios.mainwin2.rb1
	radiobutton $Name  -background lightgray -text White -variable frmcolor -value white
	pack $Name -side top -anchor nw
	
	set Name $Parent.radios.mainwin2.rb2
	radiobutton $Name  -background lightgray -text Blue -variable frmcolor -value lightblue
	pack $Name -side top -anchor nw	

	set Name $Parent.radios.mainwin2.rb3
	radiobutton $Name  -background lightgray -text Gray -variable frmcolor -value lightgray
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin2.rb4
	radiobutton $Name  -background lightgray -text Yellow -variable frmcolor -value yellow
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin2.rb5
	radiobutton $Name  -background lightgray -text Pink -variable frmcolor -value pink
	pack $Name -side top -anchor nw

	set Name $Parent.radios.mainwin2.rb6
	radiobutton $Name  -background lightgray -text Lavender -variable frmcolor -value lavender
	pack $Name -side top -anchor nw



	set Name $Parent.radios.mainwin2.b1
	button $Name  -activebackground lavender -background navy \
			-command {
				 .rouser.main.txt configure -background $frmcolor
				} \
			-foreground white -highlightbackground LightGray \
			-text {Select frame}
	pack $Name -anchor sw -side left

	
	#-------------------------------------------------------
	# Creates Cancel button that destroys the dialog box
	#-------------------------------------------------------


	set Name $Parent.buttons
	frame $Name -background lightgray
	pack $Name -side bottom -pady 5 -expand 1 -fill x


	set Name $Parent.buttons.b3
	button $Name  -activebackground Lavender -background navy \
			-command {
			destroy .colorf
			} -foreground white \
                        -highlightbackground LightGray -text OK
	pack $Name -anchor center -side left

	set Name $Parent.buttons.b2
	button $Name  -activebackground Lavender -background navy \
			-command {
			.rouser.main.txt configure -background $FRMBG(1)
			.rouser.main.txt.win configure -background $BG(1)
			destroy .colorf
			} -foreground white \
                        -highlightbackground LightGray -text Cancel
	pack $Name -anchor center -side right




	set x [expr [winfo rootx .rouser] + 300]
	set y [expr [winfo rooty .rouser] + \
			[winfo height .rouser] - 300]
	wm geometry .colorf +$x+$y
	wm deiconify .colorf
	raise .colorf
	update
	wm minsize .colorf [winfo width .colorf] \
			[winfo height .colorf]
	wm maxsize .url [winfo width .colorf] \
				[winfo height .colorf] \

}



##############################
# ----- 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 >-----