#!/usr/local/bin/wish8.0
#!/space/home/jc/bin/wish8.0
# NAME
# HTML - Display HTML text in a window
#
# SYNOPSIS
# HTML [file | URL]...
#
# DESCRIPTION
# This is a prototype HTML window. It is highly experimental at
# present. Use it at your own risk (or confusion). The main reason
# for this program is to have a "debug" version of an HTML viewer.
# The emphasis here is on informativeness, not fancy features.
#
# This program pops up a text window and fills it with the contents
# of a file. Files may be given as local file names or as URLs,
# which will be read using the w3cat(x) program as a subprocess.
# This program thus functions much like a web browser, but with
# lots of hooks to help debug HTML applications.
#
# If there are names on the command line, they are loaded into the
# "History" menu, and the first is loaded as the "current" file.
# The others may be loaded by using the History menu.
#
# CONFIG
# We read a config file, which should be called .htmlinit, and may
# be anywhere in the search path. It should be a wish script. It
# -fg can do anything, of course, but the recommended use is for
# setting global variables.
#
# OPTIONS
# There are a few, mostly kept in the opt() array. You might want
# to scan this script for opt(...) to get ideas.
#
# opt(TABLE)
# This is a value that says whether to handle
and related
# tags. This is not fully implemented yet. 1 means to use the
# code that just uses basic tk functions; 2 means to use the
# tkTable package.
#
# opt(ALT)
# If true, we will show the ALT= attribute for all images, as a
# label widget under the image. The default opt(ALT)==0 means
# that we show the ALT string initially, and replace it with the
# image when we get it.
#
# opt(IMG)
# If true, will attempt to load images and display them. If
# false, only the ALT text will be shown for the images. This is
# useful in testing whether a page will work for text-only
# browsers. The default is true.
#
# opt(TARGET)
# If true, will open new windows for URLs with TARGET attributes.
# The default is false, which means to show all documents in the
# single (_top) window.
#
# INITIALIZATION
# This program looks through the search path for .htmlinit, and
# sources the first such file that is found. This is done after our
# basic initialization of globals, so it can override any of them.
#
# REQUIRES
# Various parts of this program have been split off into separate
# modules, some of which run as separate processes. See the list of
# Source commands below. You should find all of them in the same
# directory where you found this file. Make sure that you put them
# into a directory that is in your search path, so we can find them
# at run time.
#
# URLcache is used as a separate process for maintaining a cache of
# images. If we can't send messages to URLcache, we will start one.
# This reqires that the send command be usable with your wish,
# which is sometimes a tricky setup. If you can't make it work, try
# recompiling your tk library with the SECURITY stuff disabled. And
# describe your problems to the comp.lang.tcl newsgroup. This isn't
# pretty, but sometimes that's all you can do.
#
# The w3cat program is used to fetch files from web servers. It is
# written in perl, so you'll need that language, too, if you want
# to access documents via the web.
#
# BUGS
# We haven't yet implemented all the bizarre features that some of
# the web vendors have foisted on us as "HTML". In fact, we don't
# quite have all of HTML 3.0 working yet. (That's why tables are
# turned off by default.) Stay tuned ...
#
# SEE ALSO
# w3cat(x)
# URLcache(x)
#
# AUTHOR
# Copyright 1998 by John Chambers
# You are free to use this code however you wish, as long as you 1)
# don't claim you wrote it; 2) don't try to sell it; and 3) send me
# copies of any significant additions you make.
set myname [wm title .]
set ME [lindex $myname 0]
if ![regsub {.*/} $ME {} me] {set me $ME}
if [info exists env(V_$me)] {set V $env(V_$me)} else {set V 1}
if {$V>1} {puts "$me: Started with V=$V."}
set title {HTML viewer}
wm title . $title
set URLs {}; # URL list from command line.
set URLt(.d.t) {}; # Current URL for each text widget.
set Hist {}; # History array (URLs).
set curF {.d}; # Current document's frame.
set curL {}; # Currend link's URL.
set curN {}; # Currend widget's name.
set curT {.d.t}; # Current document's text widget.
set curW {}; # Current document's window.
set curX 0; # Current X position of pointer.
set curY 0; # Current Y position of pointer.
# tk_setPalette grey60
if [info exists env(V_$me)] {set V $env(V_$me)} else {set V 1}
if [info exists env(B_$me)] {set B $env(B_$me)} else {set B 0}
if [info exists env(F_$me)] {set F $env(F_$me)} else {set F 5}
if [info exists env(R_$me)] {set R $env(R_$me)} else {set R ridge}
if [info exists env(EDITOR)] {set E $env(EDITOR)} else {set E vi}
if [info exists env(TMPDIR)] {set Tmpdir $env(TMPDIR)} else {set Tmpdir /tmp}
if [info exists env(IMGDIR)] {set Imgdir $env(IMGDIR)} else {set Imgdir /tmp}
# Symbols used when creating widgets:
set BB {-padx 3 -pady 0 -highlightthickness 0 -bd $F -relief $R}
set EB {-highlightthickness 0 -width 0 -bd $B -relief $R}
set FB {-bd $B -relief $R}
set IB {-bd $B -relief $R}
# The C() array holds global color names:
set C(bg) grey40 ;set Dsc(C:bg:title) {Document background color}
set C(fg) green ;set Dsc(C:fg:title) {Document foreground color}
set C(hl) cyan1 ;set Dsc(C:l1) {Hyperlink color}
set C(vl) cyan2 ;set Dsc(C:l2) {Visited link color}
set C(nm) orange ;set Dsc(C:nm) {HTML name color}
set C(E) yellow ;set Dsc(C:E) {Variable entry color}
set C(fg:title) white ;set Dsc(C:fg:title) {Title foreground color}
set C(bg:title) grey40 ;set Dsc(C:bg:title) {Title background color}
set mydir [file dirname [info script]]
if {$V>1} {puts "$me: mydir=\"$mydir\""}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Default values for assorted global variables:
set bufsiz 1000
set section {}
set Ftag 3vsr
set Ltag Lnorm
set Lnum Lnk0
set LC { }; # Last char in window.
set wantNL(.d.t) 0; # Number of newlines to add before next text.
set SP(.d.t) {}; # Saved spaces for text widget.
#set in(A) 0; # Whether we are in aset in(Aed (linked) section.
#set in(BODY) 0; # Whether we are in a ... section.
#set in(FONT) 0; # Whether we are in a ... section.
#set in(HEAD) 0; # Whether we are in a ... section.
#set in(H) 1; # Whether we are treating current text as HTML.
#set in(HDR) 0; # Whether we are in the header section of a document.
#set in(PLAINTEXT) 0; # Whether we are in a ... section.
#set in(PRE) 0; # Whether we are in a ...
section.
#set in(SCRIPT) 0; # Whether we are in a section.
#set in(TABLE) 0; # Whether we are in a section.
#set in(TCL) 0; # Whether we are processing embedded TCL code.
#set in(comment) 0; # Whether we are in a comment section.
#set in(except) 0; # Exception to HTML is in effect (PRE or SCRIPT)
set N(HR) 0; # Counter for HR widgets.
set N(TARGET) 0; # Counter for target windows.
set isRmt 0; # True if current page is remote file.
set mark 0
set ll 0; # List level
set lm1 0; # Left margin for first lines.
set lm2 0; # Left margin for other lines.
set Link(0) {}
set L(T0) 0
set L(N0) 0
set L(i0) 0
set L(i1) [set ts 25]
set L(i2) [expr 2*$ts]
set TS(li0) {}
set TS(ll0) 0
set Mtab Mtab0 ;# Current mark for tabbing.
set scripts 0 ;# Number of scripts defined.
set off(X) 10 ;# X offset for popups
set off(Y) 10 ;# U offset for popups
set opt(_) 0 ;set Dsc(opt:_) {If true, show spaces as underscores}
set opt(B) 1 ;set Dsc(opt:B) {Widget border widths}
set opt(F) 1 ;set Dsc(opt:F) {Frame border widths}
set opt(ALT) 1 ;set Dsc(opt:ALT) {If true, always show ALT values}
set opt(BASEFONT) 3 ;set Dsc(opt:BASEFONT) {Starting font for documents}
set opt(FONTSIZE) 1 ;set Dsc(opt:FONTSIZE) {If true, accept font-size attributes}
set opt(IMG) 1 ;set Dsc(opt:IMG) {If true, attempt to show images}
set opt(H) 1 ;set Dsc(opt:HTML) {Whether to assume that new text is HTML}
set opt(MOTIF) 0 ;set Dsc(opt:MOTIF) {Act as much like MOTIF as possible}
set opt(Option) 0 ;set Dsc(opt:Option) {Whether to show the Option window}
set opt(Source) 0 ;set Dsc(opt:Source) {Whether to show the Source.tclindow}
set opt(Header) 0 ;set Dsc(opt:Header) {Whether to show the Header window}
set opt(POPUP) 1 ;set Dsc(opt:POPUP) {How to display popups}
set opt(TARGET) 0 ;set Dsc(opt:TARGET) {Whether to honor TARGET attributes}
set opt(TABLE) 0 ;set Dsc(opt:TABLE) {How to handle tables}
set opt(Width) 0 ;set Dsc(opt:Width) {Default width (chars) of main document}
set opt(Height) 0 ;set Dsc(opt:Height) {Default height (chars) of main document}
set opt(TCL) 0 ;set Dsc(opt:TCL) {Whether to eval tcl inclusions}
set opt(TTL) 0 ;set Dsc(opt:TITLE) {Whether to show titles in window in info area}
set opt(URL) 1 ;set Dsc(opt:_URL_) {Whether to show URL widget in info area}
set opt(MSG) 1 ;set Dsc(opt:_MSG_) {Whether to show message widget in info area}
set opt(LNK) 0 ;set Dsc(opt:_LNK_) {Whether to show hyperlink URLs in info area}
set opt(NAM) 0 ;set Dsc(opt:_NAM_) {Whether to show widget names in info area}
if {$V>1} {set opt(Debug) 1} else {set opt(Debug) 0}
set Dsc(opt:Debug) {Whether to show the Debug window}
set Dsc(var:V) {Debug/verbose level}
set Dsc(var:B) {Debug border widths}
set Dsc(var:F) {Debug frame widths}
set Dsc(var:R) {Debug border relief}
if [info exists env(MOTIF)] {set opt(MOTIF) $env(MOTIF)}
set Link(sel) {}
set doctype {}
set subtype {}
set imageViewer {wrapper xv -}
set imageBufsiz 1000
set imagePipe {}
set in(IMAGE) 0
set UE(\ ) +
set UE(\") %22
set UE(#) %23
set UE(%) %25
set UE(&) %26
set UE(+) %2B
set UE(/) %2F
set UE(:) %3A
set UE(\;) %3B
set UE(<) %3C
set UE(=) %3D
set UE(>) %3E
set UE(?) %3F
set UE(@) %40
set UE(\[) %5B
set UE(\\) %5C
set UE(\]) %5D
set UE(^) %5E
set UE(`) %6D
set UE(\{) %7B
set UE(|) %7C
set UE(\}) %7D
set UE(~) %7E
if {$V>1} {puts "$me: after sets."}
# Border widths for some widgets:
set bd(DB) $B; # Debug borders.
set bd(IMG) 0; # Inline image borders.
set bd(LNK) 0; # Hyperlink borders.
set bd(TABLE) $B; # Table borders.
set bd(.d.t) 0; # Border width for main document.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Load in some useful packages. We can't use Source until we've loaded it, so #
# the first line here is a bit complicated. Then Loadfile takes care of it #
# for us. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
set initfile {}
set PATH [split $env(PATH) :]
foreach d $PATH {if [file exists $d/Source.tcl] {source [set Path(Source.tcl) $d/Source.tcl];break}}
foreach d $PATH {
if [file readable $d/.htmlinit] {source [set Path([set initfile .htmlinit]) $d/.htmlinit]; break}
if [file readable $d/.htmlrc ] {source [set Path([set initfile .htmlrc ]) $d/.htmlrc]; break}
}
if {$V>1} {puts "$me: After loading init file \"$initfile\" ($Path($initfile))"}
Source pvar.w
Source Help.w
Source Verbose.w
Source forAllMatches.w
Source txtWin.w
Source Misc.w
Source H_err
Source H_find
Source H_font
Source H_form
Source H_html
Source H_tag
Source H_load
Source H_select
Source H_table
Source H_url
Source H_chars
Source H_link
Source H_mark
Source H_menu
Source H_size
Source H_text
Source H_wait
Source H_win
FontInit
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if {$V>1} {puts "$me: before iconbitmap."}
foreach d [split $env(PATH) :] {
if [file exists $d/$me.xbm] {
if {$V>1} {puts "$me: Bitmap file \"$d/$me.xbm\""}
if [catch {image create bitmap rooticon -file "$d/$me.xbm"} x] {
Msg "Can't create image from file \"$d/$me.xbm\""
}
wm iconbitmap . @$d/$me.xbm
break
}
}
if {$V>1} {puts "$me: after iconbitmap."}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# We read in our init file last, so that everything above this point may be #
# treated as "defaults" that may be overridden by the config file. Also, if #
# there is a .htmlsettings file, we load it last, and we'll use it as a sort #
# of "dynamic" way of setting options. See LoadSettings and SaveSettings for #
# more details. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
LoadSettings
if {$opt(MOTIF)} {set tk_strictMotif 1}
if {$V>1} {puts "$me: After tk_strictMotif."}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Set up a new font for the named widget (which should be a text widget). The
# args can all be null, in which case we default them to the current values
# for $w at the current font level. The global variable Ftag holds the current
# font code for the current text widget. The Ftags() array holds the font
# codes for each font-level+text-widget combination. All of this is to take
# care of the fact that font-related tags may be nested. For font level fl
# in the text widget w, we remember font info with the following:
# Fsize($fl$w) The font's HTML size, 1-7.
# Fspce($fl$w) The font's spacing: v=variable f=fixed.
# Fslnt($fl$w) The font's HTML slant: r=roman, i=italic.
# Fwght($fl$w) The font's HTML weight: m=medium, b=bold
# We may need to augment some of these eventually.
proc PushFont {size spce slnt wght} {
global V me curT Fsize Fspce Fslnt Fwght in opt
if {$V>1} {set id "$me/PushFont"}
if {$V>2} {puts "$id: curT=\"$curT\" size=$size spce=$spce slnt=$slnt wght=$wght."}
if [info exists in(FONT)] {set l2 $in(FONT)} else {set l2 [set in(FONT) 0]}
if {!$opt(FONTSIZE)} {set size 3}
set l1 $in(FONT)
set l2 [incT FONT]
set ff "$l2$curT"
if {$V>2} {puts "$id: l1=$l1 l2=$l2 ff=\"$ff\""}
# Get txt's values or defaults for any null args:
if {$size == {}} {if [info exists Fsize($l1$curT)] {set size $Fsize($l1$curT)} else {set size 3}}
if {$spce == {}} {if [info exists Fspce($l1$curT)] {set spce $Fspce($l1$curT)} else {set spce v}}
if {$slnt == {}} {if [info exists Fslnt($l1$curT)] {set slnt $Fslnt($l1$curT)} else {set slnt r}}
if {$wght == {}} {if [info exists Fwght($l1$curT)] {set wght $Fwght($l1$curT)} else {set wght m}}
if {$V>2} {puts "$id: size=$size spce=$spce slnt=$slnt wght=$wght for $ff."}
SetFont $curT $l2 $size $spce $slnt $wght
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc PopFont {} {
global V me curT Fsize Fspce Fslnt Fwght in opt
if {$V>1} {set id "$me/PopFont"}
if {$V>2} {puts "$id: curT=\"$curT\""}
set l1 $in(FONT)
set l2 [decT FONT]
set ff "$l2$curT"
if {$V>2} {puts "$id: l1=$l1 l2=$l2 ff=\"$ff\""}
if [info exists Fsize($ff)] {set size $Fsize($ff)} else {set size 3}
if [info exists Fspce($ff)] {set spce $Fspce($ff)} else {set spce v}
if [info exists Fslnt($ff)] {set slnt $Fslnt($ff)} else {set slnt r}
if [info exists Fwght($ff)] {set wght $Fwght($ff)} else {set wght m}
if {$V>2} {puts "$id: size=$size spce=$spce slnt=$slnt wght=$wght for $ff."}
SetFont $curT $l2 $size $spce $slnt $wght
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Set all the font info for text widget t level l. This routine assumes that
# all the parameters are valid; they were calculated in PushFont and PopFont..
proc SetFont {t l size spce slnt wght} {
global V me Fsize Fspce Fslnt Fwght Ftag Ftags FF gotfont
set id "$me/SetFont"
set ff "$l$t"
if {$V>2} {puts "$id: t=\"$t\" l=$l size=$size spce=$spce slnt=$slnt wght=$wght."}
set Ftag "$size$spce$slnt$wght"
set Fsize($t) [set Fsize($ff) $size]; # HTML size (1-7)
set Fspce($t) [set Fspce($ff) $spce]; # Spacing: v=variable f=fixed
set Fslnt($t) [set Fslnt($ff) $slnt]; # Slant: s=straight i=italic
set Fwght($t) [set Fwght($ff) $wght]; # weight: n=normal b=bold
set Fdsc "-family $FF(fmly$spce) -weight $FF(wght$wght) -slant $FF(slnt$slnt) -size $FF(size$size)"
if {$V>2} {puts "$id: Ftag=\"$Ftag\""}
if ![info exists gotfont($Ftag)] {
if {$V>2} {puts "$id: FONT $Ftag $Fdsc"}
eval font create F$Ftag $Fdsc
set gotfont($Ftag) 1
} else {
if {$V>2} {puts "$id: FONT $Ftag is \"[font config F$Ftag]\""}
}
if {$V>2} {puts "$id: $t tag config F$Ftag -font F$Ftag"}
$t tag config F$Ftag -font F$Ftag
set Ftags($ff) F$Ftag
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc BR w {
global V me in LC wantNL curT
if {$LC == "\n"} {
if {$V>2} {puts "$me/BR: Ignored because LC is a newline."}
return
}
if {$in(PRE) > 0} {
if {$wantNL($curT) < 1} {
if {$V>2} {puts "$me/BR: Call Hnl because in(PRE)=$in(PRE) and wantNL($curT)=$wantNL($curT)."}
Hnl 1
}
} else {
if {$V>2} {puts "$me/BR: Call Hnl because in(PRE)=$in(PRE)."}
Hnl 1
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc ButtonBindings {w f l} {
global V me
if {$V>2} {puts "$me/ButtonBindings: w=\"$w\" f=\"$f\" link $l"}
bind $f "LinkButton1 $w $l %X %Y"
bind $f "LinkShiftB1 $w $l %X %Y"
bind $f "LinkButton3 $w $l %X %Y"
bind $f "LinkEnter $f $l %X %Y %W"
bind $f "LinkLeave $f $l %X %Y %W"
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Clicking button 1 over anything associated with link n causes us to load #
# the link's URL into the text widget w. This routine is bound to button 1 in #
# several places, all of them leading here when the user clicks the button. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc LinkButton1 {txt n X Y} {
global C V me Link curX curY target
set curX $X
set curY $Y
if {$V>1} {puts "LinkButton1: Click Link $n \"$Link($n)\""}
if [regexp -nocase {^mailto:[ ]*"*(.*)"*$} $Link($n) {} rcpt] {
if {$V>1} {puts "LinkButton1: MAILTO rcpt=\"$rcpt\""}
exec M_EditSend $rcpt &
return
}
set U [url2URL $Link($n)]
if [winfo exists .doclink$n] {destroy .doclink$n}
if ![info exists target($n)] {set target($n) {}}
if [regexp {(.*)\.\d\.\t$} $txt {} w] {
LoadFile $w $target($n) $U GET
} else {
Msg "Can't determine window for \"$txt\""
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Button 3 over a link gives a menu of operations that can be done using the #
# link's URL as a parameter. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc LinkButton3 {txt n X Y} {
global C V me Link curX curY
set curX $X
set curY $Y
if {$V>1} {puts "$me/LinkButton3: Click Link $n in $txt \"$Link($n)\""}
$txt tag config Lnk$n -foreground $C(vl)
if [winfo exists .b3menu] {destroy .b3menu}
menu .b3menu -tearoff 0
.b3menu add command -label {Copy URL to Clipboard} -command "Link2Cut $n"
.b3menu add command -label {Load to new window} -command "Link2Win $txt $n %X %Y"
.b3menu add command -label {Load to file} -command "Link2File $txt $n %X %Y"
if {$X && $Y} {tk_popup .b3menu $X $Y}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# The Shift-B1 combination causes a new window to be started up for the link. #
# This can also be done by using B3's "Load to new window" menu item. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc LinkShiftB1 {txt n X Y} {
global C V me Link curX curY
set curX $X
set curY $Y
if {$V>1} {puts "$me/LinkShiftB1: Click Link $n in $txt \"$Link($n)\""}
Link2Win $txt $n %X %Y
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here's a cute way to export data to the server's cut buffer: We create .sel #
# as a non-displayed widget, fill it with the data, and declare that it owns #
# the selection. Even though .sel never appears on the screen, we can paste #
# from it to another window. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Link2Cut {n} {
global V me Link
if ![winfo exists .sel] {text .sel}
selection own .sel
.sel delete 1.0 end
if {$V>4} {puts "$id: .sel insert end \"$Link($n)\" sel"}
.sel insert end $Link($n) sel
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Download a link into a file.
proc Link2File {txt n X Y} {
global C V me Link curX curY
set curX $X
set curY $Y
if {$V>1} {puts "Link2File: Load Link $n {$Link($n)}"}
$txt tag config Lnk$n -foreground $C(vl)
set url [url2URL $Link($n)]
set forkcmd "w3cat $url"
if {$V>1} {puts "Link2File: forkcmd=\"$forkcmd\""}
eval exec $forkcmd &
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Fork off a copy of this program to do a new URL.
proc Link2Win {txt n X Y} {
global C V me Link curX curY
set curX $X
set curY $Y
if {$V>1} {puts "Link2Win: Click Link $n {$Link($n)}"}
$txt tag config Lnk$n -foreground $C(vl)
set url [url2URL $Link($n)]
set forkcmd "$me $url"
if {$V>1} {puts "Link2Win: forkcmd=\"$forkcmd\""}
eval exec $forkcmd &
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Canonicalize a directory name. We reduce multiple slashes, and strip out
# uses of "/../". Maybe we should also delete initial "./".
proc Dir {d} {
global V me
if {$V>5} {puts "$me/Dir: Reducing: \"$d\""}
regsub -all {//+} $d / d
while [regsub {[^/]+/\.\./} $d {} d] {
if {$V>5} {puts "$me/Dir: Edited to \"$d\""}
}
if {$d == {}} {set d {./}}
if {$V>5} {puts "$me/Dir: Returned: \"$d\""}
return $d
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Add a message to the Debug window. We also check to see if the scrollbar is #
# positioned at the bottom, and if so, we scroll to keep the bottom visible. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc Msg e {
global V me errmsg
set id "$me/Msg"
if {$V>1} {puts "$id: \"$e\""}
set errmsg $e
set tsy1 [lindex [set tsy [.dbg.txt.s.y get]] 1]
if {$V>4} {puts "$id: .dbg.txt.t insert end \"$e\\n\""}
.dbg.txt.t insert end $e\n
if {$tsy1 == 1.0} {
if {$V>1} {puts "$id: Scroll .dbg.txt.t to bottom"}
.dbg.txt.t yview moveto 1.0
}
update idletasks
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Nesting tags need to be closed. For the optional cases, don't put an entry
# here, and we will simply ignore the end tags.
set Ntag {A B BIG BL BODY CENTER DIV DL EM FONT FORM H1 H2 H3 H4 H5 H6 HEAD HTML I OL OPTION PRE SCRIPT SELECT STRONG TABLE TCL TITLE UL comment}
proc NtagInit {} {
global in N Ntag
foreach t $Ntag {
set in($t) 0; # How deep we are nested within this tag.
set N($t) 0; # Count of times this tag has been encountered.
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Note which section of the HTML document (head, body) we are in. This is set
# up as a proc for use in debugging; all we really do is save s in the global
# section variable..
proc Section s {
global V me section
if {$V>1} {puts "$me: Section <$s> (was <$section>)"}
set section $s
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# This does some simple-minded URL entity encoding.
proc URL {s} {
global V me UE
if {$V>2} {puts "$me/URL \"$s\""}
set v {}
while [regexp {^(.*)([][;/?:@=&+<>\\#%{|}\\^~` ])(.*)$} $s {} init c tail] {
if {$V>2} {puts "$me/URL: {$init} {$c} {$tail}"}
set v "$UE($c)$tail$v"
set s $init
}
if {$V>2} {puts "$me/URL: \"$s$v\" returned."}
return "$s$v"
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# For a target window, we fill it up with the appropriate widgets. This is a
# bit ad hoc at present and we might well to do a bit of reorganizing here if
# things eventually settle down.
proc TargetWin {w t} {
global V me B BB C F R curF curL curN curT curW namN bd target \
Tfont Txt txtlvl Lbgn Lfgn Lfgl opt URLt
set id "$me/TargetWin"
if {$V>1} {puts "$id: Build \"$w\" target window."}
if {$w != {}} {
if ![winfo exists $w] {
if {$V>1} {puts "$id: Create toplevel window \"$w\""}
toplevel $w
}
}
bind $w "EnterW $w %X %Y"
if {$V>1} {puts "$id: $w.b frame."}
#
frame $w.b -bd 3 -relief ridge; # Holds folder selection menus/buttons
frame $w.i -bd $F -relief $R; # Holds information widgets.
frame $w.d -bd $B -relief $R; # Holds the document.
#
frame $w.d.s -bd 0
pack $w.d.s -in $w.d -side left -fill y
#
if {[set hght $opt(Height)] < 1} {set hght 20}
set T $w.d.t
text $T -tabs {4m left} \
-yscrollcommand "$w.d.s.y set" \
-xscrollcommand "$w.d.sbx set" \
-wrap word -bd $bd($T) -relief $R \
-width $opt(Width) -height $hght -highlightthickness 0
scrollbar $w.d.s.y -command "$T yview" -bd 1 -width 8 -orient vertical
scrollbar $w.d.sbx -command "$T xview" -bd 1 -width 8 -orient horizontal
button $w.d.s.x -command "Load {$w}" -bd 1 -text * \
-padx 0 -pady 0 -highlightthickness 0
pack $w.d.s.x -in $w.d.s -side top -fill x
pack $w.d.s.y -in $w.d.s -side bottom -fill y -expand 1
pack $w.d.sbx -in $w.d -side top -fill x
pack $w.d.t -in $w.d -side left -fill both -expand 1
BindHelp $w.d.s.x Reload
SetFont $T 0 3 v r m
#
set Lbgn [lindex [$T config -background] 4]
set Lfgn [lindex [$T config -foreground] 4]
set Lfgl cyan
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# The globals curW and curT contain the names of the current window and text
# widget. This is one of the most important things to understand here (and
# often one of the trickiest points to get right). Also, we map the HTML
# target="_top" to our main window here. However, at present we don't do
# much with targets.
#
set target(_top) $w.d
set curT [set Txt([set txtlvl 0]) [set curF [set curW $w].d].t]
if {$V>1} {puts "$id: curT=Txt($txtlvl)={$curT} target(_top)=\"$target(_top)\""}
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if ![winfo exists $w.b.bCmd] {
eval menubutton $w.b.bCmd -text Cmds -menu $w.b.bCmd.menu -padx 0 -pady 0 $BB
bind $w.b.bCmd {menuCmd $curW %X %Y}
pack $w.b.bCmd -in $w.b -side left
set namN($w.b.st.bCmd) {Commands}
menuCmd $curW 0 0
}
if ![winfo exists $w.b.bOpt] {
eval menubutton $w.b.bOpt -text Opts -menu $w.b.bOpt.menu -padx 0 -pady 0 $BB
bind $w.b.bOpt "menuOpt {$w} %X %Y"
pack $w.b.bOpt -in $w.b -side left
set namN($w.b.st.bOpt) {Options}
menuOpt $w 0 0
}
if ![winfo exists $w.b.bWin] {
eval menubutton $w.b.bWin -text Wins -menu $w.b.bWin.menu -padx 0 -pady 0 $BB
bind $w.b.bWin {menuWin $curW %X %Y}
pack $w.b.bWin -in $w.b -side left
set namN($w.b.st.bWin) {Control windows}
menuWin $curW 0 0
}
if ![winfo exists $w.b.bHst] {
eval menubutton $w.b.bHst -text Hist -menu $w.b.bHst.menu -padx 0 -pady 0 $BB
bind $w.b.bHst {menuHst L $curW %X %Y}
bind $w.b.bHst {menuHst L $curW %X %Y}
bind $w.b.bHst {menuHst H $curW %X %Y}
bind $w.b.bHst {menuHst H $curW %X %Y}
pack $w.b.bHst -in $w.b -side left
set namN($w.b.st.bHst) {URL history list}
menuHst 1 $curW 0 0
}
if ![winfo exists $w.b.st] {
eval frame $w.b.st -bd 1 -relief $R
eval button $w.b.st.bBck $BB -relief raised -text {<-} -command {{Stk dn}}
eval menubutton $w.b.st.bStk $BB -text {^} -menu $w.b.st.bStk.menu
eval button $w.b.st.bFwd $BB -relief raised -text {->} -command {{Stk up}}
bind $w.b.st.bStk {menuStk L $curW %X %Y}
bind $w.b.st.bStk {menuStk L $curW %X %Y}
bind $w.b.st.bStk {menuStk H $curW %X %Y}
bind $w.b.st.bStk {menuStk H $curW %X %Y}
pack $w.b.st.bBck $w.b.st.bStk $w.b.st.bFwd -in $w.b.st -side left
pack $w.b.st -in $w.b -side left
menuStk 1 $curW 0 0
BindHelp $w.b.st.bBck {Previous URL}
BindHelp $w.b.st.bStk {URL stack}
BindHelp $w.b.st.bFwd {Next URL}
set namN($w.b.st.bBck) {Previous URL}
set namN($w.b.st.bStk) {URL stack}
set namN($w.b.st.bFwd) {Next URL}
}
if ![winfo exists $w.b.re] {
eval frame $w.b.re -bd 1 -relief $R
eval button $w.b.re.bWheel $BB -relief raised -textvariable waitchr -command Stop
eval button $w.b.re.bAgain $BB -text GET -command {{Load $curW}}
pack $w.b.re.bAgain $w.b.re.bWheel -in $w.b.re -side left
pack $w.b.re -in $w.b -side left
BindHelp $w.b.re.bWheel {Stop}
BindHelp $w.b.re.bAgain {Reload}
set namN($w.b.re.bAgain) {Reload document}
}
Verbose $w.b -padx 0 -pady 0 -highlightthickness 0
set namN($w.b.fVbs.m) {Verbose level}
set namN($w.b.fVbs.v) {Verbose level}
#
frame $w.b.bd -bd $F -relief $R
label $w.b.bd.l -text B
entry $w.b.bd.v -textvariable B -highlightthickness 0 -width 0 -bd 0
pack $w.b.bd.l $w.b.bd.v -in $w.b.bd -side left
pack $w.b.bd -in $w.b -side right
set namN($w.b.bd.l) {Border width}
set namN($w.b.bd.v) {Border width}
#
label $w.b.target -text $t -bd $B -relief $R
pack $w.b.target $w.b -side left -expand 1
set namN($w.b.target) {target}
#
eval button $w.b.quit -text Quit -bd $F -command exit -highlightthickness 0 -fg red3
pack $w.b.quit -in $w.b -side right
set namN($w.b.bquit) {Exit}
#
set DIR [pwd]/
#
entry $w.i.t -textvariable title -bd 0 -font F4vsb \
-bd 0 -relief $R -width 0 -highlightthickness 0 -fg yellow -bg navy
set namN($w.i.t) {document's title}
#
entry $w.i.u -textvariable URLt($T) -bd 2 -relief $R -fg yellow -bg navy -highlightthickness 0
bind $w.i.u "LoadFile {$w} {} \$URLt($T) GET"
set namN($w.i.u) {document's URL}
#
entry $w.i.e -textvariable errmsg -bd 0 -bg black -fg orange
set namN($w.i.e) {error message}
#
entry $w.i.l -textvariable curL -bd 0 -bg black -fg green
set namN($w.i.l) {hyperlink URL}
#
entry $w.i.n -textvariable curN -bd 0 -bg black -fg cyan
bind $w.i.n "EnterW $w.i.n %X %Y"
set namN($w.i.n) {widget name}
#
set C(bg) [lindex [$T config -background] 4]
set C(fg) [lindex [$T config -foreground] 4]
#
bind $T "ResizeText $T"
set litB B
set Tfont [$T config -font]
if {$V>1} {puts "$id: Tfont=\"$Tfont\""}
set Bfont "$Tfont$litB"
if {$V>1} {puts "$id: Bfont=\"$Bfont\""}
set Nfont $Tfont
if {$V>1} {puts "$id: Nfont=\"$Nfont\""}
#
tagDefs $T
Packs $w
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if {$V>2} {
foreach n [lsort [array names bd]] {puts "$me: bd($n) = {$bd($n)}"}
foreach n [lsort [array names opt]] {puts "$me: opt($n) = {$opt($n)}"}
}
TargetWin {} _top
update idletasks
HeaderWin $opt(Header)
SourceWin $opt(Source)
DebugWin $opt(Debug)
OptionWin $opt(Option)
update idletasks
FindInit .d.t
bind .d.t "FindPat .d.t"
bind .d.t "NextPat .d.t"
if {$V>1} {puts "$me: Built other windows."}
update idletasks
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Run thru the command-line args. We recognize the forms:
# -opt(foo)=bar
# -opt(foo)
# and set the appropriate option. A missing value is taken to be 1. All other
# command-line args are added to the URLs list. If there were any such URLs
# on the command line, we will start off by loading the first one.
set urls 0; # Number of URLs on the command line.
foreach a $argv {
if [regexp {^[-+]opt\(([A-Za-z0-9_]+)\)=(.*)$} $a {} n v] {
set opt($n) $v
} elseif [regexp {^[-+]opt\(([A-Za-z0-9_]+)\)$} $a {} n] {
set opt($n) 1
} else {
set URLs "$a $URLs"
incr urls
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Finally, get the data and HTMLize it.
if {$urls > 0} {
set f [lindex $URLs 0]
if {$V>1} {puts "$me: Load first file \"$f\""}
LoadFile {} {} $f GET
}
set Hist $URLs
if {$V>1} {foreach o [array names opt] {puts "$me: opt($o)=\"$opt($o)\""}}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
set TxtLen(.d.t) 0
#trace variable TxtLen w pvar
bind all "EnterW %W %X %Y"
#bind all "LeaveW %W %X %Y"
if {$opt(TTL)} {titleon {}}