::less::less filenameSome of the well know less-shortcuts are supported (e.g. /). To get a complete list press '?'
namespace eval less {
namespace export less
proc less filename {
package require Tk
set now [clock seconds]
set tl .$now
if {[info commands $tl]!=""} {
after 2000 [list tailf $filename]
return
}
toplevel $tl
wm title $tl $filename
frame ${tl}.f
text ${tl}.f.t -yscrollcommand "${tl}.f.scroll set" -width 1 -height 1
scrollbar ${tl}.f.scroll -command "${tl}.f.t yview"
pack ${tl}.f -expand 1 -fill both
pack ${tl}.f.scroll -side right -fill y
pack ${tl}.f.t -side left -expand 1 -fill both
entry ${tl}.search
${tl}.search insert 0 "press '?' for help"
pack ${tl}.search -fill x
wm state $tl zoomed
bind ${tl}.f.t <Key-slash> [namespace code [list to_search ${tl}.search]]
bind ${tl}.search <Return> [namespace code [list search $tl forwards forwards]]
bind ${tl}.search <Shift-Return> [namespace code [list search $tl backwards forwards]]
bind ${tl}.f.t <Shift-G> [namespace code [list goto ${tl}.f.t end]]
bind ${tl}.f.t g [namespace code [list goto ${tl}.f.t 1.0]]
bind ${tl}.f.t ? [namespace code display_help]
bind ${tl}.f.t q "destroy ${tl} ; break"
set fd [open $filename r]
while {![eof $fd]} {
${tl}.f.t insert end "[gets $fd]\n"
}
close $fd
${tl}.f.t configure -state disabled
focus ${tl}.f.t
goto ${tl}.f.t 1.0
}
proc to_search {widget} {
focus $widget
$widget delete 0 end
}
proc goto {widget where} {
$widget see $where
$widget mark set pos $where
}
proc display_help {} {
set help_message "
?: Display this dialog
/: Goto search entry box
g: Display beginning of file
G: Display end of file
q: Exit
In entry box
<Enter>: Search forwards
<Shift-Enter>: Search backwards
When matches are found
n: Show next match
p: Show previous match
"
tk_messageBox -type ok -title "Less shortcut commands" -message $help_message
}
proc search {tl mode direction {start {}} {end {}}} {
if {$start eq {}} {
set start [${tl}.f.t index pos]
}
if {$end eq {}} {
set end [${tl}.f.t index pos]
}
set regexp [${tl}.search get]
if {($mode eq "forwards") && ($direction eq "forwards")} {
set match_start_idx [${tl}.f.t search -forwards -count chars -regexp -- $regexp $end]
} elseif {($mode eq "forwards") && ($direction eq "backwards")} {
set match_start_idx [${tl}.f.t search -backwards -count chars -regexp -- $regexp $start]
} elseif {($mode eq "backwards") && ($direction eq "forwards") } {
set match_start_idx [${tl}.f.t search -backwards -count chars -regexp -- $regexp $start]
} elseif {($mode eq "backwards") && ($direction eq "backwards") } {
set match_start_idx [${tl}.f.t search -forwards -count chars -regexp -- $regexp $end]
}
if {$match_start_idx eq "" } {
bell
} else {
${tl}.f.t tag remove sel 1.0 end
focus ${tl}.f.t
goto ${tl}.f.t $match_start_idx
set match_end_idx "$match_start_idx+${chars}c"
${tl}.f.t tag add sel $match_start_idx $match_end_idx
bind ${tl}.f.t n [namespace code [list search $tl $mode forwards $match_start_idx $match_end_idx ]]
bind ${tl}.f.t p [namespace code [list search $tl $mode backwards $match_start_idx $match_end_idx ]]
}
}
}See also: A grep-like utility - A little file searcher - tk_getOpenFile

