Updated 2011-07-21 01:30:15 by RLE

[MJ] - The following script will create a less-like Tk window where a file can be searched. You can call the script with:
 ::less::less filename

Some 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