1184 lines
38 KiB
Tcl
Executable File
1184 lines
38 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
# BFG (aka Back/Forward/Go): a no-nonsense Tcl/Tk 8.6+ client for "small web"
|
|
# currently supported protocols:
|
|
# Gopher (incl. gophers://), Finger, Nex, Spartan, Gemini
|
|
# depends on Tk, Tcllib and TclTLS
|
|
# created by Luxferre in 2024, released into public domain
|
|
|
|
package require uri
|
|
package require inifile
|
|
package require Tk
|
|
|
|
# overall vars
|
|
set tclpath [ file normalize [ info nameofexecutable ] ]
|
|
set scriptpath [ file normalize [ info script ] ]
|
|
set appdir [ file dirname $scriptpath ]
|
|
# check if we're running from a starpack
|
|
if [string match *app-bfg $appdir] {
|
|
set appdir [ file normalize [ file join $appdir ".." ".." ".." ] ]
|
|
}
|
|
set config_file [ file join $appdir "bfg.ini" ]
|
|
|
|
# configuration defaults
|
|
set bfg_net_timeout 4000
|
|
set bfg_theme "clam"
|
|
set bfg_widgetfont "TkDefaultFont"
|
|
set bfg_widgetfontsize 16
|
|
set bfg_entryfont "TkTextFont"
|
|
set bfg_entryfontsize 10
|
|
set bfg_statusfont "TkDefaultFont"
|
|
set bfg_statusfontsize 10
|
|
set bfg_textfont "TkFixedFont"
|
|
set bfg_textfontsize 12
|
|
set bfg_monofont "TkFixedFont"
|
|
set bfg_monofontsize 12
|
|
set bfg_main_fgcolor black
|
|
set bfg_main_bgcolor white
|
|
set bfg_link_fgcolor $bfg_main_fgcolor
|
|
set bfg_link_bgcolor $bfg_main_bgcolor
|
|
set bfg_focusedlink_fgcolor blue
|
|
set bfg_focusedlink_bgcolor $bfg_main_bgcolor
|
|
set bfg_highlight_fgcolor $bfg_main_fgcolor
|
|
set bfg_highlight_bgcolor yellow
|
|
set bfg_error_fgcolor red
|
|
set bfg_error_bgcolor $bfg_main_bgcolor
|
|
set bfg_tls_support 1
|
|
|
|
# read configuration from ini
|
|
set confini ""
|
|
catch {set confini [::ini::open $config_file -encoding utf-8]}
|
|
set val ""
|
|
set bookmarks ""
|
|
if {$confini ne ""} {
|
|
set val [::ini::value $confini net timeout $bfg_net_timeout]
|
|
if {$val ne ""} {set bfg_net_timeout $val}
|
|
set val [::ini::value $confini net tls "on"]
|
|
if {$val ne ""} {set bfg_tls_support $val}
|
|
set val [::ini::value $confini widget ttkTheme $bfg_theme]
|
|
if {$val ne ""} {set bfg_theme $val}
|
|
set val [::ini::value $confini widget font $bfg_widgetfont]
|
|
if {$val ne ""} {set bfg_widgetfont $val}
|
|
set val [::ini::value $confini widget fontsize $bfg_widgetfontsize]
|
|
if {$val ne ""} {set bfg_widgetfontsize $val}
|
|
set val [::ini::value $confini widget entryfont $bfg_entryfont]
|
|
if {$val ne ""} {set bfg_entryfont $val}
|
|
set val [::ini::value $confini widget entryfontsize $bfg_entryfontsize]
|
|
if {$val ne ""} {set bfg_entryfontsize $val}
|
|
set val [::ini::value $confini widget statusfont $bfg_statusfont]
|
|
if {$val ne ""} {set bfg_statusfont $val}
|
|
set val [::ini::value $confini widget statusfontsize $bfg_statusfontsize]
|
|
if {$val ne ""} {set bfg_statusfontsize $val}
|
|
set val [::ini::value $confini style.general textfont $bfg_textfont]
|
|
if {$val ne ""} {set bfg_textfont $val}
|
|
set val [::ini::value $confini style.general textfontsize $bfg_textfontsize]
|
|
if {$val ne ""} {set bfg_textfontsize $val}
|
|
set val [::ini::value $confini style.general monofont $bfg_monofont]
|
|
if {$val ne ""} {set bfg_monofont $val}
|
|
set val [::ini::value $confini style.general monofontsize $bfg_monofontsize]
|
|
if {$val ne ""} {set bfg_monofontsize $val}
|
|
set val [::ini::value $confini style.general foreground $bfg_main_fgcolor]
|
|
if {$val ne ""} {set bfg_main_fgcolor $val}
|
|
set val [::ini::value $confini style.general background $bfg_main_bgcolor]
|
|
if {$val ne ""} {set bfg_main_bgcolor $val}
|
|
set val [::ini::value $confini style.link.normal foreground $bfg_link_fgcolor]
|
|
if {$val ne ""} {set bfg_link_fgcolor $val}
|
|
set val [::ini::value $confini style.link.normal background $bfg_link_bgcolor]
|
|
if {$val ne ""} {set bfg_link_bgcolor $val}
|
|
set val [::ini::value $confini style.link.focused foreground $bfg_focusedlink_fgcolor]
|
|
if {$val ne ""} {set bfg_focusedlink_fgcolor $val}
|
|
set val [::ini::value $confini style.link.focused background $bfg_focusedlink_bgcolor]
|
|
if {$val ne ""} {set bfg_focusedlink_bgcolor $val}
|
|
set val [::ini::value $confini style.highlight foreground $bfg_highlight_fgcolor]
|
|
if {$val ne ""} {set bfg_highlight_fgcolor $val}
|
|
set val [::ini::value $confini style.highlight background $bfg_highlight_bgcolor]
|
|
if {$val ne ""} {set bfg_highlight_bgcolor $val}
|
|
set val [::ini::value $confini style.error foreground $bfg_error_fgcolor]
|
|
if {$val ne ""} {set bfg_error_fgcolor $val}
|
|
set val [::ini::value $confini style.error background $bfg_error_bgcolor]
|
|
if {$val ne ""} {set bfg_error_bgcolor $val}
|
|
|
|
# load bookmarks
|
|
if {[::ini::exists $confini bookmarks]} {
|
|
foreach key [::ini::keys $confini bookmarks] {
|
|
dict set bookmarks $key [::ini::value $confini bookmarks $key]
|
|
}
|
|
}
|
|
|
|
# close the ini for now
|
|
::ini::close $confini
|
|
}
|
|
|
|
# load TLS support
|
|
if {($bfg_tls_support eq "off") || ($bfg_tls_support eq "false" || ($bfg_tls_support eq "none"))} {
|
|
set bfg_tls_support 0
|
|
} else {
|
|
set bfg_tls_support 1
|
|
}
|
|
if {$bfg_tls_support eq 1} {
|
|
package require tls
|
|
}
|
|
|
|
# generate fonts
|
|
foreach fid {widget entry status text mono} {
|
|
set vname [string cat bfg_ $fid font]
|
|
set ffamily [set $vname]
|
|
set fsize [set [string cat $vname size]]
|
|
unset -nocomplain $vname
|
|
font create $vname -family "$ffamily" -size $fsize -weight normal
|
|
}
|
|
|
|
# logic part
|
|
|
|
# store browser history here
|
|
set bfg_history ""
|
|
set bfg_histidx 0
|
|
|
|
# redirection variables for Spartan and Gemini
|
|
set redirectcount 0
|
|
set redirectlimit 5
|
|
|
|
# truncate status characters
|
|
proc trunc {s} {
|
|
set mlen 60
|
|
set nlen [expr { ($mlen / 2) - 1 }]
|
|
set len [string length $s]
|
|
if {$len > $mlen} {
|
|
# truncate characters in the middle
|
|
set p1 [string range $s 0 $nlen]
|
|
set p2 [string range $s [expr {$len - $nlen}] end]
|
|
return [string cat $p1 "…" $p2]
|
|
} else {return $s}
|
|
}
|
|
|
|
# common request logic:
|
|
# 1) connect via TCP (or TLS)
|
|
# 2) send a single data chunk with selector etc
|
|
# 3) read the incoming data
|
|
# 4) close the connection
|
|
proc reqresp {host port reqline is_tls encoding} {
|
|
global bfg_response bfg_net_timeout
|
|
if {$is_tls eq 1} {
|
|
set sock [::tls::socket -autoservername true -async $host $port]
|
|
} else {
|
|
set sock [socket -async $host $port]
|
|
}
|
|
global rcv_end_$sock
|
|
unset -nocomplain rcv_end_$sock
|
|
if {$encoding eq ""} {set encoding utf-8}
|
|
fconfigure $sock -translation binary -buffering none -encoding $encoding
|
|
fileevent $sock writable [list connected $sock $reqline]
|
|
proc connected {sock reqline} {
|
|
fileevent $sock writable {}
|
|
puts -nonewline $sock "$reqline"
|
|
flush $sock
|
|
fileevent $sock readable [list rdbl $sock]
|
|
}
|
|
set bfg_response ""
|
|
proc rdbl {sock} {
|
|
global bfg_response rcv_end_$sock
|
|
while {![eof $sock]} {
|
|
append bfg_response [read $sock]
|
|
}
|
|
set rcv_end_$sock 0
|
|
}
|
|
after $bfg_net_timeout "global rcv_end_$sock; set rcv_end_$sock 1"
|
|
vwait rcv_end_$sock
|
|
catch {close $sock}
|
|
if {"$bfg_response" eq ""} {
|
|
set bfg_response "Connection refused or timed out"
|
|
}
|
|
unset -nocomplain rcv_end_$sock
|
|
}
|
|
|
|
# parse target URL
|
|
# returns dictionary {scheme host port path handler}
|
|
# uses some hacky http-like logic of Tcllib uri module
|
|
proc url2dict {inputurl} {
|
|
set out [dict create]
|
|
if [regexp {^(.*)://} $inputurl _ lscheme] {
|
|
dict set out scheme $lscheme
|
|
} else {
|
|
dict set out handler "render_handler_invalid"
|
|
return $out
|
|
}
|
|
set rawout [::uri::split [regsub {^.*://} $inputurl "http://"]]
|
|
set rhost [dict get $rawout host]
|
|
set rpath [dict get $rawout path]
|
|
set rport [dict get $rawout port]
|
|
set secondarydata [dict get $rawout query]
|
|
dict set out host $rhost
|
|
set selector $rpath
|
|
dict set out handler "render_handler_$lscheme"
|
|
# protocol-specific request logic
|
|
switch "$lscheme" {
|
|
gophers -
|
|
gopher {
|
|
if {$rport eq ""} {set rport 70}
|
|
set selector [string cat [string range $rpath 1 end] "\r\n"]
|
|
dict set out handler render_handler_gopher
|
|
}
|
|
finger {
|
|
if {$rport eq ""} {set rport 79}
|
|
set selector "$selector\r\n"
|
|
}
|
|
spartan {
|
|
if {$rport eq ""} {set rport 300}
|
|
if {$rpath eq ""} {set rpath "/"}
|
|
if {![string match "/*" $rpath]} {
|
|
set rpath "/$rpath"
|
|
}
|
|
set blen [string length $secondarydata]
|
|
set selector "$rhost $rpath $blen\r\n$secondarydata"
|
|
}
|
|
nex {
|
|
if {$rport eq ""} {set rport 1900}
|
|
set selector "$selector\r\n"
|
|
}
|
|
gemini {
|
|
if {$rport eq ""} {set rport 1965}
|
|
set selector "$inputurl\r\n"
|
|
}
|
|
default {dict set out handler render_handler_none}
|
|
}
|
|
dict set out path $rpath
|
|
dict set out selector $selector
|
|
dict set out port $rport
|
|
return $out
|
|
}
|
|
|
|
# link clicking logic
|
|
set linkcount 0
|
|
set curlink 0
|
|
# all link tracker
|
|
set linklist ""
|
|
# interactive link tracker (prefixes)
|
|
set ilinklist ""
|
|
proc clicklink {linknum} {
|
|
global bfg_prompt sentry_status linklist ilinklist
|
|
set url [lindex $linklist $linknum]
|
|
set iprefix [lindex $ilinklist $linknum]
|
|
if {$iprefix ne ""} {
|
|
grid .sframe.sentry
|
|
.sframe.sentry state !disabled
|
|
set sentry_status "Prompt from [trunc $url]:"
|
|
focus .sframe.sentry
|
|
vwait bfg_prompt
|
|
.sframe.sentry state disabled
|
|
grid remove .sframe.sentry
|
|
set url "$url$iprefix$bfg_prompt"
|
|
unset -nocomplain bfg_prompt
|
|
}
|
|
urlfetch $url 1
|
|
}
|
|
|
|
# open link in a new window
|
|
proc windowlink {linknum istor} {
|
|
global bfg_prompt sentry_status linklist ilinklist
|
|
global tclpath scriptpath
|
|
set url [lindex $linklist $linknum]
|
|
set iprefix [lindex $ilinklist $linknum]
|
|
if {$iprefix ne ""} {
|
|
grid .sframe.sentry
|
|
.sframe.sentry state !disabled
|
|
set sentry_status "Prompt from [trunc $url]:"
|
|
focus .sframe.sentry
|
|
vwait bfg_prompt
|
|
.sframe.sentry state disabled
|
|
grid remove .sframe.sentry
|
|
set url "$url$iprefix$bfg_prompt"
|
|
unset -nocomplain bfg_prompt
|
|
}
|
|
# forward the URL to a new window
|
|
if {$istor eq 1} {set epath "torsocks $tclpath"} else {set epath $tclpath}
|
|
exec -ignorestderr -- {*}$epath $scriptpath $url &
|
|
}
|
|
|
|
# link downloading logic
|
|
proc downloadlink {linknum openExternally} {
|
|
global bfg_prompt sentry_status linklist ilinklist
|
|
global bfg_status bfg_response
|
|
set url [lindex $linklist $linknum]
|
|
set iprefix [lindex $ilinklist $linknum]
|
|
if {$iprefix ne ""} {
|
|
grid .sframe.sentry
|
|
.sframe.sentry state !disabled
|
|
set sentry_status "Prompt from [trunc $url]:"
|
|
focus .sframe.sentry
|
|
vwait bfg_prompt
|
|
.sframe.sentry state disabled
|
|
grid remove .sframe.sentry
|
|
set url "$url$iprefix$bfg_prompt"
|
|
unset -nocomplain bfg_prompt
|
|
}
|
|
# get the raw contents in $bfg_response
|
|
set scheme [urldl $url 1]
|
|
# sanitize the contents for Gemini or Spartan
|
|
if {($scheme eq "spartan") || ($scheme eq "gemini")} {
|
|
regsub {^\d[^\r].*\r\n} $bfg_response "" bfg_response
|
|
}
|
|
# get the last part of the URL as suggested filename
|
|
set uname [file tail $url]
|
|
set outfname [tk_getSaveFile -confirmoverwrite true -initialfile $uname]
|
|
if {$outfname ne ""} {
|
|
set fp [open $outfname w]
|
|
fconfigure $fp -translation binary
|
|
puts -nonewline $fp $bfg_response
|
|
close $fp
|
|
set bfg_response ""
|
|
set bfg_status "Downloaded [trunc $url]"
|
|
after 2000 {set bfg_status Ready}
|
|
if {$openExternally eq 1} {
|
|
extOpen $outfname
|
|
}
|
|
}
|
|
}
|
|
|
|
# link insertion logic
|
|
proc linkinsert {textw prevurl rooturl url name iprefix tag} {
|
|
global linkcount linklist ilinklist
|
|
global contentcursor
|
|
global bfg_status bfg_link_fgcolor bfg_link_bgcolor
|
|
set linktext "$url"
|
|
if {$name ne ""} {
|
|
set linktext $name
|
|
}
|
|
set linktext "=> $linktext"
|
|
set tagname "bfglink_$linkcount"
|
|
# resolve the url as local if it doesn't contain a scheme
|
|
if {[::uri::isrelative "$url"]} {
|
|
regexp {^(.*)://} $rooturl _ lscheme
|
|
# case 1: it has 2 slashes in the forward, case 2: it has 1 slash
|
|
# case 3: it has a suffix on the end, case 4: the rest
|
|
if {[string match "//*" "$url"]} {
|
|
set url [string cat "$lscheme" ":" "$url"]
|
|
} elseif {[string match "/*" "$url"]} {
|
|
set url [string cat "$rooturl" "$url"]
|
|
} elseif {[regexp {.*/[^/]+$} "$prevurl"]} {
|
|
set url [string cat "$prevurl" "/../" "$url"]
|
|
} else {
|
|
set url [string cat "$prevurl" "/" "$url"]
|
|
}
|
|
# recanonicalize the URL
|
|
set url [regsub {^http://} [::uri::canonicalize [regsub {^.*://} "$url" "http://"]] "$lscheme://"]
|
|
}
|
|
# handle possible interactive part
|
|
set bindcmd "clicklink $linkcount"
|
|
set bindcmd2 "windowlink $linkcount 0"
|
|
set bindcmd3 "windowlink $linkcount 1"
|
|
set bindcmd4 "downloadlink $linkcount 0"
|
|
set bindcmd5 "downloadlink $linkcount 1"
|
|
lappend ilinklist $iprefix
|
|
# perform the insertion
|
|
$textw insert end $linktext "$tagname $tag"
|
|
$textw tag configure $tagname -underline on -foreground $bfg_link_fgcolor -background $bfg_link_bgcolor
|
|
$textw tag bind $tagname <Button-1> $bindcmd
|
|
$textw tag bind $tagname <Shift-Button-1> $bindcmd2
|
|
$textw tag bind $tagname <Button-2> $bindcmd2
|
|
$textw tag bind $tagname <Control-Shift-Button-1> $bindcmd3
|
|
$textw tag bind $tagname <Shift-Button-2> $bindcmd3
|
|
$textw tag bind $tagname <Button-3> $bindcmd4
|
|
$textw tag bind $tagname <Shift-Button-3> $bindcmd5
|
|
$textw tag bind $tagname <Enter> "set prev_status \"\$bfg_status\";set bfg_status [trunc \"$url\"];%W configure -cursor hand2"
|
|
$textw tag bind $tagname <Leave> {
|
|
set bfg_status $prev_status
|
|
%W configure -cursor $contentcursor
|
|
}
|
|
$textw insert end "\n"
|
|
# populate the link list
|
|
lappend linklist $url
|
|
incr linkcount
|
|
}
|
|
|
|
# open unknown protocols in the external OS
|
|
proc extOpen {url} {
|
|
global tcl_platform
|
|
if {$tcl_platform(platform) eq "windows"} {
|
|
set command [list {*}[auto_execok start] {}]
|
|
if {[file isdirectory $url]} {
|
|
set url [file nativename [file join $url .]]
|
|
}
|
|
} elseif {$tcl_platform(os) eq "Darwin"} {
|
|
set command [list open]
|
|
} else {
|
|
set command [list xdg-open]
|
|
}
|
|
exec {*}$command $url &
|
|
}
|
|
|
|
# common URL downloader
|
|
# return the contents in $bfg_response
|
|
proc urldl {inputurl isbinary} {
|
|
global bfg_tls_support bfg_response
|
|
set parts [url2dict $inputurl]
|
|
set host [dict get $parts host]
|
|
set port [dict get $parts port]
|
|
set path [dict get $parts path]
|
|
set selector [dict get $parts selector]
|
|
set scheme [dict get $parts scheme]
|
|
set is_tls 0
|
|
if {($scheme eq "gemini") || ($scheme eq "gophers")} {
|
|
if {$bfg_tls_support eq 0} { # report unsupported content
|
|
set errmsg {BFG error: TLS support is turned off in the configuration}
|
|
if {$scheme eq "gemini"} {
|
|
set bfg_response [string cat "50 " $errmsg "\r\n"]
|
|
}
|
|
if {$scheme eq "gophers"} {
|
|
set bfg_response [string cat "3" $errmsg "\t-\t-\t-\r\n"]
|
|
}
|
|
return $scheme
|
|
} else {set is_tls 1}
|
|
}
|
|
set encoding "utf-8"
|
|
if {$isbinary eq 1} {set encoding "binary"}
|
|
reqresp $host $port $selector $is_tls $encoding
|
|
return $scheme
|
|
}
|
|
|
|
# common URL fetcher: pass to handler
|
|
proc urlfetch {inputurl refhist} {
|
|
set parts [url2dict $inputurl]
|
|
set handler [dict get $parts handler]
|
|
if {$handler eq "render_handler_none"} {
|
|
extOpen $inputurl; # attempt to pass the URL to the external OS
|
|
} elseif {$handler eq "render_handler_invalid"} {
|
|
global linkcount linklist ilinklist curlink bookmarkactive bookmarklabel
|
|
set linkcount 0
|
|
set curlink 0
|
|
set linklist ""
|
|
set ilinklist ""
|
|
.content.text configure -state normal
|
|
.content.text delete 1.0 end; # clear the previous contents
|
|
.content.text insert end "Please enter a valid URL"
|
|
.content.text configure -state disabled
|
|
# append to the history
|
|
if {$refhist eq 1} {histappend "about:invalid"}
|
|
set bookmarkactive "\u2605"
|
|
set bookmarklabel "Add bookmark"
|
|
refreshbookmarks
|
|
} else {
|
|
global bfg_status bfg_response linkcount linklist targeturl
|
|
global bfg_history bfg_histidx curlink ilinklist
|
|
global bookmarks bookmarkactive bookmarklabel
|
|
set bfg_status [trunc "Fetching $inputurl..."]
|
|
set linkcount 0
|
|
set curlink 0
|
|
set linklist ""
|
|
set ilinklist ""
|
|
set scheme [dict get $parts scheme]
|
|
set host [dict get $parts host]
|
|
set port [dict get $parts port]
|
|
set path [dict get $parts path]
|
|
set rooturl "$scheme://$host:$port"
|
|
urldl $inputurl 0
|
|
# append to the history
|
|
if {$refhist eq 1} {histappend $inputurl}
|
|
if {$linkcount > 0} {linkfocus 0 1; set curlink 0}
|
|
set targeturl $inputurl
|
|
wm title . [string cat "BFG - " [trunc $targeturl]]
|
|
# update the bookmark character if the URL is bookmarked
|
|
if {$targeturl in [dict values $bookmarks]} {
|
|
set bookmarkactive "\u2605"
|
|
set bookmarklabel "Remove bookmark"
|
|
} else {
|
|
set bookmarkactive "\u2606"
|
|
set bookmarklabel "Add bookmark"
|
|
}
|
|
set bfg_status [trunc "Rendering $inputurl..."]
|
|
.content.text configure -state normal
|
|
.content.text delete 1.0 end; # clear the previous contents
|
|
# remove all SGR escape sequences for non-downloaded responses
|
|
regsub -all {\033\[[0-9;]+m} $bfg_response "" bfg_response
|
|
$handler "$inputurl" "$rooturl" "$path" "$bfg_response" .content.text
|
|
.content.text configure -state disabled
|
|
refreshbookmarks
|
|
set bfg_status Ready
|
|
focus .content.text
|
|
}
|
|
}
|
|
|
|
# plaintext sanitizer: trim every line end
|
|
proc textsanitize {text} {
|
|
set newtext ""
|
|
foreach line [split $text \n] {
|
|
set line [string trimright $line]
|
|
set newtext [string cat $newtext $line "\n"]
|
|
}
|
|
return $newtext
|
|
}
|
|
|
|
# link insertion helper
|
|
proc widget_linsert {textw prevurl rooturl linkpart prefix tag} {
|
|
set llist [split [string trim "$linkpart"]]
|
|
set linkurl [lindex $llist 0]
|
|
set linkname ""
|
|
if {[llength $llist] > 1} {
|
|
set linkname [string trim [join [lrange $llist 1 end] " "]]
|
|
}
|
|
linkinsert $textw "$prevurl" "$rooturl" "$linkurl" "$linkname" "$prefix" "$tag"
|
|
}
|
|
|
|
# Gemtext rendering (for Gemini and Spartan)
|
|
# Since BFG displays contents in monospace, only three things
|
|
# are processed (per the specification):
|
|
# links, preformatting (with optional suffixes) and Spartan's input prompts
|
|
|
|
proc render_gemtext {textw prevurl rooturl gemtext is_spartan} {
|
|
set preformat false
|
|
foreach line [split "$gemtext" "\n"] {
|
|
set line [string trimright "$line"]
|
|
if {[string match "```*" $line]} {; # preformatting mode
|
|
set preformat [expr {!$preformat}]
|
|
} else {
|
|
if {$preformat} {
|
|
$textw insert end "$line\n" preformatter
|
|
} else {
|
|
if {[regexp {^=>(.*)$} $line _ linkpart]} {; # regular link detected
|
|
widget_linsert $textw "$prevurl" "$rooturl" "$linkpart" "" ""
|
|
} elseif {$is_spartan && [regexp {^=:(.*)$} $line _ linkpart]} {; # input link detected
|
|
widget_linsert $textw "$prevurl" "$rooturl" "$linkpart" "?" ""
|
|
} else {$textw insert end "$line\n"}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# individual protocol rendering handlers
|
|
|
|
# finger content is just plain text
|
|
proc render_handler_finger {prevurl rooturl path body textw} {
|
|
$textw insert end [textsanitize $body] preformatter
|
|
}
|
|
|
|
# nex content depends on the path:
|
|
# with "" or ending in "/", it is plain text with => links
|
|
# otherwise, it's just plain text
|
|
proc render_handler_nex {prevurl rooturl path body textw} {
|
|
if {$path eq ""} {set path /}
|
|
if {[string index $path end] eq "/"} {
|
|
foreach line [split $body \n] {
|
|
set line [string trimright $line]
|
|
if [regexp {^=>\s(.*)$} $line _ linkpart] {; # link detected
|
|
widget_linsert $textw $prevurl $rooturl $linkpart "" preformatter
|
|
} else {; # normal line
|
|
$textw insert end "$line\n" preformatter
|
|
}
|
|
}
|
|
} else {
|
|
$textw insert end [textsanitize $body] preformatter
|
|
}
|
|
}
|
|
|
|
# gopher content depends on the first character in the selector path
|
|
proc render_handler_gopher {prevurl rooturl path body textw} {
|
|
if {($path eq "") || ($path eq "/")} {
|
|
set gophertype 1
|
|
set selector ""
|
|
} else {
|
|
set gophertype [string index $path 0]
|
|
set selector [string range $path 1 end]
|
|
}
|
|
# for now, let's support TSV gophermaps and treat everything else as plaintext
|
|
if {($gophertype eq 1) || ($gophertype eq 7)} {
|
|
# get root url scheme, host and port
|
|
regexp {^(.*)://} $rooturl _ rootscheme
|
|
set parts [::uri::split [regsub {^.*://} $rooturl "http://"]]
|
|
set roothost [dict get $parts host]
|
|
set rootport [dict get $parts port]
|
|
# parse the gophermap body
|
|
foreach line [split $body \n] {
|
|
set fields [split [string trimright $line] \t]
|
|
set l [llength $fields]
|
|
set rtype ""
|
|
set rdesc ""
|
|
set rsel ""
|
|
set rhost ""
|
|
set rport ""
|
|
if {$l > 0} {set rdesc [string trim [lindex $fields 0]]}
|
|
if {$l > 1} {set rsel [string trim [lindex $fields 1]]}
|
|
if {$l > 2} {set rhost [string trim [lindex $fields 2]]}
|
|
if {$l > 3} {set rport [string trim [lindex $fields 3]]}
|
|
if {[string length $rdesc] > 0} {
|
|
set rtype [string index $rdesc 0]
|
|
set rdesc [string range $rdesc 1 end]
|
|
if {$l < 2} {
|
|
set rsel $rdesc
|
|
}
|
|
}
|
|
# fill in the missing host and port
|
|
if {$rhost eq ""} {set rhost $roothost}
|
|
if {$rport eq ""} {set rport $rootport}
|
|
# update the scheme if the resource is the same
|
|
set tscheme gopher
|
|
if {($rhost eq $roothost) && ($rport eq $rootport)} {
|
|
set tscheme $rootscheme
|
|
}
|
|
# now we have resource type, description, selector, host and port
|
|
# let's output it depending on the type and ignore unknown types
|
|
switch $rtype {
|
|
0 -
|
|
1 -
|
|
5 -
|
|
g -
|
|
I -
|
|
: -
|
|
; -
|
|
< -
|
|
d -
|
|
p -
|
|
s -
|
|
P -
|
|
X -
|
|
9 { # plain text, gophermap, binary, image, sound...
|
|
linkinsert $textw $prevurl $rooturl "$tscheme://$rhost:$rport/$rtype$rsel" $rdesc "" preformatter
|
|
}
|
|
7 { # gophermap with input
|
|
linkinsert $textw $prevurl $rooturl "$tscheme://$rhost:$rport/$rtype$rsel" $rdesc "\t" preformatter
|
|
}
|
|
8 { # telnet session link
|
|
set username ""
|
|
if {$rsel ne ""} {set username "$rsel@"}
|
|
linkinsert $textw $prevurl $rooturl "telnet://$username$rhost:$rport" $rdesc "" preformatter
|
|
}
|
|
3 { # error message
|
|
$textw insert end "$rdesc\n" {errormsg preformatter}
|
|
}
|
|
i { # info message
|
|
$textw insert end "$rdesc\n" preformatter
|
|
}
|
|
h { # HTTP URL
|
|
regsub ***=URL: $rsel "" clearurl
|
|
linkinsert $textw $prevurl $rooturl [string trim $clearurl] $rdesc "" preformatter
|
|
}
|
|
default {}
|
|
}
|
|
}
|
|
} elseif {($gophertype ne 0) && ($gophertype ne 3)} {
|
|
$textw insert end $body preformatter
|
|
} else {
|
|
$textw insert end [textsanitize $body] preformatter
|
|
}
|
|
}
|
|
|
|
# Spartan has a status line in response and multiple MIME types
|
|
# we support only text/gemini and text/plain for now
|
|
proc render_handler_spartan {prevurl rooturl path body textw} {
|
|
global redirectcount redirectlimit
|
|
# get the status line
|
|
if {[regexp {^([^\n]*)\n} $body _ statusline]} {
|
|
set statusline [string trimright $statusline]
|
|
set statusparts [split $statusline " "]
|
|
set statuscode [lindex $statusparts 0]
|
|
set statusinfo [join [lrange $statusparts 1 end] " "]
|
|
# reset redirect counter if the code group is not 3
|
|
if {$statuscode ne 3} {set redirectcount 0}
|
|
if {$statuscode eq 2} { # success - get the remaining body
|
|
regsub {.*?\n} $body "" body
|
|
if {[string match "text/gemini*" $statusinfo]} {
|
|
render_gemtext $textw "$prevurl" "$rooturl" "$body" true
|
|
} elseif {[string match "text/plain*" $statusinfo]} {
|
|
$textw insert end [textsanitize $body] preformatter
|
|
} else {
|
|
$textw insert end $body preformatter
|
|
}
|
|
} elseif {$statuscode eq 3} { # redirect
|
|
if {![string match "/*" $statusinfo]} {
|
|
set statusinfo "/$statusinfo"
|
|
}
|
|
set newurl [string cat $rooturl $statusinfo]
|
|
if {$redirectcount < $redirectlimit} {
|
|
incr redirectcount
|
|
urlfetch "$newurl" 0
|
|
}
|
|
} else { # error
|
|
$textw insert end "Error $statuscode: $statusinfo\n"
|
|
}
|
|
} else {
|
|
$textw insert end "Error: empty response from server\n"
|
|
}
|
|
}
|
|
|
|
# Gemini is like Spartan but with a separate input logic
|
|
# and relative URL support required
|
|
proc render_handler_gemini {prevurl rooturl path body textw} {
|
|
global redirectcount redirectlimit
|
|
if {![string match "/*" "$path"]} {set path "/$path"}
|
|
if {[string match "*/" "$rooturl"]} {set rooturl [string range $rooturl 0 end-1]}
|
|
set baseurl [string cat "$rooturl" "$path"]
|
|
# get the status line
|
|
if {[regexp {^([^\n]*)\n} $body _ statusline]} {
|
|
set statusline [string trimright $statusline]
|
|
set statusparts [split $statusline " "]
|
|
set statuscode [lindex $statusparts 0]
|
|
set mainstatuscode [string index $statuscode 0]
|
|
set statusinfo ""
|
|
if {[llength $statusparts] > 1} {
|
|
set statusinfo [join [lrange $statusparts 1 end] " "]
|
|
}
|
|
if {($statuscode < 10) || ($statuscode > 99)} {
|
|
$textw insert end "Invalid status code $statuscode: $statusinfo\n" errormsg
|
|
return
|
|
}
|
|
# reset redirect counter if the code group is not 3
|
|
if {$mainstatuscode ne 3} {set redirectcount 0}
|
|
# we have several code groups
|
|
switch $mainstatuscode {
|
|
1 { # input required
|
|
global sentry_status bfg_prompt
|
|
grid .sframe.sentry
|
|
.sframe.sentry state !disabled
|
|
unset -nocomplain bfg_prompt
|
|
set sentry_status "$statusinfo:"
|
|
focus .sframe.sentry
|
|
vwait bfg_prompt
|
|
.sframe.sentry state disabled
|
|
grid remove .sframe.sentry
|
|
set newurl "$baseurl?$bfg_prompt"
|
|
urlfetch "$newurl" 1
|
|
}
|
|
2 { # success - get the remaining body
|
|
regsub {.*?\n} $body "" body
|
|
if {[string match "text/gemini*" $statusinfo]} {
|
|
render_gemtext $textw "$prevurl" "$rooturl" "$body" true
|
|
} elseif {[string match "text/plain*" $statusinfo]} {
|
|
$textw insert end [textsanitize $body] preformatter
|
|
} else {
|
|
$textw insert end $body preformatter
|
|
}
|
|
}
|
|
3 { # redirect
|
|
if {[::uri::isrelative $statusinfo]} {
|
|
set newurl [string cat $baseurl $statusinfo]
|
|
} else {set newurl $statusinfo}
|
|
if {$redirectcount < $redirectlimit} {
|
|
incr redirectcount
|
|
urlfetch "$newurl" 0
|
|
}
|
|
}
|
|
6 { # client certificate status - not supported yet
|
|
$textw insert end "The server requires a client certificate — not implemented yet\n"
|
|
$textw insert end "Status $statuscode: $statusinfo\n" errormsg
|
|
}
|
|
default { # error
|
|
$textw insert end "Error $statuscode: $statusinfo\n" errormsg
|
|
}
|
|
}
|
|
} else {
|
|
$textw insert end "Error: empty response from server\n"
|
|
}
|
|
}
|
|
|
|
# history navigation part
|
|
|
|
proc histappend {inputurl} {
|
|
global bfg_history bfg_histidx
|
|
set prevurl ""
|
|
set previdx [expr {$bfg_histidx - 1}]
|
|
if {$bfg_histidx > 0} {
|
|
set prevurl [lindex $bfg_history $previdx]
|
|
}
|
|
if {$inputurl ne $prevurl} {
|
|
set bfg_history [lrange $bfg_history 0 $previdx]
|
|
lappend bfg_history $inputurl
|
|
incr bfg_histidx
|
|
.ctrl.back configure -state normal
|
|
.ctrl.fwd configure -state disabled
|
|
}
|
|
}
|
|
|
|
proc goback {} {
|
|
global bfg_history bfg_histidx targeturl
|
|
if {$bfg_histidx > 0} {
|
|
set newurl [lindex $bfg_history [expr {$bfg_histidx - 2}]]
|
|
if {($newurl ne "") && ($newurl ne $targeturl)} {
|
|
incr bfg_histidx -1
|
|
urlfetch "$newurl" 0
|
|
.ctrl.fwd configure -state normal
|
|
if {$bfg_histidx < 2} {
|
|
.ctrl.back configure -state disabled
|
|
}
|
|
}
|
|
} else {
|
|
.ctrl.back configure -state disabled
|
|
}
|
|
}
|
|
|
|
proc goforward {} {
|
|
global bfg_history bfg_histidx targeturl
|
|
set newurl [lindex $bfg_history $bfg_histidx]
|
|
if {($newurl ne "") && ($newurl ne $targeturl)} {
|
|
incr bfg_histidx
|
|
urlfetch "$newurl" 0
|
|
.ctrl.back configure -state normal
|
|
if {$bfg_histidx >= [llength $bfg_history]} {
|
|
.ctrl.fwd configure -state disabled
|
|
}
|
|
}
|
|
}
|
|
|
|
# in-page text search functionality
|
|
set cursearchidx "1.0"
|
|
set cursearchpattern ""
|
|
proc textsearch {pattern dir isregex} {
|
|
global cursearchidx cursearchpattern
|
|
global bfg_highlight_bgcolor bfg_highlight_fgcolor
|
|
if {("$pattern" eq "") && ("$cursearchpattern" ne "")} {
|
|
set pattern "$cursearchpattern"
|
|
}
|
|
if {("$pattern" ne "$cursearchpattern") && ("$pattern" ne "")} {
|
|
set cursearchidx "1.0"
|
|
}
|
|
set mode {-exact}
|
|
if {$isregex} {set mode {-regexp}}
|
|
set numdir [expr {int($dir)}]
|
|
if {$dir eq -1} {
|
|
set dir {-backwards}
|
|
} else {set dir {-forwards}}
|
|
set fcount 0
|
|
set foundidx [.content.text search $mode $dir -nocase -count fcount $pattern $cursearchidx]
|
|
.content.text tag delete highlight
|
|
if {$foundidx ne ""} {
|
|
# add search highlight tag
|
|
set endidx "$foundidx + $fcount chars"
|
|
.content.text tag add highlight $foundidx $endidx
|
|
.content.text tag configure highlight -background $bfg_highlight_bgcolor -foreground $bfg_highlight_fgcolor
|
|
.content.text see $foundidx
|
|
set cursearchidx "$foundidx + $numdir chars"
|
|
set cursearchpattern "$pattern"
|
|
} else {set cursearchidx "1.0"}
|
|
}
|
|
|
|
# search GUI action
|
|
proc searchui {dir} {
|
|
global cursearchidx cursearchpattern
|
|
global sentry_status bfg_status bfg_prompt bfg_entry
|
|
set prevstatus "$bfg_status"
|
|
grid .sframe.sentry
|
|
.sframe.sentry state !disabled
|
|
unset -nocomplain bfg_prompt
|
|
set sentry_status "Search:"
|
|
set bfg_entry 1
|
|
if {$dir eq -1} {
|
|
set sentry_status "Search backwards:"
|
|
}
|
|
set bfg_status $sentry_status
|
|
focus .sframe.sentry
|
|
vwait bfg_prompt
|
|
.sframe.sentry state disabled
|
|
grid remove .sframe.sentry
|
|
set bfg_entry 0
|
|
textsearch "$bfg_prompt" $dir 0
|
|
set bfg_status "$prevstatus"
|
|
unset -nocomplain bfg_prompt
|
|
}
|
|
|
|
# Bookmark logic
|
|
proc addremovebookmark {url} {
|
|
global bookmarks bookmarklabel bookmarkactive
|
|
global sentry_status bfg_status bfg_rawprompt bfg_prompt bfg_entry
|
|
set urlkey ""
|
|
dict for {bkey bval} $bookmarks {
|
|
if {$bval eq $url} {
|
|
set urlkey $bkey
|
|
}
|
|
}
|
|
if {$urlkey ne ""} { # found the URL, removing the bookmark
|
|
set bookmarks [dict remove $bookmarks $urlkey]
|
|
set bookmarkactive "\u2606"
|
|
set bookmarklabel "Add bookmark"
|
|
} else { # adding a new bookmark
|
|
set prevstatus "$bfg_status"
|
|
grid .sframe.sentry
|
|
.sframe.sentry state !disabled
|
|
unset -nocomplain bfg_prompt
|
|
set sentry_status "Bookmark name:"
|
|
set bfg_entry 1
|
|
set bfg_status $sentry_status
|
|
set bfg_rawprompt $url
|
|
focus .sframe.sentry
|
|
.sframe.sentry selection range 0 end
|
|
vwait bfg_prompt
|
|
.sframe.sentry state disabled
|
|
grid remove .sframe.sentry
|
|
set bfg_entry 0
|
|
# we have the name in bfg_prompt
|
|
set bname [string trim $bfg_prompt]
|
|
dict set bookmarks $bname $url
|
|
set bookmarkactive "\u2605"
|
|
set bookmarklabel "Remove bookmark"
|
|
unset -nocomplain bfg_prompt
|
|
set bfg_status "$prevstatus"
|
|
set sentry_status ""
|
|
}
|
|
savebookmarks
|
|
refreshbookmarks
|
|
}
|
|
|
|
# save the bookmarks in the configuration INI
|
|
proc savebookmarks {} {
|
|
global config_file bookmarks
|
|
set confini [::ini::open $config_file -encoding utf-8]
|
|
::ini::delete $confini bookmarks
|
|
dict for {bkname bkurl} $bookmarks {
|
|
::ini::set $confini bookmarks $bkname $bkurl
|
|
}
|
|
::ini::commit $confini
|
|
::ini::close $confini
|
|
}
|
|
|
|
# build or refresh bookmark menu
|
|
proc refreshbookmarks {} {
|
|
global bookmarklabel bookmarks targeturl
|
|
.ctrl.bkm.menu delete 0 end
|
|
.ctrl.bkm.menu add command -label "$bookmarklabel" -command {addremovebookmark $targeturl}
|
|
.ctrl.bkm.menu add separator
|
|
dict for {bkname bkurl} $bookmarks {
|
|
.ctrl.bkm.menu add command -label "$bkname" -command "urlfetch $bkurl 1"
|
|
}
|
|
}
|
|
|
|
# UI part
|
|
|
|
set contentcursor "left_ptr"
|
|
set targeturl ""
|
|
if {$argc > 0} {
|
|
set targeturl [lindex $argv 0]
|
|
}
|
|
|
|
# set the window title
|
|
wm title . "BFG"
|
|
|
|
# set the window geometry
|
|
wm minsize . 800 600
|
|
|
|
# control bar
|
|
set btnwidth 2
|
|
set btnpad 2
|
|
ttk::frame .ctrl -padding 4
|
|
# change this to 2605 when active
|
|
set bookmarkactive "\u2606"
|
|
set bookmarklabel "Add bookmark"
|
|
grid [ttk::button .ctrl.back -text "\u21a9" -width $btnwidth -style bfg.TButton -command {goback}] \
|
|
-row 0 -column 0 -sticky nes -padx $btnpad
|
|
grid [ttk::button .ctrl.fwd -text "\u21aa" -width $btnwidth -style bfg.TButton -command {goforward}] \
|
|
-row 0 -column 1 -sticky nes -padx $btnpad
|
|
grid [ttk::button .ctrl.refresh -text "\u21bb" -width $btnwidth -style bfg.TButton -command {urlfetch "$targeturl" 0}] \
|
|
-row 0 -column 2 -sticky nes -padx $btnpad
|
|
grid [ttk::entry .ctrl.addr -textvariable targeturl -width 40 -font bfg_entryfont] -row 0 -column 3 -sticky nswe -ipadx $btnpad
|
|
grid [ttk::menubutton .ctrl.bkm -textvariable bookmarkactive -style bfg.TButton -width $btnwidth -menu .ctrl.bkm.menu] \
|
|
-row 0 -column 4 -sticky nws -padx $btnpad
|
|
grid columnconfigure .ctrl 3 -weight 1
|
|
|
|
# bookmarks menu
|
|
menu .ctrl.bkm.menu -tearoff 0 -cursor $contentcursor
|
|
refreshbookmarks
|
|
|
|
# main content widget
|
|
ttk::frame .content
|
|
tk::text .content.text -cursor $contentcursor -yscrollcommand ".content.yscroll set" -wrap word \
|
|
-font bfg_textfont -foreground $bfg_main_fgcolor -background $bfg_main_bgcolor -state disabled
|
|
ttk::scrollbar .content.yscroll -orient vertical -command ".content.text yview"
|
|
grid .content.text -column 0 -row 0 -sticky nsew
|
|
grid .content.yscroll -column 1 -row 0 -sticky ns
|
|
grid columnconfigure .content 0 -weight 1
|
|
grid rowconfigure .content 0 -weight 1
|
|
|
|
# status bar
|
|
ttk::frame .sframe
|
|
ttk::label .sframe.status -padding 4 -textvariable bfg_status -font bfg_statusfont
|
|
ttk::entry .sframe.sentry -textvariable bfg_rawprompt -state disabled -font bfg_entryfont
|
|
grid .sframe.status -column 0 -row 0 -sticky nsew
|
|
grid .sframe.sentry -column 1 -row 0 -sticky nsw
|
|
grid columnconfigure .sframe 0 -weight 1
|
|
set bfg_status Ready
|
|
|
|
# place them all
|
|
grid .ctrl -column 0 -row 0 -sticky nsew
|
|
grid .content -column 0 -row 1 -sticky nsew
|
|
grid .sframe -column 0 -row 2 -sticky nsew
|
|
grid remove .sframe.sentry
|
|
|
|
# root grid geometry: don't resize the top and bottom row
|
|
grid rowconfigure . 1 -weight 1
|
|
grid columnconfigure . 0 -weight 1
|
|
|
|
# iterate over available platform-dependent themes, apply "clam" if none found
|
|
catch {ttk::style theme use clam}
|
|
catch {ttk::style theme use aqua}
|
|
catch {ttk::style theme use winnative}
|
|
catch {ttk::style theme use $bfg_theme}
|
|
|
|
# apply custom styles
|
|
ttk::style configure bfg.TButton -font bfg_widgetfont
|
|
|
|
# set up keybindings
|
|
|
|
# address entry
|
|
bind .ctrl.addr <Return> {urlfetch "$targeturl" 1}
|
|
bind .ctrl.addr <FocusIn> {set bfg_entry 1; .ctrl.addr selection range 0 end}
|
|
bind .ctrl.addr <FocusOut> {set bfg_entry 0; .ctrl.addr selection clear}
|
|
focus .ctrl.addr
|
|
|
|
# scroll and focus into the numbered link
|
|
proc linkfocus {lnum noscroll} {
|
|
global bfg_focusedlink_fgcolor bfg_focusedlink_bgcolor
|
|
# scroll into the link
|
|
set ci [lindex [.content.text tag ranges "bfglink_$lnum"] 0]
|
|
if {$noscroll eq 0} {
|
|
.content.text see $ci
|
|
}
|
|
# add highlight tag
|
|
set rng [string cat [lindex [split $ci .] 0] ".end"]
|
|
.content.text tag delete focuslink
|
|
.content.text tag add focuslink $ci $rng
|
|
.content.text tag configure focuslink -foreground $bfg_focusedlink_fgcolor -background $bfg_focusedlink_bgcolor
|
|
}
|
|
|
|
# do this on startup
|
|
if {$targeturl ne ""} {
|
|
.ctrl.addr selection clear
|
|
urlfetch "$targeturl" 1
|
|
}
|
|
set bfg_entry 0
|
|
set bfg_rawprompt ""
|
|
.ctrl.back configure -state disabled
|
|
.content.text tag configure errormsg -foreground $bfg_error_fgcolor -background $bfg_error_bgcolor
|
|
.content.text tag configure preformatter -font bfg_monofont
|
|
|
|
# general keybinding switch
|
|
|
|
bind . <Key> {
|
|
if {$bfg_entry eq 0} {
|
|
switch "%K" {
|
|
g {focus .ctrl.addr}
|
|
F5 -
|
|
r {urlfetch "$targeturl" 0}
|
|
default {}
|
|
b {goback}
|
|
f {goforward}
|
|
Prior -
|
|
Left -
|
|
h {.content.text yview scroll -1 pages}
|
|
Next -
|
|
Right -
|
|
l {.content.text yview scroll 1 pages}
|
|
Down -
|
|
j {.content.text yview scroll 1 units}
|
|
Up -
|
|
k {.content.text yview scroll -1 units}
|
|
a { # select previous link
|
|
if {$linkcount > 0} { # we have some links
|
|
incr curlink -1
|
|
if {$curlink < 0} {
|
|
set curlink [expr {$linkcount - 1}]
|
|
}
|
|
linkfocus $curlink 0
|
|
set vurl [lindex $linklist $curlink]
|
|
set bfg_status "=> [trunc $vurl]"
|
|
}
|
|
}
|
|
s { # select next link
|
|
if {$linkcount > 0} { # we have some links
|
|
incr curlink
|
|
if {$curlink >= $linkcount} {
|
|
set curlink 0
|
|
}
|
|
linkfocus $curlink 0
|
|
set vurl [lindex $linklist $curlink]
|
|
set bfg_status "=> [trunc $vurl]"
|
|
}
|
|
}
|
|
space -
|
|
Return { # visit the focused link
|
|
if {$linkcount > 0} { # we have some links
|
|
.content.text tag delete focuslink
|
|
clicklink $curlink
|
|
}
|
|
}
|
|
d { # download the focused link
|
|
if {$linkcount > 0} { # we have some links
|
|
downloadlink $curlink 0
|
|
}
|
|
}
|
|
D { # download the focused link and open it externally
|
|
if {$linkcount > 0} { # we have some links
|
|
downloadlink $curlink 1
|
|
}
|
|
}
|
|
Escape { # reset search highlights
|
|
set cursearchpattern ""
|
|
set cursearchidx "1.0"
|
|
.content.text tag delete highlight
|
|
}
|
|
slash {searchui 1}
|
|
default {}
|
|
}
|
|
}
|
|
}
|
|
|
|
bind . <Shift-space> {
|
|
if {$linkcount > 0} { # we have some links
|
|
windowlink $curlink 0
|
|
}
|
|
}
|
|
|
|
bind . <Shift-Return> {
|
|
if {$linkcount > 0} { # we have some links
|
|
windowlink $curlink 0
|
|
}
|
|
}
|
|
|
|
bind . <Control-Shift-space> {
|
|
if {$linkcount > 0} { # we have some links
|
|
windowlink $curlink 1
|
|
}
|
|
}
|
|
|
|
bind . <Control-Shift-Return> {
|
|
if {$linkcount > 0} { # we have some links
|
|
windowlink $curlink 1
|
|
}
|
|
}
|
|
|
|
# generic mouse click events
|
|
# 1 - left, 2 - mid, 3 - right, 8 - back, 9 - forward
|
|
bind . <Button> {
|
|
if {$bfg_entry eq 0} {
|
|
switch "%b" {
|
|
8 {goback}
|
|
9 {goforward}
|
|
default {}
|
|
}
|
|
}
|
|
}
|
|
|
|
# status entry
|
|
bind .sframe.sentry <Return> {
|
|
set bfg_prompt "$bfg_rawprompt"
|
|
set bfg_rawprompt ""
|
|
}
|
|
bind .sframe.sentry <Enter> {
|
|
if {$sentry_status ne ""} {
|
|
set bfg_status [trunc "$sentry_status"]
|
|
}
|
|
}
|
|
bind .sframe.sentry <FocusIn> {
|
|
set bfg_entry 1
|
|
if {$sentry_status ne ""} {
|
|
set bfg_status [trunc "$sentry_status"]
|
|
}
|
|
}
|
|
bind .sframe.sentry <FocusOut> {
|
|
set bfg_entry 0
|
|
}
|
|
|
|
# search
|
|
bind . <Control-f> {searchui 1}
|
|
bind . <Control-F> {searchui -1}
|
|
bind . <Control-slash> {searchui -1}
|
|
|
|
# bookmark menu
|
|
bind . <Control-b> {event generate .ctrl.bkm <Button-1>}
|
|
|
|
# exit
|
|
bind . <Control-q> {exit 0}
|