#!/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 ... </PLAINTEXT> section. #set in(PRE) 0; # Whether we are in a <PRE> ... </PRE> section. #set in(SCRIPT) 0; # Whether we are in a <SCRIPT> ... </SCRIPT> section. #set in(TABLE) 0; # Whether we are in a <TABLE> ... </TABLE> 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 <Button-1> "LinkButton1 $w $l %X %Y" bind $f <Shift-1> "LinkShiftB1 $w $l %X %Y" bind $f <Button-3> "LinkButton3 $w $l %X %Y" bind $f <Enter> "LinkEnter $f $l %X %Y %W" bind $f <Leave> "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 <Enter> "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 <Button-1> {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 <Button-1> "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 <Button-1> {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 <Button-1> {menuHst L $curW %X %Y} bind $w.b.bHst <Button-2> {menuHst L $curW %X %Y} bind $w.b.bHst <Button-3> {menuHst H $curW %X %Y} bind $w.b.bHst <Shift-1> {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 <Button-1> {menuStk L $curW %X %Y} bind $w.b.st.bStk <Button-2> {menuStk L $curW %X %Y} bind $w.b.st.bStk <Button-3> {menuStk H $curW %X %Y} bind $w.b.st.bStk <Shift-1> {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 <Return> "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 <Enter> "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 <Configure> "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 <Alt-f> "FindPat .d.t" bind .d.t <Alt-g> "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 <Enter> "EnterW %W %X %Y" #bind all <Leave> "LeaveW %W %X %Y" if {$opt(TTL)} {titleon {}}