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