1
namespace eval hv3 { set {version($Id: hv3_main.tcl,v 1.190 2008/03/02 14:43:49 danielk1977 Exp $)} 1 }
5
proc sourcefile {file} [string map \
6
[list %HV3_DIR% [file dirname [info script]]] \
8
return [file join {%HV3_DIR%} $file]
11
# Before doing anything else, set up profiling if it is requested.
12
# Profiling is only used if the "-profile" option was passed on
14
source [sourcefile hv3_profile.tcl]
15
::hv3::profile::init $argv
19
package require Tkhtml 3.0
21
# If possible, load package "Img". Without it the script can still run,
22
# but won't be able to load many image formats.
24
if {[catch { package require Img } errmsg]} {
25
puts stderr "WARNING: $errmsg (most image types will fail to load)"
28
source [sourcefile hv3_browser.tcl]
30
namespace eval ::hv3 {
31
set log_source_option 0
32
set reformat_scripts_option 0
35
# This class is used to create toplevel "sub-window" widgets. Sub-windows
36
# are toplevel windows that contain a single [::hv3::browser] object.
38
# Sub-windows are different from the main window in several ways:
40
# * There is no menubar.
41
# * There is no "new tab", "home" or "bug report button on the toolbar.
42
# * It is not possible to open new tabs in a sub-window.
44
# These restrictions are because Hv3 is a tabbed browser. New views are
45
# supposed to live in tabs, not separate toplevel windows. If the user
46
# really wants more than one window, more than one copy of the browser
47
# should be started. Sub-windows are provided purely for the benefit of
48
# those javascript applications that have UIs that require multiple
51
namespace eval ::hv3::subwindow {
58
set O(browser) [::hv3::browser $O(win).browser]
59
set O(label) [::hv3::label $O(win).label -anchor w -width 1]
60
set O(location) [::hv3::locationentry $O(win).location]
62
set O(stop_button) $O(win).stop
63
set O(back_button) $O(win).back
64
set O(next_button) $O(win).next
66
::hv3::toolbutton $O(stop_button) -text {Stop} -tooltip "Stop"
67
::hv3::toolbutton $O(next_button) -text {Forward} -tooltip "Go Forward"
68
::hv3::toolbutton $O(back_button) -text {Back} -tooltip "Go Back"
70
grid $O(back_button) $O(next_button) $O(stop_button)
71
grid $O(location) -column 3 -row 0 -sticky ew
72
grid $O(browser) -column 0 -row 1 -sticky nsew -columnspan 4
73
grid $O(label) -column 0 -row 2 -sticky nsew -columnspan 4
75
grid columnconfigure $O(win) 3 -weight 1
76
grid rowconfigure $O(win) 1 -weight 1
78
$O(back_button) configure -image hv3_previmg
79
$O(next_button) configure -image hv3_nextimg
80
$O(stop_button) configure -image hv3_reloadimg
82
$O(label) configure -textvar [$O(browser) statusvar]
83
$O(browser) configure -stopbutton $O(stop_button)
84
$O(browser) configure -forwardbutton $O(next_button)
85
$O(browser) configure -backbutton $O(back_button)
86
$O(browser) configure -locationentry $O(location)
87
$O(location) configure -command [list $me GotoLocation]
89
$O(browser) configure -width 600 -height 400
91
set O(titlevarname) [$O(browser) titlevar]
92
set O(locationvarname) [$O(browser) locationvar]
94
# Set up traces on the browser title and location. Use these to
95
# set the title of the toplevel window.
96
trace add variable $O(titlevarname) write [list $me SetTitle]
97
trace add variable $O(locationvarname) write [list $me SetTitle]
100
proc SetTitle {me args} {
102
set T [set [$O(browser) titlevar]]
104
set T [set [$O(browser) locationvar]]
111
trace remove variable $O(titlevarname) write [list $me SetTitle]
112
trace remove variable $O(locationvarname) write [list $me SetTitle]
117
$O(browser) goto $uri
120
proc GotoLocation {me} {
122
set uri [$O(location) get]
123
$O(browser) goto $uri
126
::hv3::make_constructor ::hv3::subwindow toplevel
130
# An instance of this class manages the application "View" menu,
131
# which contains all the runtime configuration options (font size,
132
# image loading etc.).
134
snit::type ::hv3::config {
136
# The SQLite database containing the configuration used
137
# by this application instance.
140
variable myPollActive 0
142
foreach {opt def type} [list \
143
-enableimages 1 Boolean \
144
-enablejavascript 0 Boolean \
145
-forcefontmetrics 1 Boolean \
148
-fontscale 1.0 Double \
149
-guifont 11 Integer \
150
-icons default_icons Icons \
151
-debuglevel 0 Integer \
152
-fonttable [list 8 9 10 11 13 15 17] SevenIntegers \
154
option $opt -default $def -validatemethod $type -configuremethod SetOption
157
constructor {db args} {
164
CREATE TABLE cfg_options1(name TEXT PRIMARY KEY, value);
168
foreach {n v} [array get options] {
169
$myDb eval {INSERT INTO cfg_options1 VALUES($n, $v)}
171
if {[llength [info commands ::tkhtml::heapdebug]] > 0} {
172
$self configure -debuglevel 1
175
$myDb eval {SELECT name, value FROM cfg_options1} {
176
set options($name) $value
177
if {$name eq "-guifont"} {
178
after idle [list ::hv3::SetFont [list -size $value]]
184
::hv3::$options(-icons)
186
$self configurelist $args
187
after 2000 [list $self PollConfiguration]
190
method PollConfiguration {} {
193
foreach n [array names options] {
194
$myDb eval { SELECT value AS v FROM cfg_options1 WHERE name = $n } {
195
if {$options($n) ne $v} {
196
$self configure $n $v
202
after 2000 [list $self PollConfiguration]
205
method populate_menu {path} {
207
# Add the 'Gui Font (size)' menu
208
::hv3::menu ${path}.guifont
209
$self PopulateRadioMenu ${path}.guifont -guifont [list \
218
$path add cascade -label {Gui Font} -menu ${path}.guifont
220
# Add the 'Icons' menu
221
::hv3::menu ${path}.icons
222
$self PopulateRadioMenu ${path}.icons -icons [list \
223
grey_icons "Great looking classy grey icons" \
224
color_icons22 "22x22 Tango icons" \
225
color_icons32 "32x32 Tango icons" \
227
$path add cascade -label {Gui Icons} -menu ${path}.icons
229
$self populate_hidegui_entry $path
232
# Add the 'Zoom' menu
233
::hv3::menu ${path}.zoom
234
$self PopulateRadioMenu ${path}.zoom -zoom [list \
245
$path add cascade -label {Browser Zoom} -menu ${path}.zoom
247
# Add the 'Font Scale' menu
248
::hv3::menu ${path}.fontscale
249
$self PopulateRadioMenu ${path}.fontscale -fontscale [list \
257
$path add cascade -label {Browser Font Scale} -menu ${path}.fontscale
259
# Add the 'Font Size Table' menu
260
set fonttable [::hv3::menu ${path}.fonttable]
261
$self PopulateRadioMenu $fonttable -fonttable [list \
262
{7 8 9 10 12 14 16} "Normal" \
263
{8 9 10 11 13 15 17} "Medium" \
264
{9 10 11 12 14 16 18} "Large" \
265
{11 12 13 14 16 18 20} "Very Large" \
266
{13 14 15 16 18 20 22} "Extra Large" \
267
{15 16 17 18 20 22 24} "Recklessly Large" \
269
$path add cascade -label {Browser Font Size Table} -menu $fonttable
271
foreach {option label} [list \
272
-forcefontmetrics "Force CSS Font Metrics" \
273
-enableimages "Enable Images" \
275
-enablejavascript "Enable ECMAscript" \
277
if {$option eq "--"} {
280
set var [myvar options($option)]
281
set cmd [list $self Reconfigure $option]
282
$path add checkbutton -label $label -variable $var -command $cmd
285
if {[info commands ::see::interp] eq ""} {
286
$path entryconfigure end -state disabled
290
method populate_hidegui_entry {path} {
291
$path add checkbutton -label "Hide Gui" -variable [myvar options(-hidegui)]
292
$path entryconfigure end -command [list $self Reconfigure -hidegui]
295
method PopulateRadioMenu {path option config} {
296
foreach {val label} $config {
297
$path add radiobutton \
298
-variable [myvar options($option)] \
300
-command [list $self Reconfigure $option] \
305
method Reconfigure {option} {
306
$self configure $option $options($option)
309
method Boolean {option value} {
310
if {![string is boolean $value]} { error "Bad boolean value: $value" }
312
method Double {option value} {
313
if {![string is double $value]} { error "Bad double value: $value" }
315
method Integer {option value} {
316
if {![string is integer $value]} { error "Bad integer value: $value" }
318
method Icons {option value} {
319
if {[info commands ::hv3::$value] eq ""} { error "Bad icon scheme: $value" }
321
method SevenIntegers {option value} {
322
set len [llength $value]
323
if {$len != 7} { error "Bad seven-integers value: $value" }
324
foreach elem $value {
325
if {![string is integer $elem]} {
326
error "Bad seven-integers value: $value"
331
method SetOption {option value} {
332
set options($option) $value
333
if {$myPollActive == 0} {
334
$myDb eval {REPLACE INTO cfg_options1 VALUES($option, $value)}
345
pack .status -after .notebook -fill x -side bottom
346
pack .toolbar -before .notebook -fill x -side top
350
::hv3::SetFont [list -size $options(-guifont)]
353
::hv3::$options(-icons)
358
set ::hv3::reformat_scripts_option 0
359
set ::hv3::log_source_option 0
362
set ::hv3::reformat_scripts_option 0
363
set ::hv3::log_source_option 1
366
set ::hv3::reformat_scripts_option 1
367
set ::hv3::log_source_option 1
372
$self configurebrowser [.notebook current]
377
method StoreOptions {} {
379
method RetrieveOptions {} {
382
method configurebrowser {b} {
384
foreach {option var} [list \
385
-fonttable options(-fonttable) \
386
-fontscale options(-fontscale) \
387
-zoom options(-zoom) \
388
-forcefontmetrics options(-forcefontmetrics) \
389
-enableimages options(-enableimages) \
390
-enablejavascript options(-enablejavascript) \
392
if {[$b cget $option] ne [set $var]} {
393
$b configure $option [set $var]
394
foreach f [$b get_frames] {
395
if {[$f positionid] ne "0"} {
396
$self configureframe $f
402
method configureframe {b} {
403
foreach {option var} [list \
404
-fonttable options(-fonttable) \
405
-fontscale options(-fontscale) \
406
-zoom options(-zoom) \
407
-forcefontmetrics options(-forcefontmetrics) \
408
-enableimages options(-enableimages) \
409
-enablejavascript options(-enablejavascript) \
411
if {[$b cget $option] ne [set $var]} {
412
$b configure $option [set $var]
418
after cancel [list $self PollConfiguration]
422
snit::type ::hv3::search {
424
typevariable SearchHotKeys -array [list \
429
variable mySearchEngines [list \
431
{Google} "http://www.google.com/search?q=%s" \
432
{Tcl Wiki} "http://wiki.tcl.tk/_search?S=%s" \
434
{Ask.com} "http://www.ask.com/web?q=%s" \
435
{MSN} "http://search.msn.com/results.aspx?q=%s" \
436
{Wikipedia} "http://en.wikipedia.org/wiki/Special:Search?search=%s" \
437
{Yahoo} "http://search.yahoo.com/search?p=%s" \
439
variable myDefaultEngine Google
442
bind Hv3HotKeys <Control-f> [list gui_current Find]
443
bind Hv3HotKeys <Control-F> [list gui_current Find]
444
foreach {label} [array names SearchHotKeys] {
445
set lc $SearchHotKeys($label)
446
set uc [string toupper $SearchHotKeys($label)]
447
bind Hv3HotKeys <Control-$lc> [list $self search $label]
448
bind Hv3HotKeys <Control-$uc> [list $self search $label]
452
method populate_menu {path} {
453
set cmd [list gui_current Find]
455
$path add command -label {Find in page...} -command $cmd -accelerator $acc
457
foreach {label uri} $mySearchEngines {
458
if {[string match ---* $label]} {
463
$path add command -label $label -command [list $self search $label]
465
if {[info exists SearchHotKeys($label)]} {
466
set acc "(Ctrl-[string toupper $SearchHotKeys($label)])"
467
$path entryconfigure end -accelerator $acc
472
method search {{default ""}} {
473
if {$default eq ""} {set default $myDefaultEngine}
475
# The currently visible ::hv3::browser widget.
476
set btl [.notebook current]
478
set fdname ${btl}.findwidget
480
if {[llength [info commands $fdname]] > 0} {
481
set initval [${fdname}.entry get]
486
foreach {label uri} $mySearchEngines {
487
if {![string match ---* $label]} {
488
lappend conf $label $uri
492
::hv3::googlewidget $fdname \
493
-getcmd [list $btl goto] \
497
$btl packwidget $fdname
498
$fdname configure -borderwidth 1 -relief raised
500
# Pressing <Escape> dismisses the search widget.
501
bind ${fdname}.entry <KeyPress-Escape> gui_escape
503
${fdname}.entry insert 0 $initval
504
focus ${fdname}.entry
508
snit::type ::hv3::file_menu {
514
"Open File..." [list gui_openfile $::hv3::G(notebook)] o \
515
"Open Tab" [list $::hv3::G(notebook) add] t \
516
"Open Location" [list gui_openlocation $::hv3::G(location_entry)] l \
518
"Bookmark This Page" [list ::hv3::gui_bookmark] b \
520
"Downloads..." [list ::hv3::the_download_manager show] "" \
521
"Bookmarks..." [list gui_current goto home://bookmarks/] "" \
523
"Close Tab" [list $::hv3::G(notebook) close] "" \
528
method populate_menu {path} {
531
foreach {label command key} $MENU {
532
if {[string match ---* $label]} {
536
$path add command -label $label -command $command
538
set acc "(Ctrl-[string toupper $key])"
539
$path entryconfigure end -accelerator $acc
543
if {[llength [$::hv3::G(notebook) tabs]] < 2} {
544
$path entryconfigure "Close Tab" -state disabled
548
method setup_hotkeys {} {
549
foreach {label command key} $MENU {
551
set uc [string toupper $key]
552
bind Hv3HotKeys <Control-$key> $command
553
bind Hv3HotKeys <Control-$uc> $command
559
proc ::hv3::gui_bookmark {} {
560
::hv3::bookmarks::new_bookmark [gui_current hv3]
563
snit::type ::hv3::debug_menu {
567
variable myDebugLevel
568
variable myHv3Options
570
constructor {hv3_options} {
571
set myHv3Options $hv3_options
572
set myDebugLevel [$hv3_options cget -debuglevel]
574
"Cookies" [list $::hv3::G(notebook) add cookies:] "" \
575
"About" [list $::hv3::G(notebook) add home://about] "" \
576
"Polipo..." [list ::hv3::polipo::popup] "" \
577
"Events..." [list gui_log_window $::hv3::G(notebook)] "" \
579
"Tree Browser..." [list gui_current browse] "" \
580
"Debugging Console..." [list ::hv3::launch_console] d \
582
"Sub-Window..." gui_subwindow "" \
583
"Exec firefox -remote" [list gui_firefox_remote] "" \
585
"Reset Profiling Data..." [list ::hv3::profile::zero] "" \
586
"Save Profiling Data..." [list ::hv3::profile::report_to_file] "" \
590
method populate_menu {path} {
593
set m [::hv3::menu ${path}.debuglevel]
595
-variable [myvar myDebugLevel] \
597
-command [list $self SetDebugLevel] \
600
-variable [myvar myDebugLevel] \
602
-command [list $self SetDebugLevel] \
605
-variable [myvar myDebugLevel] \
607
-command [list $self SetDebugLevel] \
608
-label "Reformat and log source (buggy)"
610
foreach {label command key} $MENU {
611
if {[string match ---* $label]} {
615
$path add command -label $label -command $command
617
set acc "(Ctrl-[string toupper $key])"
618
$path entryconfigure end -accelerator $acc
621
$path add cascade -menu $m -label "Application Source Logging"
625
if {0 == [hv3::profile::enabled]} {
626
$path entryconfigure end -state disabled
627
$path entryconfigure [expr [$path index end] - 1] -state disabled
633
method SetDebugLevel {} {
634
$myHv3Options configure -debuglevel $myDebugLevel
637
method setup_hotkeys {} {
638
foreach {label command key} $MENU {
640
set uc [string toupper $key]
641
bind Hv3HotKeys <Control-$key> $command
642
bind Hv3HotKeys <Control-$uc> $command
649
#--------------------------------------------------------------------------
650
# The following functions are all called during startup to construct the
651
# static components of the web browser gui:
655
# create_fontsize_menu
656
# create_fontscale_menu
661
# This procedure is called once at the start of the script to build
662
# the GUI used by the application. It creates all the widgets for
665
# The argument is the name of an array variable in the parent context
666
# into which widget names are written, according to the following
670
# ------------------------------------------------------------
671
# stop_button The "stop" button
672
# back_button The "back" button
673
# forward_button The "forward" button
674
# location_entry The location bar
675
# notebook The ::hv3::tabset instance
676
# status_label The label used for a status bar
677
# history_menu The pulldown menu used for history
679
proc gui_build {widget_array} {
680
upvar $widget_array G
683
# Create the top bit of the GUI - the URI entry and buttons.
686
::hv3::locationentry .toolbar.entry
687
::hv3::toolbutton .toolbar.b.back -text {Back} -tooltip "Go Back"
688
::hv3::toolbutton .toolbar.b.stop -text {Stop} -tooltip "Stop"
689
::hv3::toolbutton .toolbar.b.forward -text {Forward} -tooltip "Go Forward"
691
::hv3::toolbutton .toolbar.b.new -text {New Tab} -command [list .notebook add]
692
::hv3::toolbutton .toolbar.b.home -text Home -command [list \
693
gui_current goto $::hv3::homeuri
695
::hv3::toolbutton .toolbar.bug -text {Report Bug} -command gui_report_bug
697
.toolbar.b.new configure -tooltip "Open New Tab"
698
.toolbar.b.home configure -tooltip "Go to Bookmarks Manager"
700
.toolbar.bug configure -tooltip "Bug Report"
702
# Create the middle bit - the browser window
704
::hv3::tabset .notebook \
706
-switchcmd gui_switch
708
# And the bottom bit - the status bar
709
::hv3::label .status -anchor w -width 1
710
bind .status <1> [list gui_current ProtocolGui toggle]
712
bind .status <3> [list gui_status_toggle $widget_array]
713
bind .status <Enter> [list gui_status_enter $widget_array]
714
bind .status <Leave> [list gui_status_leave $widget_array]
716
# Set the widget-array variables
717
set G(new_button) .toolbar.b.new
718
set G(stop_button) .toolbar.b.stop
719
set G(back_button) .toolbar.b.back
720
set G(forward_button) .toolbar.b.forward
721
set G(home_button) .toolbar.b.home
722
set G(location_entry) .toolbar.entry
723
set G(notebook) .notebook
724
set G(status_label) .status
726
# The G(status_mode) variable takes one of the following values:
728
# "browser" - Normal browser status bar.
729
# "browser-tree" - Similar to "browser", but displays the document tree
730
# hierachy for the node the cursor is currently
731
# hovering over. This used to be the default.
732
# "memory" - Show information to do with Hv3's memory usage.
734
# The "browser" mode uses less CPU than "browser-tree" and "memory".
735
# The user cycles through the modes by right-clicking on the status bar.
737
set G(status_mode) "browser"
739
# Pack the elements of the "top bit" into the .entry frame
740
pack .toolbar.b.new -side left
741
pack .toolbar.b.back -side left
742
pack .toolbar.b.forward -side left
743
pack .toolbar.b.stop -side left
744
pack .toolbar.b.home -side left
745
pack [frame .toolbar.b.spacer -width 2 -height 1] -side left
747
pack .toolbar.b -side left
748
pack .toolbar.bug -side right
749
pack .toolbar.entry -fill x -expand true
751
# Pack the top, bottom and middle, in that order. The middle must be
752
# packed last, as it is the bit we want to shrink if the size of the
753
# main window is reduced.
754
pack .toolbar -fill x -side top
755
pack .status -fill x -side bottom
756
pack .notebook -fill both -expand true
759
proc goto_gui_location {browser entry args} {
760
set location [$entry get]
761
$browser goto $location
764
proc gui_openlocation {location_entry} {
765
$location_entry selection range 0 end
766
$location_entry OpenDropdown *
767
focus ${location_entry}.entry
770
proc gui_populate_menu {eMenu menu_widget} {
771
switch -- [string tolower $eMenu] {
773
set cmd [list $::hv3::G(file_menu) populate_menu $menu_widget]
774
$menu_widget configure -postcommand $cmd
778
$::hv3::G(search) populate_menu $menu_widget
782
$::hv3::G(config) populate_menu $menu_widget
786
$::hv3::G(debug_menu) populate_menu $menu_widget
790
set cmd [list gui_current populate_history_menu $menu_widget]
791
$menu_widget configure -postcommand $cmd
795
error "gui_populate_menu: No such menu: $eMenu"
800
proc gui_menu {widget_array} {
801
upvar $widget_array G
803
# Attach a menu widget - .m - to the toplevel application window.
804
. config -menu [::hv3::menu .m]
806
set G(config) [::hv3::config %AUTO% ::hv3::sqlitedb]
807
set G(file_menu) [::hv3::file_menu %AUTO%]
808
set G(search) [::hv3::search %AUTO%]
809
set G(debug_menu) [::hv3::debug_menu %AUTO% $G(config)]
811
# Add the "File", "Search" and "View" menus.
812
foreach m [list File Search Options Debug History] {
813
set menu_widget .m.[string tolower $m]
814
gui_populate_menu $m [::hv3::menu $menu_widget]
815
.m add cascade -label $m -menu $menu_widget -underline 0
818
$G(file_menu) setup_hotkeys
819
$G(debug_menu) setup_hotkeys
822
.toolbar.b.back configure -image hv3_previmg
823
.toolbar.b.forward configure -image hv3_nextimg
824
.toolbar.b.stop configure -image hv3_stopimg
825
.toolbar.b.new configure -image hv3_newimg
826
.toolbar.b.home configure -image hv3_homeimg
827
.toolbar.bug configure -image hv3_bugimg
830
#--------------------------------------------------------------------------
832
proc gui_current {args} {
833
eval [linsert $args 0 [.notebook current]]
836
proc gui_firefox_remote {} {
837
set url [.toolbar.entry get]
838
exec firefox -remote "openurl($url,new-tab)"
841
proc gui_switch {new} {
844
# Loop through *all* tabs and detach them from the history
845
# related controls. This is so that when the state of a background
846
# tab is updated, the history menu is not updated (only the data
847
# structures in the corresponding ::hv3::history object).
849
foreach browser [.notebook tabs] {
850
$browser configure -backbutton ""
851
$browser configure -stopbutton ""
852
$browser configure -forwardbutton ""
853
$browser configure -locationentry ""
856
# Configure the new current tab to control the history controls.
858
set new [.notebook current]
859
$new configure -backbutton $G(back_button)
860
$new configure -stopbutton $G(stop_button)
861
$new configure -forwardbutton $G(forward_button)
862
$new configure -locationentry $G(location_entry)
863
$new populatehistorymenu
865
# Attach some other GUI elements to the new current tab.
867
set gotocmd [list goto_gui_location $new $G(location_entry)]
868
$G(location_entry) configure -command $gotocmd
869
gui_status_leave ::hv3::G
871
# Configure the new current tab with the contents of the drop-down
872
# config menu (i.e. font-size, are images enabled etc.).
874
$G(config) configurebrowser $new
876
# Set the top-level window title to the title of the new current tab.
878
wm title . [.notebook get_title $new]
880
# Focus on the root HTML widget of the new tab.
882
focus [[$new hv3] html]
885
proc gui_new {path args} {
886
set new [::hv3::browser $path]
887
$::hv3::G(config) configurebrowser $new
889
set var [$new titlevar]
890
trace add variable $var write [list gui_settitle $new $var]
892
set var [$new locationvar]
893
trace add variable $var write [list gui_settitle $new $var]
895
if {[llength $args] == 0} {
896
$new goto $::hv3::newuri
898
$new goto [lindex $args 0]
901
# This black magic is required to initialise the history system.
902
# A <<Location>> event will be generated from within the [$new goto]
903
# command above, but the history system won't see it, because
904
# events are not generated until the window is mapped. So generate
905
# an extra <<Location>> when the window is mapped.
907
set w [[$new hv3] win]
908
bind $w <Map> [list event generate $w <<Location>>]
909
bind $w <Map> +[list bind <Map> $w ""]
911
# [[$new hv3] html] configure -logcmd print
916
proc gui_settitle {browser var args} {
917
if {[.notebook current] eq $browser} {
918
wm title . [set $var]
920
.notebook set_title $browser [set $var]
923
# This procedure is invoked when the user selects the File->Open menu
924
# option. It launches the standard Tcl file-selector GUI. If the user
925
# selects a file, then the corresponding URI is passed to [.hv3 goto]
927
proc gui_openfile {notebook} {
928
set browser [$notebook current]
929
set f [tk_getOpenFile -filetypes [list \
930
{{Html Files} {.html}} \
931
{{Html Files} {.htm}} \
935
if {$::tcl_platform(platform) eq "windows"} {
936
set f [string map {: {}} $f]
938
$browser goto file://$f
942
proc gui_log_window {notebook} {
943
set browser [$notebook current]
944
::hv3::log_window [[$browser hv3] html]
947
proc gui_report_bug {} {
949
set uri [[[$G(notebook) current] hv3] uri get]
950
.notebook add "home://bug/[::hv3::format_query [encoding system] $uri]"
952
set cookie "tkhtml_captcha=[expr [clock seconds]+86399]; Path=/; Version=1"
953
::hv3::the_cookie_manager SetCookie http://tkhtml.tcl.tk/ $cookie
959
$G(location_entry) escape
960
focus [[gui_current hv3] html]
962
bind Hv3HotKeys <KeyPress-Escape> gui_escape
964
proc gui_status_enter {widget_array} {
965
upvar $widget_array G
966
after cancel [list gui_set_memstatus $widget_array]
967
gui_status_help $widget_array
968
$G(status_label) configure -textvar ::hv3::G(status_help)
970
proc gui_status_help {widget_array} {
971
upvar $widget_array G
972
set G(status_help) "Current status-bar mode: "
973
switch -- $G(status_mode) {
974
browser { append G(status_help) "Normal" }
975
browser-tree { append G(status_help) "Tree-Browser" }
976
memory { append G(status_help) "Memory-Usage" }
978
append G(status_help) " "
979
append G(status_help) "(To toggle mode, right-click)"
980
append G(status_help) " "
981
append G(status_help) "(To view outstanding resource requests, left-click)"
983
proc gui_status_leave {widget_array} {
984
upvar $widget_array G
986
switch -exact -- $G(status_mode) {
988
$G(status_label) configure -textvar [gui_current statusvar]
991
$G(status_label) configure -textvar [gui_current statusvar]
994
$G(status_label) configure -textvar ""
995
gui_set_memstatus $widget_array
999
proc gui_status_toggle {widget_array} {
1000
upvar $widget_array G
1001
set modes [list browser browser-tree memory]
1002
set iNewMode [expr {([lsearch $modes $G(status_mode)]+1)%[llength $modes]}]
1003
set G(status_mode) [lindex $modes $iNewMode]
1004
gui_status_help $widget_array
1007
proc gui_set_memstatus {widget_array} {
1008
upvar $widget_array G
1009
if {$G(status_mode) eq "memory"} {
1010
set status "Script: "
1011
append status "[::count_vars] vars, [::count_commands] commands,"
1012
append status "[::count_namespaces] namespaces"
1015
array set v [::see::alloc]
1016
set nHeap [expr {int($v(GC_get_heap_size) / 1000)}]
1017
set nFree [expr {int($v(GC_get_free_bytes) / 1000)}]
1018
set nDom $v(SeeTclObject)
1020
append status "GC Heap: ${nHeap}K (${nFree}K free) "
1021
append status "($v(SeeTclObject) DOM objects)"
1024
foreach line [split [memory info] "\n"] {
1025
if {[string match {current packets allocated*} $line]} {
1026
set nAllocs [lindex $line end]
1028
if {[string match {current bytes allocated*} $line]} {
1029
set nBytes [lindex $line end]
1032
set nBytes "[expr {int($nBytes / 1000)}]K"
1033
append status " Tcl Heap: ${nBytes} in $nAllocs allocs"
1036
$G(status_label) configure -text $status
1037
after 2000 [list gui_set_memstatus $widget_array]
1041
# Launch a new sub-window.
1043
proc gui_subwindow {{uri ""}} {
1044
set name ".subwindow_[incr ::hv3::subwindow::counter]"
1045
::hv3::subwindow $name
1047
set uri [[gui_current hv3] uri get]
1052
# Override the [exit] command to check if the widget code leaked memory
1053
# or not before exiting.
1055
rename exit tcl_exit
1058
catch {destroy .prop.hv3}
1059
catch {::tkhtml::htmlalloc}
1060
eval [concat tcl_exit $args]
1063
#--------------------------------------------------------------------------
1066
# The main() program for the application. This proc handles
1067
# parsing of command line arguments.
1073
for {set ii 0} {$ii < [llength $args]} {incr ii} {
1074
set val [lindex $args $ii]
1075
switch -glob -- $val {
1076
-s* { # -statefile <file-name>
1077
if {$ii == [llength $args] - 1} ::hv3::usage
1079
set ::hv3::statefile [lindex $args $ii]
1082
# Ignore this here. If the -profile option is present it will
1083
# have been handled already.
1086
set enablejavascript 1
1089
set uri [::tkhtml::uri file:///[pwd]/]
1090
lappend docs [$uri resolve $val]
1098
if {[llength $docs] == 0} {set docs [list home://bookmarks/]}
1099
set ::hv3::newuri [lindex $docs 0]
1100
set ::hv3::homeuri home://bookmarks/
1106
if {[info exists enablejavascript]} {
1107
$::hv3::G(config) configure -enablejavascript 1
1110
::hv3::downloadmanager ::hv3::the_download_manager
1112
# After the event loop has run to create the GUI, run [main2]
1113
# to load the startup document. It's better if the GUI is created first,
1114
# because otherwise if an error occurs Tcl deems it to be fatal.
1115
after idle [list main2 $docs]
1119
set tab [$::hv3::G(notebook) add $doc]
1123
proc ::hv3::usage {} {
1124
puts stderr "Usage:"
1125
puts stderr " $::argv0 ?-statefile <file-name>? ?<uri>?"
1130
set ::hv3::statefile ":memory:"
1132
# Remote scaling interface:
1133
proc hv3_zoom {newval} { $::hv3::G(config) set_zoom $newval }
1134
proc hv3_fontscale {newval} { $::hv3::G(config) set_fontscale $newval }
1135
proc hv3_forcewidth {forcewidth width} {
1136
[[gui_current hv3] html] configure -forcewidth $forcewidth -width $width
1139
proc hv3_guifont {newval} { $::hv3::G(config) set_guifont $newval }
1141
proc hv3_html {args} {
1142
set html [[gui_current hv3] html]
1143
eval [concat $html $args]
1146
# Set variable $::hv3::maindir to the directory containing the
1147
# application files. Then run the [main] command with the command line
1148
# arguments passed to the application.
1149
set ::hv3::maindir [file dirname [info script]]
1150
eval [concat main $argv]
1152
proc print {args} { puts [join $args] }
1154
#--------------------------------------------------------------------------
added
removed
hv/hv3_main.tcl
