A bird? A plane? TkMan! (TkPerson?)
Tom Phelps
hypertext links to other man pages (click on a word in the text which
corresponds to a man page, and you jump there), and better navigation
within long man pages with searches (both incremental and regular
expression) and jumps to section headers. TkMan also offers some
convenience features, like a user-configurable list of commonly-used man
pages, a one-click printout, and integration of `whatis' and `apropos'.
A companion C program translates the nroff version of a man page into Tk
text widget input.
You'll need to edit the `Makefile' before `make'ing and running `tkman'.
TkMan adapts to your use of it, and you should kill it with the `Quit'
button if you wish to save these adaptations.
Tom Phelps (phe...@cs.Berkeley.EDU)
--------------------------------------------------
#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# tkman.tcl
# utils.tcl
# bs2tk.c
# Makefile
# This archive created: Thu Apr 1 17:27:22 1993
# By: Tom Phelps (phe...@cs.Berkeley.EDU)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'tkman.tcl'" '(22312 characters)'
if test -f 'tkman.tcl'
then
echo shar: over-writing existing file "'tkman.tcl'"
fi
sed 's/^X//' << \SHAR_EOF > 'tkman.tcl'
X# $Header: /home/yew/yew5/users/phelps/spine/tkman/RCS/tkman.tcl,v 1.8 1993/04/02 01:26:48 phelps Exp phelps $
X
X#
X# Bird? Plane? TkMan! (TkPerson?)
X#
X# by Tom Phelps (phe...@cs.Berkeley.EDU)
X#
X#
X# 24-Mar-93 hard stuff working
X# 25-Mar-93 easy stuff finished up, including documentation
X# 29-Mar-93 wrote Makefile and otherwise prepared for distribution
X# 31-Mar-93 changed incremental searching
X#
X
Xset boilerplate {\
XA bird? A plane? TkMan! (TkPerson?)
X
Xbased on Tcl 6.7/Tk 3.2
X
XCopyright (C) 1993 by T.A. Phelps (phe...@cs.Berkeley.EDU)
XUniversity of California, Berkeley
XDepartment of Electrical Engineering and Computer Science
XComputer Science Division
X
X
XPERMISSION IS GRANTED TO DISTRIBUTE THIS SOFTWARE FREELY, BUT ONE MAY NOT \
XCHARGE FOR IT OR INCLUDE IT AS PART OF SOFTWARE WHICH IS SOLD. \
XPlease send me bug reports and suggestions for new features!
X
X
X
X============
XIntroduction
X------------
X
XI wanted my man page reader to have hypertext. Along the way of writing
Xone, I added jumps to section titles, a configurable short cut list of
Xcommonly-referenced man pages, a history list, and two kinds of searching.
X
XSince man page formatting follows conventions but not rigid standards, not
Xall man pages can be parsed fully. However, most yield their section
Xtitles and SEE ALSO's and their emphasized words. TkMan also tries to
Xfilter out the unsightly page footers and headers put in by `nroff', but
Xnonstandard formatting can slip by.
X
XFirst I'll describe how to use TkMan, although I hope that most features
Xare intuitive. At the end are my address and UC's disclaimer.
X
X(You may ask why I didn't write a man page for TkMan. The reason is that
X`[nt]roff' style formatting is archaic and unbearable. I think we should
Xwrite in them in RTF, which is more widely supported by editors.)
X
X
X
X===========
XUsing TkMan
X-----------
X
X= Locating a man page =
X
XThere are several ways to identify the manual page you desire. You can
Xtype its name in the entry box at the top of the screen and press return or
Xclick man. The name may be just the name of the command or include a `.n'
Xor `(n)' at the end to indicate in which section to look in. You can click
Xone of the buttons labeled `1'--`8', `o', `l', or `n' to bring up that
Xvolume of man page entries (the name of the volume appears above) and then
Xclick on the name within the listing. Typing a letter (or letters) jumps
Xto the line starting with that letter.
X
XOnce you have a man page on the screen, you can click on the name of a man
Xpage within the text to jump there. The last few man pages you looked at
Xcan be accessed directly through the `History' pulldown menu. `Shortcuts'
Xlists your personal favorites and is used just like `History', with the
Xadditional options of adding (by clicking `+') the current man page or
Xremoving (`-') it from the list.
X
X`apropos' information is available by typing the name and clicking `apropos' or
Xhitting meta-return (for meta information, of course). Hypertext is active
Xwithin this listing also.
X
X
X= Working within a man page =
X
XThe `whatis' information for a man page, if any, appears at the top of the screen.
X
XTo the extent it follows convention, the man page is parsed to yield its
Xsection titles (which are directly available from the `Sections' pulldown)
Xand references to other man pages from its `SEE ALSO' section (`Links'
Xpulldown). It may be handy to tear off the `Sections' and `Links' menus.
X
XYou can move about the man page by using the scrollbar or typing space or
XC-v to page down or delete or M-v to scroll up. C-< goes to the head and
XC-> to the tail of the man page. Typing a few letters attempts to find a
Xline with that string, starting its search with the topmost line currently
Xvisible. C-s finds the next match of the string typed so far. You must
Xpause briefly between different search strings so that the past one "times
Xout". This type of search can be use to quickly locate a particular
Xcommand-line option or a particular command in a group (as in `csh'). The
Xbottom of the screen interfaces to a TCL/Tk demo's (modified) mkTextSearch
Xproc. Type in a regular expression to search for at the bottom, and hit
Xreturn or click `Search' to begin a search. Hit `Next' or keep hitting
Xreturn to search for the next occurance.
X
XFinally, you can print the current man page by clicking `Print'.
X
X
X= Other commands =
X
XYou can return to this information by clicking `Help'.
X
XQuit exits TkMan, of course, after saving some status information (see below).
X
X
X= Modifying TkMan =
X
XThere are three levels of configuration to TkMan. (1) Transparent. Simply
Xuse TkMan and it will remember your window size and placement and short
Xcuts (if you quit out of TkMan via the `Quit' button). (2) Configuration
Xfile. Other information, like the string used to print the man page, the
Xfonts used, or the incremental search time out time limit, can be changed
Xby editing one's own ~/.tkman. Thus, a single copy of TkMan (`tkman') can
Xbe shared, but each user can have his own customized setup. (3) Source
Xcode. Of course, but if you make generally useful changes or have
Xsuggestions for some, please report them back to me.
X
X
X
X=========
XAddresses
X---------
X
XTom Phelps
XUniversity of California, Berkeley
XComputer Science Division
X571 Evans Hall
XBerkeley, CA 94720
XUSA
X
X(510) 642-8155
Xph...@cs.Berkeley.EDU
X
X
XTo do list:
X
Xsave yview with shortcuts?
Xwait cursor, maybe
XTkMan takes about 10 seconds to come up on my SPARCstation 1+--
X can I speed this up? how about a TCL profiler? compiler?
X most of time consumed in reading directories, though
Xlink up with Kennard White's texinfo reader
X
XPlease include this line when reporting bugs or requesting new features:
XRCS: $Header: /home/yew/yew5/users/phelps/spine/tkman/RCS/tkman.tcl,v 1.8 1993/04/02 01:26:48 phelps Exp phelps $
X
X
X==========
XDisclaimer
X----------
X
XIN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY \
XFOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES \
XARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF \
XTHE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF \
XSUCH DAMAGE.
X
XTHE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, \
XINCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF \
XMERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE \
XPROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE UNIVERSITY OF \
XCALIFORNIA HAS NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, \
XENHANCEMENTS, OR MODIFICATIONS.
X}
X
X
X#--------------------------------------------------
X#
X# set defaults for shared global variables
X#
X#--------------------------------------------------
X
X# # # # # # # # # # # # # # # # # # # # # # # # # #
X# DON'T EDIT THE DEFAULTS HERE--DO IT IN ~/.tkman #
X# # # # # # # # # # # # # # # # # # # # # # # # # #
X
X# man(), maninfo()
Xset maninfo(manList) {1 2 3 4 5 6 7 8 l o n}
Xset maninfo(manTitleList) {
X "User Commands" "System Calls" "Subroutines" "Devices" "File Formats"
X Games "Miscellaneous" "System Administration" "Local" "Old" "New"
X}
Xset maninfo(version) 1.0
X# make history a man?
Xset maninfo(history) ""
Xset maninfo(man) ""
Xset maninfo(manfull) ""
Xset maninfo(catfull) ""
Xset maninfo(name) ""
Xset maninfo(num) ""
Xset maninfo(search,string) ""
Xset maninfo(lastkeys) ""
Xset maninfo(oldkeytime) 0
Xset maninfo(mode) help
X
Xset man(geom) 540x800+150+10
Xset man(print) "psroff -man \$maninfo(manfull)"
X#set man(show,font) -adobe-courier-medium-r-normal--12-*
Xset man(show,pro) -adobe-times-medium-r-normal--14-*
Xset man(show,mono) "-adobe-courier-medium-r-normal--12-*"
Xset man(show,font) $man(show,pro)
Xset man(show,bold) -adobe-times-bold-r-normal--12-*
Xset man(show,bigbold) "-adobe-new century schoolbook-bold-r-normal--14-*"
Xset man(show,italic) -adobe-times-medium-i-normal--14-*
Xset man(maxhistory) 15
Xset man(shortcuts) {tcl.1}
X#set man(searchdelay) 1000
X
Xif [file exists ~/.tkman] {source ~/.tkman}
Xif {![info exists maninfo(debug)]} {set maninfo(debug) 0}
Xif {$maninfo(debug)} {set maninfo(manList) {1 2}}
X
Xif {![info exists man(lib)]} {set man(lib) [pwd]}
Xsource $man(lib)/utils.tcl
X
X
X#--------------------------------------------------
X#
X# tkMan -- make the gui
X#
X#--------------------------------------------------
X
Xproc TkMan {} {
X global man maninfo env
X
X # leave open possibility of embedding in another application
X toplevel .man
X set w .man
X wm title .man TkMan
X wm geometry $w $man(geom)
X wm minsize $w 200 500
X
X ### information bar
X label $w.info -text "TkMan v$maninfo(version) by Tom Phelps (phe...@cs.Berkeley.EDU)" -anchor w
X
X ### man or section or texinfo
X frame $w.kind
X button $w.man -text "man" -command "manShowMan $w \[$w.mantypein get\]"
X button $w.apropos -text "apropos" -command "manApropos $w \[$w.mantypein get\]"
X entry $w.mantypein -relief sunken
X emacsbind $w.mantypein
X bind $w.mantypein <KeyPress-Return> "$w.man invoke"
X # ha! meta information
X bind $w.mantypein <Mod1-KeyPress-Return> "$w.apropos invoke"
X set cnt 0
X foreach i $maninfo(manList) {
X button $w.$i -text $i -padx 4 -command "manShowSection $w $i"
X bind $w.$i <Enter> "+manMessage $w \"[lindex $maninfo(manTitleList) $cnt]\""
X incr cnt
X }
X # link up with Kennard White's texinfo reader here
X# button $w.texinfo -text "texinfo"
X pack append $w.kind $w.man {left padx 8} $w.apropos {left padx 8} \
X $w.mantypein {left expand padx 30 frame w}
X foreach i $maninfo(manList) {pack append $w.kind $w.$i left}
X frame $w.pad
X pack append $w.kind $w.pad {left padx 8}
X# pack append $w.kind $w.texinfo {left padx 30}
X
X
X ### navigation
X frame $w.nav
X menubutton $w.sections -text "Sections" -relief raised -menu $w.sections.m
X menu $w.sections.m
X menubutton $w.links -text "Links" -relief raised -menu $w.links.m
X menu $w.links.m
X menubutton $w.shortcuts -text "Shortcuts" -relief raised -menu $w.shortcuts.m
X menu $w.shortcuts.m
X foreach i $man(shortcuts) {
X $w.shortcuts.m add command -label [file rootname $i] -command "manShowMan $w $i"
X }
X button $w.add -text "+" -padx 4 -command "
X if \{\$maninfo(man)!=\"\" && \[lsearch \$man(shortcuts) \$maninfo(man)\]==-1\} \{
X set man(shortcuts) \[setappend \$man(shortcuts) \$maninfo(man)\]
X $w.shortcuts.m add command -label \$maninfo(name) -command \"manShowMan $w \$maninfo(man)\"
X \}
X "
X button $w.sub -text "-" -padx 4 -command "
X set man(shortcuts) \[lfilter \$maninfo(man) \$man(shortcuts)\]
X catch \"$w.shortcuts.m delete \$maninfo(name)\"
X "
X menubutton $w.history -text "History" -relief raised -menu $w.history.m
X menu $w.history.m
X button $w.help -text "Help" -command \
X "manHelp $w; manKeyNav $w 0 \"Using TkMan\" 0; set maninfo(lastkeys) \"\""
X pack append $w.nav $w.sections left \
X $w.links {left expand padx 30} \
X $w.shortcuts left $w.add left $w.sub left \
X $w.history {left expand padx 30} \
X $w.help {left padx 15}
X
X frame $w.sep -height 4 -width 1 -border 1 -relief sunken
X
X ### view box
X frame $w.view
X text $w.show -font $man(show,font) -foreground black -relief sunken \
X -yscrollcommand "$w.v set" -exportselection yes -wrap word
X scrollbar $w.v -orient vertical -command "$w.show yview"
X $w.show tag configure title -font $man(show,bold)
X $w.show tag configure high -font $man(show,italic)
X $w.show tag configure big -font $man(show,bigbold)
X bind $w.show <Enter> "focus $w.show"
X bind $w.show <Leave> "focus $w"
X # bind letters to jump to that part of list
X bind $w.show <Any-KeyPress> "manKeyNav $w %s %K %t"
X focus $w.show
X pack append $w.view $w.v {right filly} $w.show {right expand fill}
X
X
X ### search (snagged from FileSelectionBox--wow, code reuse!)
X frame $w.search
X button $w.search.s -text "Search" -command "
X $w.search.cnt configure -text \[manTextSearch $w.show \
X \[set maninfo(search,string) \[$w.search.t get\]\]\]
X set maninfo(search) 1.0
X $w.search.n invoke
X "
X button $w.search.n -text "Next" -command "
X set maninfo(tmp) \[$w.show tag nextrange search \$maninfo(search)\]
X if {\$maninfo(tmp)==\"\"} {
X beep; set maninfo(search) 1.0
X } else {
X $w.show yview -pickplace \[lindex \$maninfo(tmp) 0\]
X update
X set maninfo(search) \[expr \[lindex \[$w.v get\] 3\]+1\].0
X }
X "
X label $w.search.cnt
X entry $w.search.t -relief sunken
X emacsbind $w.search.t
X bind $w.search.t <Enter> "focus $w.search.t"
X bind $w.search.t <Leave> "focus $w.show"
X bind $w.search.t <KeyPress-Return> "
X if {\[$w.search.t get\]!=\$maninfo(search,string)} {
X $w.search.s invoke
X } else {$w.search.n invoke}"
X pack append $w.search $w.search.s left $w.search.n {left padx 6} \
X $w.search.cnt left $w.search.t {left expand fillx padx 20 frame w}
X
X ### font & print
X # mostly mono (Mozart?)
X checkbutton $w.mono -text "Mono" -variable man(show,font) \
X -onvalue $man(show,mono) -offvalue $man(show,pro) \
X -command "$w.show configure -font \$man(show,font)"
X button $w.print -text "Print" -command "eval $man(print)"
X
X ### quit
X button $w.quit -text "Quit" -command "
X set man(geom) \[wm geometry $w\]
X set fid \[open ~/.tkman w\]
X manSaveConfig \$fid
X close \$fid
X destroy $w
X destroy .
X "
X
X pack append $w.search \
X $w.mono {left padx 6 frame e} \
X $w.print {left padx 6} \
X $w.quit {left padx 6}
X
X
X pack append $w \
X $w.info {top fillx pady 8} \
X $w.kind {top fillx pady 8} \
X $w.nav {top fillx pady 8} \
X $w.sep {top pady 12 fillx} \
X $w.view {top expand fill} \
X $w.search {top fillx pady 8}
X
X manHelp $w
X}
X
X
X
Xproc manMessage {w msg} {
X $w.info configure -text $msg
X}
X
X
X
Xproc manInit {} {
X global man maninfo env
X
X set tmp [pwd]
X
X foreach i [split $env(MANPATH) :] {
X foreach j $maninfo(manList) {
X if [file exists $i/man$j] {
X cd $i/man$j
X foreach k [glob -nocomplain *] {
X lappend maninfo($j) [file rootname $k]
X }
X }
X }
X }
X
X foreach j $maninfo(manList) {set maninfo($j) [uniqlist [lsort $maninfo($j)]]}
X
X cd $tmp
X}
X
X
Xproc manShowSection {w n} {
X global man maninfo
X
X set maninfo(mode) section
X $w.search.cnt configure -text ""
X # should have companions to wordstart that are bounded by whitespace, not nonalpha
X bind $w.show <ButtonRelease-1> "manShowMan $w \[$w.show get {@%x,%y wordstart} {@%x,%y wordend}\].$n"
X set maninfo(lastkeys) ""
X
X $w.show configure -state normal
X $w.show delete 0.1 end
X set online 0
X set prev [string range [lindex $maninfo($n) 0] 0 0]
X foreach i $maninfo($n) {
X set f [string range $i 0 0]
X if {$online>50} {
X $w.show insert end "\n"
X set online 0
X } elseif {"$f"!="$prev" && ![string match {[A-Z]} $f]} {
X $w.show insert end "\n\n"
X set prev [string range $i 0 0]
X set online 0
X }
X set x1 [$w.show index end]
X $w.show insert end "$i "
X incr online
X }
X $w.show configure -state disabled
X# focus $w.show
X}
X
X
X
Xproc manShowMan {w fname} {
X# fast enough now, with C helper
X# manMessage $w [time {xmanShowMan $w $name}]
X# xmanShowMan $w $fname
X#\} -- TCL should leave comments alone!
X#proc xmanShowMan {w fname} \{
X global man maninfo env
X
X set maninfo(mode) man
X set maninfo(lastkeys) ""
X set ext ""
X if {![regexp -nocase {([a-z]+)\(([1-8oln])([a-zA-Z]?)\)} $fname all name num ext]} {
X set name [file rootname $fname]
X set tmp [string range [file extension $fname] 1 end]
X set num [string range $tmp 0 0]
X set ext [string range $tmp 1 end]
X }
X set found 0
X
X # read man page WITH FORMATTING
X if {$num!=""} {set nlist $num} {set nlist $maninfo(manList)}
X foreach j $nlist {
X foreach i [split $env(MANPATH) :] {
X if {[set f [glob -nocomplain $i/man$j/$name.$j*]]!=""} {
X set found 1
X break
X }
X }
X if {$found} break
X }
X if {!$found} {return}
X
X ### found it!
X
X # set variables
X set maninfo(manfull) $f
X set maninfo(man) [file tail $f]
X set maninfo(name) [file rootname $maninfo(man)]
X set maninfo(num) [file extension $maninfo(man)]
X set maninfo(catfull) $i/cat$j/$maninfo(man)
X#puts "full = $maninfo(man), name = $maninfo(name), num = $maninfo(num)"
X
X # text box
X# wait cursor here
X # hypertext within man page
X bind $w.show <ButtonRelease-1> "manShowMan $w \[$w.show get {@%x,%y wordstart} {@%x,%y wordend}\]"
X $w.sections.m delete 0 last
X $w.links.m delete 0 last
X set maninfo(links) ""
X if {[file exists $maninfo(catfull)]} {
X exec bs2tk < $maninfo(catfull) > /tmp/tmp.tcl
X } else {
X exec nroff -man $f | bs2tk > /tmp/tmp.tcl
X }
X $w.show configure -state normal
X $w.show delete 0.1 end
X source /tmp/tmp.tcl
X# set fid [open $pipe]
X# while {![eof $fid]} {
X# eval [gets $fid]
X# }
X# close $fid
X
X $w.show configure -state disabled
X# focus $w.show
X
X # typein field
X $w.mantypein delete 0 end
X $w.mantypein insert end $maninfo(man)
X
X # history
X set maninfo(history) [setinsert [lrange $maninfo(history) 0 $man(maxhistory)] 0 $name]
X # should do this as a postcommand, but that's too messy
X $w.history.m delete 0 last
X foreach i $maninfo(history) {
X $w.history.m add command -label [lfirst [split $i .]] -command "manShowMan $w $i"
X }
X
X # hyperlinks
X foreach i $maninfo(links) {
X foreach j [split $i ,] {
X if {$j!=""} {$w.links.m add command -label $j -command "manShowMan $w $j"}
X }
X }
X
X # whatis information
X manMessage $w ""
X set fid [open "|whatis $maninfo(man)"]
X while {![eof $fid]} {
X if {[regexp {- (.*)} "[gets $fid]" all info]} {
X manMessage $w "$info"
X break
X }
X }
X close $fid
X}
X
X
X
Xproc manApropos {w name} {
X global maninfo
X
X set maninfo(mode) apropos
X if {$name==""} {set name $maninfo(man)}
X if {[catch {set fid [open "|apropos $name"]}]==1} {beep; return}
X $w.show configure -state normal
X $w.show delete 0.1 end
X while {![eof $fid]} {
X $w.show insert end "[gets $fid]\n"
X }
X close $fid
X $w.show configure -state disabled
X bind $w.show <ButtonRelease-1> "manShowMan $w \[$w.show get {@%x,%y wordstart} {@%x,%y wordend}\]"
X# focus $w.show
X}
X
X
X
Xproc manTextSearch {w string} {
X
X if {$string==""} return
X set cnt [regexpTextSearch $w $string search]
X
X set bg [lindex [$w configure -background] 4]
X set fg [lindex [$w configure -foreground] 4]
X
X $w tag configure search -background $fg -foreground $bg
X
X return $cnt
X}
X
X
X
Xproc manHelp {w} {
X global boilerplate maninfo
X
X set maninfo(mode) help
X set maninfo(lastkeys) ""
X $w.sections.m delete 0 last
X $w.links.m delete 0 last
X $w.show configure -state normal
X $w.show delete 0.1 end
X $w.show insert end $boilerplate
X
X $w.show tag add big 1.0 "1.0 lineend"
X scan [$w.show index end] %d numLines
X for {set i 1} {$i <= $numLines} {incr i} {
X set line [$w.show get $i.0 "$i.0 lineend"]
X if {[string match ==* $line]} {
X set j [expr $i+1]
X set line [$w.show get $j.0 "$j.0 lineend"]
X $w.sections.m add command -label $line -command "$w.show yview $i"
X $w.show tag add title $j.0 "$j.0 lineend"
X } elseif {[regexp -nocase {^= [a-z ]+ =} $line]} {
X $w.show tag add high $i.0 "$i.0 lineend"
X } elseif {[regexp -indices "Please.*!" $line indices]} {
X $w.show tag add high $i.[lfirst $indices] $i.[llast $indices]+1chars
X }
X }
X
X $w.show configure -state disabled
X# bind $w.show <ButtonRelease-1> {}
X bind $w.show <ButtonRelease-1> "manShowMan $w \[$w.show get {@%x,%y wordstart} {@%x,%y wordend}\]"
X}
X
X
X
Xproc manKeyNav {w m k t} {
X global man maninfo
X if {[regexp {(Shift|Control|Meta)_.} $k]} return
X
X if {[winfo class $w.show]=="Text"} {set off 1; scan [$w.show index end] %d numLines} \
X elseif {[winfo class $w.show]=="Listbox"} {set off 0; set numLines [$w.show size]}
X scan [$w.v get] "%d %d %d %d" total window first last
X
X # some translations
X# if {$k=="space" && $maninfo(lastkeys)!=""} {set k " "}
X if {$k=="space" && [expr $t-$maninfo(oldkeytime)]<=$man(searchdelay)
X && [string trim $maninfo(lastkeys)]!=""} {set k " "}
X case $k {
X minus {set k -} plus {set k +}
X percent {set k %} ampersand {set k &}
X }
X
X set mk $m-$k
X case $mk {
X {0-space 4-v} {$w.show yview [min [expr $first+$window] [expr $numLines-$window]]}
X {0-Delete 8-v} {$w.show yview [max [expr $first-$window] 0]}
X {9-less} {$w.show yview 0}
X {9-greater} {$w.show yview [max [expr $numLines-$window] 0]}
X default {
X # incremental search
X if {$mk=="4-s"} {
X incr off
X } else {
X if {[expr $t-$maninfo(oldkeytime)]>$man(searchdelay)} {set maninfo(lastkeys) ""}
X append maninfo(lastkeys) $k
X }
X set maninfo(oldkeytime) $t
X set keys $maninfo(lastkeys)
X set klen [string length $keys]
X set found 0
X update
X for {set i [expr [lindex [$w.v get] 2]+$off]} {$i<=$numLines} {incr i} {
X if {($maninfo(mode)=="section" || $maninfo(mode)=="apropos")} {
X if {"$keys"=="[$w.show get $i.0 $i.$klen]"} {
X set found 1; break
X }} elseif {[string first $keys [$w.show get $i.0 "$i.0 lineend"]]!=-1} {
X set found 1; break
X }
X }
X if {$found} {$w.show yview [expr $i-1]} elseif {$mk=="4-s"} {$w.show yview 0}
X }
X }
X}
X
X
X
X#--------------------------------------------------
X#
X# manSaveConfig -- save all the customized attributes into passed file id
X#
X#--------------------------------------------------
X
Xproc manSaveConfig {fid} {
X global man
X
X# if only persistent stuff in man array,
X# could have general SaveConfig in utils.tcl
X
X puts $fid "\n\n# TkMan\n"
X foreach i [array names man] {
X puts $fid "set man($i) {$man($i)}"
X }
X}
X
X
X### start up
X
XTkMan
Xwm withdraw .
X
Xif {$maninfo(debug)} {
X entry .man.in -relief sunken
X emacsbind .man.in
X bind .man.in <KeyPress-Return> {manMessage .man "[eval [.man.in get]]"}
X pack append .man .man.in {top fillx}
X
X puts stdout "init takes [time manInit]"
X} else {
X
XmanInit
X
X}
SHAR_EOF
if test 22312 -ne "`wc -c 'tkman.tcl'`"
then
echo shar: error transmitting "'tkman.tcl'" '(should have been 22312 characters)'
fi
echo shar: extracting "'utils.tcl'" '(7962 characters)'
if test -f 'utils.tcl'
then
echo shar: over-writing existing file "'utils.tcl'"
fi
sed 's/^X//' << \SHAR_EOF > 'utils.tcl'
X#
X# some functions which should be part of TCl, but aren't
X#
X# Tom Phelps (phe...@cs.Berkeley.EDU)
X#
X
X
X#
X# UNIXish
X#
X
Xproc tr {s c1 c2} {
X foreach i [split $s $c1] {
X append l2 $i $c2
X }
X return [string trimright $l2 $c2]
X}
X
X
X# reverse glob
X# pass expanded filename, list of shortenings
Xproc bolg {f {l ""}} {
X global file
X if {$l==""} {set l $file(globList)}
X
X foreach i $l {
X if [regsub ([glob $i])(.*) $f "$i\\2" short] {return $short}
X }
X return $f
X}
X
X
X# short enought to just inline: if [lsearch $l $e]==-1 {lappend $l $e}
X#proc setinsert {l e} {
X# if {[lsearch $l $e]==-1} {
X# return [lappend $l $e]
X# } else {
X# return $l
X# }
X#}
X
X
Xproc unsplit {l c} {
X foreach i $l {
X append l2 $i $c
X }
X# return [string trimright $l2 $c]
X return [string range $l2 0 [expr [string length $l2]-2]]
X}
X
Xproc bytes2prefix {x} {
X set k 1024
X set mb [expr $k*$k]
X set gb [expr $k*$mb]
X set bp 10
X
X return [
X if {$x<$k} {format " $x bytes"} \
X elseif {$x<[expr $k*$bp]} {format "%0.1f K" [expr ($x+0.0)/$k]} \
X elseif {$x<$mb} {format "[expr $x/$k] K"} \
X elseif {$x<[expr $mb*$bp]} {format "%0.1f MB" [expr ($x+0.0)/$mb]} \
X elseif {$x<$gb} {format "[expr $x/$mb] MB"} \
X elseif {$x<[expr $gb*$bp]} {format "%0.1f GB" [expr ($x+0.0)/$gb]} \
X else {format "[expr $x/$gb] GB"}
X ]
X}
X
Xproc bytes2prefix {x} {
X set pfx {bytes KB MB GB TB QB}
X set bp 20
X set k 1024
X set sz $k
X
X set y BIG
X for {set i 0} {$i<[llength $pfx]} {incr i} {
X if {$x<$sz} {
X set y [format " %0.0f [lindex $pfx $i]" [expr $x/($sz/$k)]]
X break
X } elseif {$x<[expr $sz*$bp]} {
X set y [format " %0.1f [lindex $pfx [expr $i+1]]" [expr ($x+0.0)/$sz]]
X break
X }
X
X set sz [expr $sz*$k]
X }
X
X return $y
X}
X
X
X
X#
X# Lispish
X#
X
X# unfortunately, no way to have more-convenient single quote form
Xproc quote {x} {return $x}
X
Xproc uniqlist {l} {
X set l1 [lsort $l]
X set e ""
X set l2 ""
X foreach i $l1 {
X if {$e!=$i} {
X set e $i
X lappend l2 $e
X }
X }
X return $l2
X}
X
X
Xproc min {args} {
X set x [lindex $args 0]
X foreach i $args {
X if {$i<$x} {set x $i}
X }
X return $x
X}
X
Xproc avg {args} {
X set sum 0.0
X
X if {$args==""} return
X
X foreach i $args {set sum [expr $sum+$i]}
X return [expr ($sum+0.0)/[llength $args]]
X}
X
Xproc max {args} {
X set x [lindex $args 0]
X foreach i $args {
X if {$i>$x} {set x $i}
X }
X return $x
X}
X
Xproc abs {x} {
X if {$x<0} {return [expr 0-$x]} {return $x}
X}
X
X
Xproc lfirst {l} {
X return [lindex $l 0]
X}
X
Xproc lrest {l} {
X return [lrange $l 1 end]
X}
X
Xproc llast {l} {
X set end [llength $l]
X if {!$end} {return ""}
X return [lindex $l [expr $end-1]]
X}
X
Xproc setappend {l e} {
X return "[lfilter $e $l] $e"
X}
X
Xproc setinsert {l i e} {
X return [linsert [lfilter $e $l] $i $e]
X}
X
Xproc lfilter {p l} {
X set l2 ""
X
X foreach i $l {
X if ![string match $p $i] "lappend l2 $i"
X }
X return $l2
X}
X
Xproc lassoc {l k} {
X
X foreach i $l {
X if {[lindex $i 0]==$k} {return [lindex $i 1]}
X }
X}
X
X# like lassoc, but search on second element, returns first
Xproc lbssoc {l k} {
X
X foreach i $l {
X if {[lindex $i 1]==$k} {return [lindex $i 0]}
X }
X}
X
Xproc lreverse {l} {
X set l2 ""
X for {set i [expr [llength $l]-1]} {$i>=0} {incr i -1} {
X lappend l2 [lindex $l $i]
X }
X return $l2
X}
X
X
X#
X# X-ish
X#
X
Xproc geom2posn {g} {
X regexp {(=?[0-9]+x[0-9]+)([-+][0-9]+[-+][0-9]+)} $g both d p
X return $p
X}
X
X
X
X#
X# TCLish
X#
X
X# remove all char c from string s
X
Xproc stringremove {s c} {
X set s2 ""
X set slen [string length $s]
X
X for {set i 0} {$i<$slen} {incr i} {
X set sc [string index $s $i]
X if [string match $c $sc]==0 {append s2 $sc}
X }
X return $s2
X}
X
Xproc tk_listboxNoSelect args {
X foreach w $args {
X bind $w <Button-1> {format x}
X bind $w <B1-Motion> {format x}
X bind $w <Shift-1> {format x}
X bind $w <Shift-B1-Motion> {format x}
X }
X}
X
X# could do with "listbox select&highlight pattern"
X
Xproc listboxshowS {lb s {first 0} {cnstr yes}} {
X set sz [$lb size]
X
X for {set i $first} {$i<$sz} {incr i} {
X if [string match $s [$lb get $i]] {
X listboxshowI $lb $i $cnstr
X return $i
X }
X }
X return -1
X}
X
Xproc listboxshowI {lb high {cnstr yes}} {
X# if {$high>=[$lb size] || $high<0} return
X set high [max 0 [min $high [expr [$lb size]-1]]]
X
X set hb [lindex [split [lindex [$lb configure -geometry] 4] x] 1]
X set hx [max 0 [expr [$lb size]-$hb]]
X if {$cnstr=="yes"} {set hl [expr $high<$hb?0:[min $high $hx]]} {set hl $high}
X $lb select from $high
X $lb yview $hl
X}
X
Xproc listboxreplace {lb index new} {
X $lb delete $index
X $lb insert $index $new
X # don't lose selection
X $lb select from $index
X}
X
X
X# preserves selection, yview
X
Xproc listboxmove {l1 l2} {
X listboxcopy $l1 $l2
X $l1 delete 0 end
X}
X
Xproc listboxcopy {l1 l2} {
X
X $l2 delete 0 end
X listboxappend $l1 $l2
X catch {$l2 select from [$l1 curselection]}
X# use NEW yview to keep same yview position
X# catch {$l2 yview [$l1 yview]}
X}
X
Xproc listboxappend {l1 l2} {
X
X set size [$l1 size]
X
X for {set i 0} {$i<$size} {incr i} {
X $l2 insert end [$l1 get $i]
X }
X}
X
Xproc emacsbind {w} {
X bind $w <KeyPress-Delete> "
X if \[catch {$w delete sel.first sel.last}\] \
X {$w delete \[expr \[$w index insert\]-1\]}
X "
X bind $w <Enter> "focus $w"
X bind $w <Leave> "focus ."
X bind $w <Control-KeyPress-d> "$w delete \[$w index insert\]"
X bind $w <Control-KeyPress-k> "$w delete \[$w index insert\] end"
X bind $w <Control-KeyPress-f> "$w icursor \[expr \[$w index insert\]+1\]"
X bind $w <Control-KeyPress-b> "$w icursor \[expr \[$w index insert\]-1\]"
X bind $w <Control-KeyPress-a> "$w icursor 0"
X bind $w <Control-KeyPress-e> "$w icursor end"
X
X # mac like
X bind $w <Double-Button-1> "$w select from 0; $w select to end"
X}
X
X
X# need a selection of sound, and don't use stdout!
X
Xproc beep {} {
X puts -nonewline stdout "\007"; flush stdout
X}
X
X# numeric sort--should be builtin
X
Xproc lnsort {l} {
X if {$l==""} {return ""}
X
X foreach i $l {
X append l2 [format %015d $i]
X }
X set l2 [lsort $l2]
X foreach $i l2 {
X append l3 [format %d $i]
X }
X
X return $l3
X}
X
X# swiped from mkTextSearch w
X#
X# The utility procedure below searches for all instances of a
X# given string in a text widget and applies a given tag to each
X# instance found.
X# Arguments:
X#
X# w - The window in which to search. Must be a text widget.
X# string - The string to search for. The search is done using
X# exact matching only; no special characters.
X# tag - Tag to apply to each instance of a matching string.
X
Xproc TextSearch {w string tag} {
X set cnt 0
X
X $w tag remove search 0.0 end
X scan [$w index end] %d numLines
X set l [string length $string]
X for {set i 1} {$i <= $numLines} {incr i} {
X if {[string first $string [$w get $i.0 $i.1000]] == -1} {
X continue
X }
X set line [$w get $i.0 $i.1000]
X set offset 0
X while 1 {
X set index [string first $string $line]
X if {$index < 0} {
X break
X }
X incr offset $index
X $w tag add $tag $i.[expr $offset] $i.[expr $offset+$l]
X incr cnt
X incr offset $l
X set line [string range $line $offset 1000]
X }
X }
X return $cnt
X}
X
X
X# modified to handle regexp's and return # of matches -TAP
X
Xproc regexpTextSearch {w string tag} {
X set cnt 0
X
X $w tag remove search 0.0 end
X scan [$w index end] %d numLines
X# set l [string length $string]
X for {set i 1} {$i <= $numLines} {incr i} {
X if {![regexp $string [$w get $i.0 $i.1000]]} continue
X set line [$w get $i.0 $i.1000]
X set offset 0
X while 1 {
X if {![regexp -indices $string $line match]} break
X scan $match "%d %d" index iend
X $w tag add $tag $i.[expr $offset+$index] $i.[incr offset [expr $iend+1]]
X# incr offset [expr $iend+1]
X set line [string range $line $offset 1000]
X incr cnt
X }
X }
X return $cnt
X}
X
SHAR_EOF
if test 7962 -ne "`wc -c 'utils.tcl'`"
then
echo shar: error transmitting "'utils.tcl'" '(should have been 7962 characters)'
fi
echo shar: extracting "'bs2tk.c'" '(2848 characters)'
if test -f 'bs2tk.c'
then
echo shar: over-writing existing file "'bs2tk.c'"
fi
sed 's/^X//' << \SHAR_EOF > 'bs2tk.c'
X#include <stdio.h>
X#include <string.h>
X#include <ctype.h>
X#define MAXTAGS 10000
X
X/*
X change backspace/underline text into Tk text tags
X -- used to do this in TCL, but it was too slow
X
X by Tom Phelps (phe...@cs.Berkeley.EDU)
X March 24, 1993
X
X*/
X
X/* TO DO ****
X
X something smart with changebars
X*/
X
X
X
Xstruct {
X char *type;
X int line;
X int first;
X int last;
X} tags[MAXTAGS];
X
Xint tagc=0;
X
Xvoid
Xaddtag(char *type, int line, int first, int last)
X{
X tags[tagc].type = type;
X tags[tagc].line = line;
X tags[tagc].first = first;
X tags[tagc].last = last;
X tagc++;
X}
X
X
Xint
Xmain(int argc, char **argv)
X{
X int line=1;
X char buf[BUFSIZ];
X char sect[BUFSIZ];
X int i,ci,hl,alluc;
X int title=1;
X char *bads = "\\\"[]$";
X char *sects = "12345678oln";
X int seealso=0;
X int ncnt=0;
X
X while (gets(buf)!=NULL) {
X /*** strip out per-page titles ***/
X
X if (strncmp(buf,"Sun",3)==0) {title=1; continue;}
X /* you may need to add title-detection lines to _if_ above */
X if (buf[0]!='\0' && !isspace(buf[0])) {
X for (i=0; isalnum(buf[i]) || buf[i]=='_' || buf[i]=='&'; i++) /* empty */;
X if (buf[i++]=='(' && strchr(sects,buf[i++])!=NULL
X && (!isalpha(buf[i]) || i++) && buf[i]==')')
X {title=1; continue;}
X }
X if (buf[0]=='\0') {ncnt++; seealso=0; continue;}
X if (title) {ncnt=0; title=0;}
X
X
X /*** process line, looking for special ones ***/
X
X alluc = isupper(buf[0]);
X printf(".man.show insert end \"");
X
X if (alluc && !ncnt) ncnt=1;
X for (i=0; i<ncnt; i++) {putchar('\n');}
X line+=ncnt; ncnt=0;
X
X /* handle underlining */
X hl=-1;
X for (ci=0,i=0; buf[i]; i++) {
X if ((buf[i]=='_' && buf[i+1]==0x08) || (buf[i]==0x08 && buf[i+1]=='_')) {
X /* start tag only if not already in one */
X if (hl==-1) {hl=ci;}
X i+=2;
X } else {
X if (hl>=0) {
X /* end of tag */
X addtag("high", line, hl, ci);
X hl=-1;
X }
X }
X if (!buf[i]) break; /* safety check */
X /* escape some chars for TCL */
X if (strchr(bads,buf[i])!=NULL) {putchar('\\');}
X if (alluc && islower(buf[i])) alluc=0;
X putchar(buf[i]);
X ci++;
X }
X if (hl>=0) {addtag("high", line, hl, ci);}
X printf("\\n\"\n");
X
X
X /*** deal with section titles, hyperlinks ***/
X
X if (seealso) printf("append maninfo(links) {%s}\n", buf);
X if (alluc) {
X seealso = strcmp(buf,"SEE ALSO")==0;
X for (i=0; buf[i]; i++) {sect[i]=tolower(buf[i]);}
X for (i--; isspace(buf[i]) && i>=0; i--) /* empty */;
X sect[i+1]='\0';
X addtag("title", line, 0, ci);
X printf("$w.sections.m add command -label {%s} -command \"$w.show yview %d\"\n",
X sect, line-1 /* pickplace has zero-based offset */);
X }
X line++;
X }
X
X for (i=0; i<tagc; i++) {
X printf(".man.show tag add %s %d.%d %d.%d\n",
X tags[i].type, tags[i].line, tags[i].first, tags[i].line, tags[i].last);
X }
X printf(".man.search.cnt configure -text \"%d lines\"\n", line-1);
X
X exit(0);
X}
SHAR_EOF
if test 2848 -ne "`wc -c 'bs2tk.c'`"
then
echo shar: error transmitting "'bs2tk.c'" '(should have been 2848 characters)'
fi
echo shar: extracting "'Makefile'" '(1267 characters)'
if test -f 'Makefile'
then
echo shar: over-writing existing file "'Makefile'"
fi
sed 's/^X//' << \SHAR_EOF > 'Makefile'
X#
X# Makefile for TkMan
X#
X
X
X# you need to edit the following three lines
X
XWISHDIR = /usr/sww/bin
XLIBDIR = /home/yew/yew5/users/phelps/lib
XBINDIR = /home/yew/yew5/users/phelps/bin
XINSTALL = install
X# this must be `nawk' or `gawk' (not `awk')
XAWK = gawk
X
X# if you don't have gcc v2.x, you need to edit these two lines
X
XCC = gcc
XCFLAGS = -O2
X
X
X#--------------------------------------------------
X#
X# you shouldn't modify anything below here
X#
X#--------------------------------------------------
X
Xall: tkman bs2tk
X
Xtkman: tkman.tcl
X $(AWK) 'BEGIN {print "#!$(WISHDIR)/wish -f\nset man(lib) $(LIBDIR)\n"}; {print}' tkman.tcl > tkman
X chmod +x tkman
X
Xbs2tk: bs2tk.c
X $(CC) $(CFLAGS) bs2tk.c -o bs2tk
X
Xdebug: tkman.tcl bs2tk.c
X $(AWK) 'BEGIN {print "#!$(WISHDIR)/wish -f\nset man(lib) $(LIBDIR)\nset maninfo(debug) 1\n"}; {print}' tkman.tcl > tkman
X chmod +x tkman
X $(CC) -g -Wall bs2tk.c -o bs2tk
X
Xprofile: bs2tk.c
X # no TCL profiling (yet?)
X $(CC) -pg bs2tk.c -o bs2tk
X
Xinstall: tkman bs2tk
X $(INSTALL) utils.tcl $(LIBDIR)
X $(INSTALL) tkman $(BINDIR)
X $(INSTALL) -s bs2tk $(BINDIR)
X
Xclean:
X rm -f tkman bs2tk
X
Xshar:
X shar -a tkman.tcl utils.tcl bs2tk.c Makefile > tkman.shar
X
Xtar:
X rm -f tkman.tar.z
X gtar chf tkman.tar tkman.tcl utils.tcl bs2tk.c Makefile
X gzip tkman.tar
SHAR_EOF
if test 1267 -ne "`wc -c 'Makefile'`"
then
echo shar: error transmitting "'Makefile'" '(should have been 1267 characters)'
fi
# End of shell archive
exit 0
--
phe...@cs.Berkeley.EDU