File fossilman from the latest check-in

#!/usr/bin/env wish
#!/usr//bin/wish
package require Tk




# frames
#	+---+
#	| A |
#	+---+
#	| B |
#	+---+

set A [ttk::frame ._top]
set B [ttk::frame ._tail]
set PAD [::ttk::notebook $B.pad -width 720 -height 640]

pack $A -fill x
pack $B $PAD -expand yes -fill both


bind . <Escape> { destroy [$PAD select] }
bind  $PAD <2> { destroy [lindex [$PAD tabs] [$PAD index @%x,%y]]}

#############################################################################
#############################################################################
#############################################################################



proc man_tag { w {regex {[\w\d:\-\.]+\s*\([1-9]\w*\)}}  } {

	# we need to do tags individually as they 
	# as they need a binding and are likely different,
	# unlike a general search

	set A [$w.txt search -regex -count B -all $regex 1.0 end] 
	if { $A eq "" } return
	foreach a $A b $B {
	        set name [$w.txt get $a "$a +${b}c" ]
		$w.txt tag add  $name $a "$a +${b}c"
		$w.txt tag configure $name -foreground blue
		$w.txt tag bind $name <1>  "execute fossil help $name" 
	}
}

# do a grep on a text widget and get all indices
proc search { w } {
	
	global PAD
	set B {}
	set L {}
	set tagname $w.tag
	$w.txt tag remove $tagname 1.0 end
	# B == the string lengths
	set A [$w.txt search -regex -count B -all [$w.grep get] 1.0 end] 
	if { $B eq {} } return

	foreach a $A b $B {
		lappend L $a "$a + $b chars"
	}
	$w.txt tag configure $tagname -foreground black -background yellow
	eval $w.txt tag add $tagname $L
	focus [$PAD select].txt
	$w.txt see [lindex $A 0]
}

proc scroller {name} { 
	set frame $name
	frame $frame
	ttk::scrollbar ${frame}.s  -command " $frame.txt yview "
	text $frame.txt -yscrollcommand "${frame}.s set"
	$frame.txt configure -font {Courier 10} -wrap none -relief groove
	$frame.txt configure -foreground black -background ivory

	pack $frame.s -side left -fill y
	pack $frame.txt -expand yes -fill both

	set g [entry $frame.grep -width 30]
	pack [label $frame.name -anchor w -text grep]  -side left
	pack $g -fill x
	bind $g <Key-Return> "search $frame"
	return $frame
}

# if the system call runs but fails, the close will fail
proc slurp_inner { args } {
	set args [eval concat $args]
	set fp [open "|$args 2>@1"]
	set R [read $fp]
	catch {close $fp}
	return $R
}
# catch the sytem call itself
proc slurp { args } {
	catch {slurp_inner $args} a b
	return $a
}

proc name_trim { args } {
	return [regsub -all {\W} $args _ ]
}


proc execute { args } {
	global PAD keywords
	set args [eval concat $args]
        set name .[name_trim $args]

	if { ! [winfo exists $name] } {
	scroller $name 
	$PAD add $name -text $args
	$name.txt insert end "$args\n"
	$name.txt insert end [eval slurp  $args]

	man_tag $name $keywords
	}

	$PAD select $name
}


##################### Jetzt geht's los! #######################
# use 'fossil help -a' to automagically grab
# the available commands and join a huge regex
# like:
#	"this|that|or|the|other"
set cmds [ slurp fossil help -a ]
set keywords [ join $cmds {\M|\m}]
puts $keywords
execute fossil help -a