From: gnat@kauri.vuw.ac.nz (Nathan Torkington)
Subject: Gopher Client in TCL
Organization: Contract to CSC, Victoria Uni, Wellington, New Zealand
Date: Sat, 17 Oct 1992 01:02:34 GMT
Distribution: comp

I have written a client for gopher, in TCL.  I don't want it to be
added to the TCL archive because it isn't pretty code yet.  However,
it does show an easy to way to implement other modes.  I haven't
implemented a "binary file" mode, but it oughtn't to be difficult.

Don't panic about the local-variables hack at the end of the file
(which should be called gopher.t, incidentally) - it just sets the
mode and the tabs.

As usual, no distribution for bucks.  If you improve it, tell me.
No redistribution without my name on.

--begin
#!wish -f
# gopher client for tk/tcl
# Nathan Torkington
########################################
# to use this, start up wish, then
#				source gopher.t
# and select "Start" to begin your
# gopher.
########################################
# todo (in no particular order)
#
# # add mac-style delete to entry box in
#   GopherGet7
# # handle bad connections tidily
# # ignore Gopher+ style responses
# # handle sound files (test for
#   /dev/audio, I guess)
# # handle binary files (whatever they
#   may be
# # bold-face words that were searched
#   for (hack GopherGet1 or just copy
#   and modify it)
# # CSO name server
# # fix fulltext so that empty selector
#   string doesn't cause it to die
# # bookmarks
# # telnet message strings not wrapping
# # rlogin instead of telnet?
#DONE meaningful document type
#DONE scrollbars on menu
# # integrate stack, options and guts
########################################

set SupportedOptions "0 1 7 8"

########################################
# setup
########################################
# initialise callback stuff and
# global variables
########################################
proc setup {} {
	   global GopherGet GopherUniqID GopherMaxOpts GopherStackHeight
	   global SupportedOptions GopherMeaningfulName

	   set MeaningfulName {"Text" "Menu" "Search" "Telnet"}

	   # initialise callback style routines
	   set j 0
	   foreach i $SupportedOptions {
		   set GopherGet($i) "GopherGet$i"
		   set GopherMeaningfulName($i) [lindex $MeaningfulName $j]
		   set GopherUniqID($i) 0
		   incr j
	   }

	   # setup global variables
	   set GopherMaxOpts 0
	   set GopherStackHeight 0

	   # create the actual gopher
	   catch "destroy .gopher"
	   catch "destroy .sb"

	   listbox .gopher \
		   -relief raised \
		   -geometry 80x25 \
		   -yscrollcommand ".sb set "
	   scrollbar .sb \
		   -command ".gopher yview "
	   pack append . .sb {left filly}
	   pack append . .gopher top

	   # restrict bindings to only one thing selected at a time
	   tk_listboxSingleSelect .gopher

	   # bind the "go" command
	   bind .gopher <Double-Button-1> {GopherExec [expr "1 + [.gopher nearest %y]"]}

	   # allow resize events
	   wm minsize . 5 5
	   bind . <ResizeRequest> {. configure -height %h -width %w}
}


########################################
# proc GopherGet1
########################################
# handle a type 1 option (a menu)
########################################
proc GopherGet1 {host port selector title} {
	   global GopherOpts GopherMaxOpts GopherGuts GopherStack GopherStackHeight
	   global GopherMeaningfulName SupportedOptions

	   # open the connection to the remote machine
	   .label configure -text "Opening connection ..."
	   set fid [open "|telnet $host $port" w+]
	   # skip the "Opening ..." message from the telnet program
  gets $fid crap ; gets $fid crap ; gets $fid crap
	   # send our selector string
	   puts $fid "$selector\n"
	   # and check for an error
	   if {[eof $fid]} {
		   catch "close $fid"
		   .label configure -text "Couldn't open a connection to $host $port"
		   return
 }
	   flush $fid

	   # now read the response
	   .label configure -text "Reading response ..."

	   # add onto the stack
	   incr GopherStackHeight
	   set GopherStack($GopherStackHeight,host) "$host"
	   set GopherStack($GopherStackHeight,port) "$port"
	   set GopherStack($GopherStackHeight,selector) "$selector"
	   set GopherStack($GopherStackHeight,title) "$title"

	   # prepare to erase over the old menu
	   set oldGopherMaxOpts $GopherMaxOpts
  set GopherMaxOpts 0
  set heed 1
	   while {![eof $fid]} {
	     set type [read $fid 1]
		   if {"." == "$type" && $GopherMaxOpts == 0} {
			   # allow for the case of an empty directory
			   set GopherMaxOpts $oldGopherMaxOpts
			   set GopherStackHeight [expr "$GopherStackHeight - 1"]
			   .label configure -text "That was an empty directory"
			   catch "close $fid"
			   return
		   }
		   if {"." == "$type"} {
			   set heed 0
			   while {![eof $fid]} {
				   gets $fid line
			   }
		   }
	     if {$heed} {
			   if {-1 == [lsearch $SupportedOptions $type]} {
				   gets $fid line
			   } else {
				   incr GopherMaxOpts
				   set opttitle ""
			   set ch [read $fid 1]
			   while {$ch != "\t"} {
					   set opttitle "${opttitle}${ch}"
					   set ch [read $fid 1]
			   }
			   set pointer ""
				   set ch [read $fid 1]
				   while {$ch != "\t"} {
					   set pointer "${pointer}${ch}"
					   set ch [read $fid 1]
				   }
				   gets $fid line
				   scan $line "%s %s" host port
		   set GopherOpts($GopherMaxOpts) [format "<%s> %s" $GopherMeaningfulName($type) $opttitle]
				   set GopherGuts($GopherMaxOpts,host) "$host"
				   set GopherGuts($GopherMaxOpts,port) "$port"
				   set GopherGuts($GopherMaxOpts,selector) "$pointer"
				   set GopherGuts($GopherMaxOpts,type) "$type"
				   set GopherGuts($GopherMaxOpts,title) "$opttitle"
			   }
		   }
	   }
	   # close the connection
	   catch "close $fid"
	   .label configure -text "Displaying"
	   GopherDisplay $title
}
# endofproc GopherGet1


########################################
# proc GopherGet7
########################################
# Handle a type 7 option (database
# search).
########################################
proc GopherGet7 {host port selector title} {
	   global GopherOpts GopherMaxOpts GopherGuts GopherStack GopherStackHeight GopherUniqID

	   # open windows
	   #   .$id is the new toplevel that everything goes in
	   #   .$id.label is the "Search for:" prompt
	   #   .$id.entry is the entry box
	   #   .$id.go is the go button which performs the search
	   .label configure -text "Opening windows"
	   incr GopherUniqID(7)
	   set id ".7$GopherUniqID(7)"
	   toplevel $id
	   entry $id.entry \
		   -width 20
	   label $id.label \
		   -text "Search for :"
	   set cmd "GopherGet1 $host $port \"$selector\t\[$id.entry get\]\" \"\[$id.entry get\]\""
	   button $id.go \
		   -text "Go" \
		   -command $cmd
	   button $id.quit \
		   -text "Quit" \
		   -command "destroy $id"
	   pack append $id $id.go left
	   pack append $id $id.label left
	   pack append $id $id.entry left
	   pack append $id $id.quit left
	   .label configure -text "Done"
}
# endofproc GopherGet7


########################################
# proc GopherGet0
########################################
# handle a type 0 option (text file)
########################################
proc GopherGet0 {host port selector title} {
	   global GopherOpts GopherMaxOpts GopherGuts GopherUniqID

	   .label configure -text "Opening connection ..."
	   set fid [open "|telnet $host $port" w+]
  gets $fid crap ; gets $fid crap ; gets $fid crap
	   puts $fid "$selector\n"
	   if {[eof $fid]} {
		   catch "close $fid"
		   .label configure -text "Couldn't open a connection to $host $port"
		   return
 }
	   flush $fid

	   .label configure -text "Opening windows"
	   incr GopherUniqID(0)
  set id "0$GopherUniqID(0)"
	   toplevel .$id
	   text .$id.text \
		   -width 80 \
		   -height 25 \
		   -relief raised \
		   -yscrollcommand ".$id.sb set"
  wm title .$id "$title"
	   foreach i [bind Text] {
		   bind .$id.text $i { }
	   }
	   scrollbar .$id.sb \
		   -command ".$id.text yview "
	   button .$id.quit \
		   -text "Quit" \
		   -command "catch \"destroy .$id\""
	   pack append .$id .$id.quit top
	   pack append .$id .$id.sb left
	   pack append .$id .$id.text right
	   set heed 1

	   .label configure -text "Reading response"
	   while {![eof $fid]} {
		   gets $fid line
		   if {"." == "$line"} {set heed 0}
		   if {$heed} {
			   .$id.text insert end $line
			   .$id.text insert end "\n"
		   }
  }
	   .label configure -text "Your wish is my command"
	   catch "close $fid"
}
# endofproc GopherGet0


########################################
# proc GopherGet8
########################################
# handle a type 8 option (telnet)
########################################
proc GopherGet8 {host port selector title} {
	   global GopherUniqID

	   .label configure -text "Opening windows"
	   incr GopherUniqID(8)
	   set id ".8$GopherUniqID(8)"

	   if {$port == 0} {
		   set port 23
	   }

	   toplevel $id
	   button $id.go \
		   -text "Go for it" \
		   -command "xterm -title \"$title\" -e telnet $host $port & ; destroy $id"
	   button $id.quit \
		   -text "Maybe not" \
		   -command "destroy $id"
	   text $id.text \
		   -width 40 \
		   -height 5 \
		   -relief raised \
		   -wrap word
	   wm title $id "$title"
	   foreach i [bind Text] {
		   bind $id $i { }
	   }
	   $id.text insert end "You are about to leave the gopher program and connect to a remote computer.\n"
	   if {$selector} {
	     $id.text insert end "When prompted for a login name, enter\n\t$selector"
	   }
	   pack append $id $id.text bottom
	   pack append $id $id.quit right
	   pack append $id $id.go left
	   .label configure -text "Your wish is my command"
}



# # # # # # # # # # # # # # # # # # # # 
# GopherDisplay
# # # # # # # # # # # # # # # # # # # # 
# Display current options
# # # # # # # # # # # # # # # # # # # # 
proc GopherDisplay {title} {
	   global GopherMaxOpts GopherOpts

	   # change the window title
	   wm title . $title
	   # clear the current listing (if any)
	   .gopher delete 0 end

	   # and fill it with the new list
	   for {set i 1} {$i <= $GopherMaxOpts} {incr i} {
		   .gopher insert end "$GopherOpts($i)"
  }
	   .label configure -text "Your wish is my command"
}
# endofproc GopherDisplay


# # # # # # # # # # # # # # # # # # # # 
# GopherExec
# # # # # # # # # # # # # # # # # # # # 
# Execute option which from options
# list.
# # # # # # # # # # # # # # # # # # # # 
proc GopherExec {which} {
	   global GopherMaxOpts GopherGuts GopherGet

	   if {$which == 0} {return}

	   eval "$GopherGet($GopherGuts($which,type)) $GopherGuts($which,host) $GopherGuts($which,port) \"$GopherGuts($which,selector)\" \"$GopherGuts($which,title)\""
}
#endofproc GopherExec


# # # # # # # # # # # # # # # # # # # # 
# GopherUp
# # # # # # # # # # # # # # # # # # # # 
# Go up a level on the stack.
# # # # # # # # # # # # # # # # # # # # 
proc GopherUp {} {
	   global GopherStack GopherStackHeight
	   if {$GopherStackHeight > 1} {
		   unset GopherStack($GopherStackHeight,host)
		   unset GopherStack($GopherStackHeight,port)
		   unset GopherStack($GopherStackHeight,selector)
		   set GopherStackHeight [expr "$GopherStackHeight - 2"]
		   set i [expr "$GopherStackHeight +1"]
		   GopherGet1 $GopherStack($i,host) $GopherStack($i,port) "$GopherStack($i,selector)" "$GopherStack($i,title)"
  }
}
# endofproc GopherUp

# # # # # # # # # # # # # # # # # # # # 
# restart
# # # # # # # # # # # # # # # # # # # # 
# restart the gopher (destroy all
# open windows and begin again)
# # # # # # # # # # # # # # # # # # # # 
proc restart {} {
	   global GopherUniqID SupportedOptions

	   foreach j $SupportedOptions {
		   for {set i 1} {$i <= $GopherUniqID($j)} {incr i} {
			   catch "destroy .$j$i"
		   }
	   set GopherUniqID($j) 0
	   }
}


# # # # # # # # # # # # # # # # # # # # 
# go
# # # # # # # # # # # # # # # # # # # # 
# initialise all the buttons and
# pack everything onto the screen
# # # # # # # # # # # # # # # # # # # # 

proc go {} {
	   catch {destroy .quit}
	   button .quit -text "Quit" -command "destroy ."
  catch {destroy .restart}
	   button .restart -text "Restart"	-command "restart ; source gopher.t"
	   catch {destroy .begin}
	   button .begin -text "Start" -command {GopherGet1 gopher.micro.umn.edu 70 {} "Gopher"}
	   catch {destroy .up}
	   button .up -text "Up" -command "GopherUp"
	   catch {destroy .label}
	   label .label -text "Your wish is my command"

	   pack append . .quit left
	   pack append . .restart left
	   pack append . .begin left
	   pack append . .up left
	   pack append . .label left
}


setup
go

# Emacs frobs start here.
# Local variables:
# mode: text
# tab-width :2
# end:

--end

Cheers;

Nat
(gnat@kauri.vuw.ac.nz -- Nathan Torkington -- is the electronic text and
 MS-DOS archivist for the Victoria University of Wellington, New Zealand)
Newsgroups: comp.lang.tcl