lib/grep.tcl

   1 class grep {
   2
   3 # widgets
   4 field w
   5 field w_vpane
   6 field w_entry
   7 field w_files
   8 field w_cnts
   9 field w_grep
  10 field w_lnos
  11 field grep_lno
  12 field grep_nl
  13 field next_nl_tag
  14
  15 field ui_cnts_width 3
  16 field ui_cnts_width_max
  17 field ui_files_cols
  18 field ui_lnos_width 5
  19 field ui_lnos_width_max
  20 field ui_grep_cols
  21
  22 field file_list
  23 field current_path {}
  24 field previous_path {}
  25 field current_path_label {}
  26 field patterns [list]
  27 field patterns_pos -1
  28 field busy 0
  29 field current_fd
  30
  31 field first_match_line 0
  32
  33 field buf_rgl {}
  34
  35 constructor embed {i_w} {
  36
  37         set w $i_w
  38         _init $this
  39
  40         return $this
  41 }
  42
  43 constructor new {args} {
  44
  45         make_toplevel top w
  46         wm title $top "Git-Gui: Grep"
  47
  48         _init $this
  49
  50         bind $top <Control-Key-r> [cb grep]
  51         bind $top <Control-Key-R> [cb grep]
  52         bind $top <Control-Key-h> [cb grep_from_selection]
  53         bind $top <Control-Key-H> [cb grep_from_selection]
  54
  55         set font_w [font measure font_diff "0"]
  56
  57         set req_w [winfo reqwidth  $top]
  58         set req_h [winfo reqheight $top]
  59         set scr_w [expr {[winfo screenwidth $top] - 40}]
  60         set scr_h [expr {[winfo screenheight $top] - 120}]
  61         set opt_w [expr {$font_w * (80 + 32)}]
  62         if {$req_w < $opt_w} {set req_w $opt_w}
  63         if {$req_w > $scr_w} {set req_w $scr_w}
  64         set opt_h [expr {$scr_h*1/2}]
  65         if {$req_h < $scr_h} {set req_h $scr_h}
  66         if {$req_h > $opt_h} {set req_h $opt_h}
  67         set g "${req_w}x${req_h}"
  68         wm geometry $top $g
  69         update
  70
  71         wm protocol $top WM_DELETE_WINDOW "destroy $top"
  72         bind $top <Destroy> [cb _handle_destroy %W]
  73
  74         if {[llength $args] > 0} {
  75                 set pattern {}
  76                 foreach arg $args {
  77                         if {$pattern ne {}} {
  78                                 append pattern { }
  79                         }
  80                         if {[regexp {[ \t\r\n'"$?*]} $arg]} {
  81                                 #"
  82                                 set arg [sq $arg]
  83                         }
  84                         append pattern $arg
  85                 }
  86                 grep $this $pattern
  87         }
  88 }
  89
  90 method _init {} {
  91
  92         # base path for all grep widgets
  93         set w_vpane $w.v
  94         set w_entry $w.entry
  95         set w_files $w_vpane.f.text
  96         set w_cnts  $w_vpane.f.cnts
  97         set w_grep  $w_vpane.o.text
  98         set w_lnos  $w_vpane.o.lnos
  99
 100         ttk::panedwindow $w_vpane -orient horizontal
 101
 102         entry $w_entry \
 103                 -font TkDefaultFont \
 104                 -disabledforeground white \
 105                 -disabledbackground blue \
 106                 -validate key \
 107                 -validatecommand [cb _reset_errstatus] \
 108                 -takefocus [cb _always_takefocus]
 109
 110         pack $w_vpane -side top -fill both -expand 1
 111         pack $w_entry -side bottom -fill x
 112
 113         ttk::frame $w_vpane.f -borderwidth 0
 114         ttk::frame $w_vpane.o -borderwidth 0
 115         $w_vpane add $w_vpane.f -weight 0
 116         $w_vpane add $w_vpane.o -weight 1
 117
 118         ## list of files with matches
 119
 120         ttk::label $w_vpane.f.title \
 121                 -style Color.TLabel \
 122                 -text "Matched Files" \
 123                 -background lightsalmon \
 124                 -foreground black
 125
 126         text $w_files \
 127                 -background white \
 128                 -foreground black \
 129                 -borderwidth 0 \
 130                 -takefocus 0 \
 131                 -highlightthickness 0 \
 132                 -padx 0 -pady 0 \
 133                 -state disabled \
 134                 -wrap none \
 135                 -width 20 \
 136                 -height 10 \
 137                 -xscrollcommand [list $w_vpane.f.sbx set]
 138         $w_files tag conf default -lmargin1 5 -rmargin 1
 139
 140         text $w_cnts \
 141                 -takefocus 0 \
 142                 -highlightthickness 0 \
 143                 -padx 0 -pady 0 \
 144                 -background grey95 \
 145                 -foreground black \
 146                 -borderwidth 0 \
 147                 -width [expr $ui_cnts_width + 1] \
 148                 -height 10 \
 149                 -wrap none \
 150                 -state disabled
 151         $w_cnts tag conf count -justify right -lmargin1 2 -rmargin 3 -foreground red
 152
 153         set ui_files_cols [list $w_files $w_cnts]
 154
 155         # simulate linespacing, as if it has an icon like the index/worktree
 156         # lists
 157         set fn [$w_cnts cget -font]
 158         set ls [font metrics $fn -linespace]
 159         if {$ls < 17} {
 160                 set d [expr 17 - $ls]
 161                 set b [expr $d / 2]
 162                 set t $b
 163                 if {[expr $b + $t] != $d} {
 164                         incr b
 165                 }
 166                 foreach i $ui_files_cols {
 167                         $i configure -spacing1 $t -spacing3 $b
 168                 }
 169         }
 170
 171         ttk::scrollbar $w_vpane.f.sbx \
 172                 -orient h \
 173                 -command [list $w_files xview]
 174
 175         ttk::scrollbar $w_vpane.f.sby \
 176                 -orient v \
 177                 -command [list scrollbar2many $ui_files_cols yview]
 178
 179         grid configure $w_vpane.f.title \
 180                 -column 0 \
 181                 -columnspan 3 \
 182                 -sticky we
 183
 184         grid $w_files $w_cnts $w_vpane.f.sby -sticky nsew
 185
 186         grid configure $w_vpane.f.sbx \
 187                 -column 0 \
 188                 -columnspan 3 \
 189                 -sticky we
 190
 191         grid columnconfigure $w_vpane.f \
 192                 0 \
 193                 -weight 1
 194         grid rowconfigure $w_vpane.f \
 195                 1 \
 196                 -weight 1
 197
 198         foreach i $ui_files_cols {
 199                 rmsel_tag $i
 200
 201                 $i conf -cursor arrow
 202                 $i conf -yscrollcommand \
 203                         "[list many2scrollbar $ui_files_cols yview $w_vpane.f.sby]"
 204
 205                 bind $i <Button-1>        "[cb _select_from_list %x %y]; break"
 206                 bind $i <ButtonRelease-2> "[cb _select_from_list %x %y [cb _open_first_match]]; break"
 207         }
 208
 209         ## grep output from one file
 210
 211         ttk::label $w_vpane.o.title \
 212                 -style Color.TLabel \
 213                 -textvariable @current_path_label \
 214                 -background gold \
 215                 -foreground black \
 216                 -justify right \
 217                 -anchor e
 218
 219         set ctxm $w_vpane.o.title.ctxm
 220         menu $ctxm -tearoff 0
 221         $ctxm add command \
 222                 -label [mc Copy] \
 223                 -command [cb _copy_path]
 224         bind_button3 $w_vpane.o.title "tk_popup $ctxm %X %Y"
 225
 226         text $w_lnos \
 227                 -takefocus 0 \
 228                 -highlightthickness 0 \
 229                 -padx 0 -pady 0 \
 230                 -background grey95 \
 231                 -foreground black \
 232                 -borderwidth 0 \
 233                 -width [expr $ui_lnos_width + 1] \
 234                 -height 10 \
 235                 -wrap none \
 236                 -state disabled \
 237                 -font font_diff
 238         $w_lnos tag conf linenumber -justify right -rmargin 5
 239
 240         text $w_grep \
 241                 -takefocus 0 \
 242                 -highlightthickness 0 \
 243                 -padx 0 -pady 0 \
 244                 -background white \
 245                 -foreground black \
 246                 -borderwidth 0 \
 247                 -width 80 \
 248                 -height 10 \
 249                 -wrap none \
 250                 -xscrollcommand [list $w_vpane.o.sbx set] \
 251                 -state disabled \
 252                 -font font_diff
 253
 254         $w_grep tag conf hunksep -background grey95
 255         $w_grep tag conf d_info -foreground blue -font font_diffbold
 256
 257         foreach {n c} {0 black 1 red 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
 258                 $w_grep tag configure clr4$n -background $c
 259                 $w_grep tag configure clri4$n -foreground $c
 260                 $w_grep tag configure clr3$n -foreground $c
 261                 $w_grep tag configure clri3$n -background $c
 262         }
 263         $w_grep tag configure clr1 -font font_diffbold
 264         $w_grep tag configure clr4 -underline 1
 265
 266         set ui_grep_cols [list $w_lnos $w_grep]
 267
 268         delegate_sel_to $w_grep [list $w_lnos]
 269
 270         ttk::scrollbar $w_vpane.o.sbx \
 271                 -orient h \
 272                 -command [list $w_grep xview]
 273
 274         ttk::scrollbar $w_vpane.o.sby \
 275                 -orient v \
 276                 -command [list scrollbar2many $ui_grep_cols yview]
 277
 278         grid configure $w_vpane.o.title \
 279                 -column 0 \
 280                 -columnspan 3 \
 281                 -sticky ew
 282
 283         grid $w_lnos $w_grep $w_vpane.o.sby -sticky nsew
 284
 285         grid configure $w_vpane.o.sbx \
 286                 -column 0 \
 287                 -columnspan 3 \
 288                 -sticky we
 289
 290         grid columnconfigure $w_vpane.o \
 291                 1 \
 292                 -weight 1
 293         grid rowconfigure $w_vpane.o \
 294                 1 \
 295                 -weight 1
 296
 297         rmsel_tag $w_lnos
 298         foreach i $ui_grep_cols {
 299                 $i tag raise sel
 300
 301                 $i conf -yscrollcommand \
 302                         "[list many2scrollbar $ui_grep_cols yview $w_vpane.o.sby]"
 303
 304                 bind $i <ButtonRelease-2> "[cb _open_from_grep %x %y]"
 305         }
 306
 307         foreach i [list $w $w_files $w_cnts $w_lnos $w_grep $w_entry] {
 308
 309                 # grep history
 310                 bind $i <Alt-Key-Left>  "[cb grep_prev]; break"
 311                 bind $i <Alt-Key-Right> "[cb grep_next]; break"
 312
 313                 # scoll of file list
 314                 bind $i <Up>            "[cb _files_scroll_line -1]; break"
 315                 bind $i <Down>          "[cb _files_scroll_line  1]; break"
 316                 bind $i <Key-Prior>     "[cb _files_scroll_page -1]; break"
 317                 bind $i <Key-Next>      "[cb _files_scroll_page  1]; break"
 318
 319                 # scroll of grep result
 320                 bind $i <Alt-Key-Up>    "[cb _grep_scroll yview -1 units]; break"
 321                 bind $i <Alt-Key-Down>  "[cb _grep_scroll yview  1 units]; break"
 322                 bind $i <Alt-Prior>     "[cb _grep_scroll yview -1 pages]; break"
 323                 bind $i <Alt-Next>      "[cb _grep_scroll yview  1 pages]; break"
 324         }
 325
 326         foreach i [list $w $w_files $w_cnts $w_lnos $w_grep] {
 327                 bind $i <Left>         break
 328                 bind $i <Right>        break
 329                 bind $i <Return>       "[cb _open_first_match]; break"
 330         }
 331
 332         bind $w_entry <Return>        [cb _grep_from_entry]
 333         bind $w_entry <Shift-Return>  "[cb _open_first_match]; break"
 334         bind $w_entry <Key-Left>      [cb _reset_errstatus]
 335         bind $w_entry <Key-Right>     [cb _reset_errstatus]
 336         bind $w_entry <Control-Key-c> [cb _cancel]
 337         bind $w_entry <Visibility>    [list focus $w_entry]
 338
 339         trace add variable current_path write [cb _update_path_label]
 340         set current_path {}
 341
 342         set patterns [list]
 343 }
 344
 345 method _clear_grep {} {
 346         foreach i $ui_grep_cols {
 347                 $i conf -state normal
 348                 $i delete 0.0 end
 349                 $i conf -state disabled
 350         }
 351         $w_lnos conf -width [expr $ui_lnos_width + 1]
 352
 353         set grep_nl ""
 354         set grep_lno 1
 355         set next_nl_tag {}
 356
 357         set first_match_line 0
 358
 359         set previous_path $current_path
 360         set current_path {}
 361 }
 362
 363 method grep {{pattern {}}} {
 364         if {$busy} return
 365         set busy 1
 366
 367         $w_entry delete 0 end
 368
 369         set file_list [list]
 370         foreach i $ui_files_cols {
 371                 $i conf -state normal
 372                 $i delete 0.0 end
 373                 $i conf -state disabled
 374         }
 375         $w_cnts conf -width [expr $ui_cnts_width + 1]
 376         set ui_cnts_width_max $ui_cnts_width
 377
 378         _clear_grep $this
 379
 380         set buf_rgl {}
 381
 382         if {$pattern ne {}} {
 383                 lappend patterns "$pattern"
 384                 set patterns_pos [expr [llength $patterns] - 1]
 385         }
 386
 387         if {$patterns_pos == -1} {
 388                 set busy 0
 389                 return
 390         }
 391
 392         set pattern [lindex $patterns $patterns_pos]
 393
 394         $w_entry insert 0 $pattern
 395         $w_entry conf -state disabled
 396
 397         ui_status "Grep for matching files..."
 398         set cmd [list | [shellpath] -c "git grep -c -z $pattern"]
 399         if {[catch {set current_fd [open $cmd r]} err]} {
 400                 $w_entry conf -state normal -background red
 401                 set busy 0
 402
 403                 tk_messageBox \
 404                         -icon error \
 405                         -type ok \
 406                         -title {git-gui: grep: fatal error} \
 407                         -message $err
 408
 409                 return
 410         }
 411         fconfigure $current_fd -eofchar {}
 412         fconfigure $current_fd \
 413                 -blocking 0 \
 414                 -buffering full \
 415                 -buffersize 512 \
 416                 -translation binary
 417         fileevent $current_fd readable [cb _do_read]
 418 }
 419
 420 method _do_read {} {
 421         append buf_rgl [read $current_fd]
 422         set c 0
 423         set n [string length $buf_rgl]
 424
 425         foreach i $ui_files_cols {$i conf -state normal}
 426         while {$c < $n} {
 427                 # find the \0 after a path
 428                 set zb [string first "\0" $buf_rgl $c]
 429                 if {$zb == -1} break
 430                 set path  [string range $buf_rgl $c [expr {$zb - 1}]]
 431                 incr zb
 432
 433                 # find the newline after the count
 434                 set nl [string first "\n" $buf_rgl $zb]
 435                 if {$nl == -1} break
 436                 set cnt [string range $buf_rgl $zb [expr {$nl - 1}]]
 437                 incr nl
 438
 439                 set path [encoding convertfrom $path]
 440                 lappend file_list $path
 441
 442                 $w_cnts insert end "$cnt\n" count
 443                 set cnt_len [string length $cnt]
 444                 if {$ui_cnts_width_max < $cnt_len} {
 445                         set ui_cnts_width_max $cnt_len
 446                 }
 447                 $w_files insert end "[escape_path $path]\n" default
 448
 449                 set c $nl
 450         }
 451         foreach i $ui_files_cols {$i conf -state disabled}
 452
 453         if {$c < $n} {
 454                 set buf_rgl [string range $buf_rgl $c end]
 455         } else {
 456                 set buf_rgl {}
 457         }
 458
 459         fconfigure $current_fd -blocking 1
 460         if {![eof $current_fd]} {
 461                 fconfigure $current_fd -blocking 0
 462                 return
 463         }
 464
 465         if {[catch {close $current_fd} err]} {
 466                 $w_entry conf -state normal -background red
 467         } else {
 468                 $w_entry conf -state normal -background green
 469         }
 470
 471         # remove trailing newline
 472         foreach i $ui_files_cols {
 473                 $i conf -state normal
 474                 $i delete "end -1 char"
 475                 $i conf -state disabled
 476         }
 477         $w_cnts conf -width [expr $ui_cnts_width_max + 1]
 478
 479         set busy 0
 480         ui_ready
 481
 482         if {[llength $file_list] eq 0} {
 483                 return
 484         }
 485
 486         set file_index -1
 487         if {$previous_path ne {}} {
 488                 set file_index [lsearch -exact $file_list $previous_path]
 489         }
 490         if {$file_index == -1} {
 491                 set file_index 0
 492         }
 493         # lines starting with 1, so add 1 more line to the zero based file_index
 494         set line [expr {$file_index + 1}]
 495         foreach i $ui_files_cols {
 496                 $i tag add in_sel "$line.0" "$line.0 + 1 line"
 497         }
 498         _show_file $this [lindex $file_list $file_index]
 499 } ifdeleted { catch {close $current_fd} }
 500
 501 method _show_file {path {after {}}} {
 502         set cmd [list | [shellpath] -c "git grep --color -h -n -p -3 [lindex $patterns $patterns_pos] -- [sq [encoding convertto $path]]"]
 503
 504         _clear_grep $this
 505         set ui_lnos_width_max $ui_lnos_width
 506
 507         ui_status "Grepping [escape_path $path]..."
 508         set current_path $path
 509
 510         if {[catch {set fd [open $cmd r]} err]} {
 511                 tk_messageBox \
 512                         -icon error \
 513                         -type ok \
 514                         -title {gui-grep: fatal error} \
 515                         -message $err
 516                 set current_path {}
 517                 ui_status "Grepping of [escape_path $path] failed..."
 518                 unset fd
 519                 return
 520         }
 521         fconfigure $fd -eofchar {}
 522         fconfigure $fd \
 523                 -blocking 0 \
 524                 -encoding [get_path_encoding $path] \
 525                 -buffering full \
 526                 -buffersize 512 \
 527                 -translation lf
 528         fileevent $fd readable [cb _file_read $fd $path $after]
 529 }
 530
 531 method _file_read {fd path after} {
 532         foreach i $ui_grep_cols {$i conf -state normal}
 533
 534         while {[gets $fd line] >= 0} {
 535
 536                 set nl_tag $next_nl_tag
 537                 set next_nl_tag {}
 538
 539                 if {[string match {Binary file * matches} $line]} {
 540                         $w_lnos insert end "${grep_nl}*" linenumber
 541                         $w_grep insert end "${grep_nl}Binary file matches" d_info
 542                         set grep_nl "\n"
 543                         incr grep_lno
 544                         continue
 545                 }
 546
 547                 # catch hunk sep --
 548                 if {[regexp {^(?:\033\[(?:(?:\d+;)*\d+)m)?--(?:\033\[m)?} $line]} {
 549                         set lno "--"
 550                         set mline {}
 551                         set markup [list]
 552                         set next_nl_tag hunksep
 553                 } else {
 554                         # remove any color from lno and sep
 555                         regexp {^(?:\033\[(?:(?:\d+;)*\d+)m)?(\d+)(?:\033\[m)?(?:\033\[(?:(?:\d+;)*\d+)m)?([-:=])(?:\033\[m)?(.*)$} $line all lno line_type mline
 556                         foreach {mline markup} [parse_color_line $mline] break
 557                         set mline [string map {\033 ^} $mline]
 558                         regsub {\r$} $mline {} mline
 559                         if {$line_type eq {:} && $first_match_line eq 0} {
 560                                 set first_match_line $lno
 561                         }
 562                 }
 563
 564                 set mark $grep_lno.0
 565
 566                 $w_lnos insert end "$grep_nl$lno" linenumber
 567                 set lno_len [string length $lno]
 568                 if {$ui_lnos_width_max < $lno_len} {
 569                         set ui_lnos_width_max $lno_len
 570                 }
 571                 $w_grep insert end "$grep_nl" $nl_tag
 572                 $w_grep insert end "$mline"
 573                 set grep_nl "\n"
 574                 incr grep_lno
 575
 576                 foreach {posbegin colbegin posend colend} $markup {
 577                         set prefix clr
 578                         foreach style [lsort -integer [split $colbegin ";"]] {
 579                                 if {$style eq "7"} {append prefix i; continue}
 580                                 # ignore bold (1), because it doesn't buy us anything
 581                                 if {$style != 4
 582                                     && ($style < 30 || $style > 37)
 583                                     && ($style < 40 || $style > 47)} {
 584                                         continue
 585                                 }
 586                                 set a "$mark + $posbegin chars"
 587                                 set b "$mark + $posend chars"
 588                                 catch {$w_grep tag add $prefix$style $a $b}
 589                         }
 590                 }
 591         }
 592
 593         if {[eof $fd]} {
 594                 close $fd
 595
 596                 #update line number column width
 597                 $w_lnos conf -width [expr $ui_lnos_width_max + 1]
 598
 599                 ui_ready
 600
 601                 if {$after ne {}} {
 602                         eval $after
 603                 }
 604         }
 605
 606         foreach i $ui_grep_cols {$i conf -state disabled}
 607 } ifdeleted { catch {close $fd} }
 608
 609 method _select_from_list {x y {after {}}} {
 610         focus $w_files
 611
 612         set lno [lindex [split [$w_files index @0,$y] .] 0]
 613         set path [lindex $file_list [expr {$lno - 1}]]
 614         if {$path eq {}} {
 615                 return
 616         }
 617
 618         foreach i $ui_files_cols {
 619                 $i tag remove in_sel 0.0 end
 620                 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
 621         }
 622
 623         if {$path eq $current_path} {
 624                 if {$after ne {}} {
 625                         eval $after
 626                 }
 627                 return
 628         }
 629
 630         _show_file $this $path $after
 631 }
 632
 633 method _open_from_grep {x y} {
 634         if {$current_path eq {}} {
 635                 return
 636         }
 637
 638         set lno {}
 639         set wlno [$w_lnos search -regexp {^[[:digit:]]+$} "@0,$y linestart" end]
 640         if {$wlno eq {}} {
 641                 set wlno [$w_lnos search -backwards -regexp {^[[:digit:]]+$} "@0,$y linestart" 1.0]
 642         }
 643         if {$wlno ne {}} {
 644                 set lno [$w_lnos get "$wlno" "$wlno lineend"]
 645         }
 646
 647         open_in_git_editor $current_path $lno
 648 }
 649
 650 method _open_first_match {} {
 651         if {$current_path eq {} || $first_match_line == 0} {
 652                 return
 653         }
 654         open_in_git_editor $current_path $first_match_line
 655 }
 656
 657 method grep_from_selection {} {
 658         if {[catch {set expr [selection get -selection PRIMARY -type STRING]}]} {
 659                 return
 660         }
 661         if {$expr eq {}} {
 662                 return
 663         }
 664         set expr [sq $expr]
 665
 666         grep $this "-F -e $expr"
 667 }
 668
 669 method _grep_from_entry {} {
 670         set expr [$w_entry get]
 671
 672         # open selected file if we didn't changed the pattern
 673         if {$patterns_pos != -1 && $expr eq [lindex $patterns $patterns_pos]} {
 674                 _open_first_match $this
 675         } else {
 676                 grep $this $expr
 677         }
 678 }
 679
 680 method grep_prev {} {
 681         _reset_errstatus $this
 682         if {$patterns_pos > 0} {
 683                 incr patterns_pos -1
 684                 grep $this
 685         }
 686 }
 687
 688 method grep_next {} {
 689         _reset_errstatus $this
 690         if {[expr {$patterns_pos + 1}] < [llength $patterns]} {
 691                 incr patterns_pos
 692                 grep $this
 693         }
 694 }
 695
 696 method _update_path_label {args} {
 697         if {$current_path eq {}} {
 698                 set current_path_label "No file matched."
 699         } else {
 700                 set current_path_label "File: [escape_path $current_path]"
 701         }
 702 }
 703
 704 method _files_scroll_line {dir} {
 705         if {$busy} return
 706
 707         if {[catch {$w_files index in_sel.first}]} {
 708                 return
 709         }
 710
 711         set lno [lindex [split [$w_files index in_sel.first] .] 0]
 712         incr lno $dir
 713
 714         set path [lindex $file_list [expr {$lno - 1}]]
 715         if {$path eq {}} {
 716                 return
 717         }
 718
 719         foreach i $ui_files_cols {
 720                 $i tag remove in_sel 0.0 end
 721                 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
 722         }
 723         $w_files see $lno.0
 724
 725         _show_file $this $path
 726 }
 727
 728 method _files_scroll_page {dir} {
 729         if {$busy} return
 730
 731         $w_files yview scroll $dir pages
 732         set lno [expr {int(
 733                   [lindex [$w_files yview] 0]
 734                 * [llength $file_list]
 735                 + 1)}]
 736
 737         set path [lindex $file_list [expr {$lno - 1}]]
 738         if {$path eq {}} {
 739                 return
 740         }
 741
 742         foreach i $ui_files_cols {
 743                 $i tag remove in_sel 0.0 end
 744                 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
 745         }
 746         $w_files see $lno.0
 747
 748         _show_file $this $path
 749 }
 750
 751 method _grep_scroll {v a u} {
 752         $w_grep $v scroll $a $u
 753 }
 754
 755 method _copy_path {} {
 756         clipboard clear
 757         clipboard append \
 758                 -format STRING \
 759                 -type STRING \
 760                 -- $current_path
 761 }
 762
 763 method _reset_errstatus {} {
 764         $w_entry conf -background white
 765         return 1
 766 }
 767
 768 method _cancel {} {
 769         if {$busy} {
 770                 set busy 0
 771                 catch {close $current_fd}
 772                 $w_entry conf -state normal -background red
 773                 foreach i $ui_files_cols {
 774                         $i conf -state normal
 775                         $i delete "end -1 char"
 776                         $i conf -state disabled
 777                 }
 778         }
 779 }
 780
 781 method _always_takefocus {w} {
 782         return 1
 783 }
 784
 785 method _handle_destroy {win} {
 786         if {$win eq $w} {
 787                 delete_this
 788         }
 789 }
 790
 791 method link_vpane {vpane} {
 792         bind $w_vpane <Map> [cb _on_pane_mapped $vpane]
 793 }
 794
 795 method _on_pane_mapped {master_vpane} {
 796         if {$::use_ttk} {
 797                 after idle [list after idle [list $w_vpane sashpos 0 [$master_vpane sashpos 0]]]
 798         } else {
 799                 after idle [list after idle \
 800                         [list $w_vpane sash place 0 \
 801                                 [lindex [$master_vpane sash coord 0] 0] \
 802                                 [lindex [$w_vpane      sash coord 0] 1]]]
 803         }
 804 }
 805
 806 method reorder_bindtags {} {
 807         foreach i [list $w $w_files $w_cnts $w_lnos $w_grep $w_entry] {
 808                 bindtags $i [list all $i [winfo class $i] .]
 809         }
 810 }
 811
 812 }