dircanvas.tcl

TKCVS Source Code For CVS。

#
# Columns for listing CVS files and their status
#

proc DirCanvas:create {w args} {
  global cvscfg
  global cvsglb
  global arr
  global incvs
  global insvn
  global inrcs

  gen_log:log T "ENTER ($w $args)"

  if {[catch "image type folder"]} {
    DirCanvas:loadimages
  }

  frame $w.filecol -relief sunken -bd 2
  frame $w.statcol -relief sunken -bd 2
  frame $w.datecol -relief sunken -bd 2
  frame $w.wrevcol -relief sunken -bd 2
  frame $w.editcol -relief sunken -bd 2

  eval canvas $w.filecol.list $args
  eval canvas $w.statcol.list $args
  eval canvas $w.datecol.list $args
  eval canvas $w.wrevcol.list $args
  eval canvas $w.editcol.list $args
  scrollbar $w.yscroll -orient vertical -command "DirCanvas:scroll_windows $w" \
    -highlightthickness 0

  pack $w.yscroll -side right -fill y

  set cvsglb(fmbg) [lindex [$w.filecol configure -background] 4]
  if {[winfo exists .workdir]} {
    set cvsglb(fg) [lindex [.workdir.top.bmodbrowse configure -foreground] 4]
    set cvsglb(dfg) [lindex [.workdir.top.bmodbrowse configure -disabledforeground] 4]
    set buttonhilite [lindex [.workdir.top.bmodbrowse configure -highlightbackground] 4]
  }
  #set cvsglb(canvbg) [lindex [$w.filecol.list configure -background] 4]
  set selcolor [option get . selectColor selectColor]
  if {[string length $selcolor]} {
    set cvsglb(hlbg) $selcolor
  }
  if {$cvsglb(hlbg) == $cvsglb(canvbg)} {
    set cvsglb(hlbg) $buttonhilite
  }
  if {! [info exists cvsglb(glb_highlight)]} {
    set cvsglb(glb_highlight) $cvsglb(hlbg)
  }

  DirCanvas:column $w filecol "file"
  DirCanvas:column $w statcol "status"
  DirCanvas:column $w datecol "date"
  gen_log:log D "incvs=$incvs insvn=$insvn inrcs=$inrcs"
  if {$incvs || $insvn || $inrcs} {
    gen_log:log D "**** going to make wrevcol ****"
    DirCanvas:column $w wrevcol "revision"
    DirCanvas:column $w editcol "editors"
  }

  # Put an extra arrow on the file column for sorting by status
  set statusbutton $w.filecol.head.statbut
  button $statusbutton -image arr_dn -bg $cvsglb(fmbg) \
    -relief raised -bd 1 -highlightthickness 0
  set arr(filestatcol) $statusbutton
  pack $statusbutton -side left
  bind $statusbutton <ButtonPress-1> \
    "DirCanvas:toggle_col $w statcol"
  bind $statusbutton <ButtonPress-2> \
    "DirCanvas:sort_by_col $w statcol -decreasing"
  bind $statusbutton <ButtonPress-3> \
    "DirCanvas:sort_by_col $w statcol -increasing"

  gen_log:log D "sort_pref:  $cvsglb(sort_pref)"
  set col [lindex $cvsglb(sort_pref) 0]
  set sense [lindex $cvsglb(sort_pref) 1]
  gen_log:log D "$incvs  $col"
  if { (! ($incvs || $inrcs))  && ( $col == "editcol" || $col == "wrevcol") } {
    gen_log:log T "setting sort to column \"filecol!\""
    set col "filecol"
    set sense "-decreasing"
  }
  if {[string match "-inc*" $sense]} {
    gen_log:log D "sort column $col -increasing"
    $arr($col) configure -image arh_up
    if {$col == "statcol"} {$arr(filestatcol) configure -image arh_up}
  } else {
    gen_log:log D "sort column $col -decreasing"
    if {[info exists arr($col)] && [winfo exists $arr($col)]} {
      $arr($col) configure -image arh_dn
    gen_log:log D "arr(col) = arr($col);  arr($col) = $arr($col)"
    }
    if {$col == "statcol"} {
      $arr(filestatcol) configure -image arh_dn
    }
  }

  focus $w.filecol.list
  if {! [winfo exists $w.paper_pop]} {
    DirCanvas:makepopup $w
  }
  gen_log:log T "LEAVE"
}

proc DirCanvas:headtext {w lbltext} {
  $w.editcol.head.lbl configure -text "$lbltext"
}

proc DirCanvas:column {w column headtext} {
  global cvscfg
  global cvsglb
  global incvs
  global insvn
  global inrcs
  global arr

  #gen_log:log T "ENTER ($w $column headtext)"
  #gen_log:log T "showstatcol $cvscfg(showstatcol) showdatecol $cvscfg(showdatecol) showeditcol $cvscfg(showeditcol)"

  $w.$column.list configure -yscrollcommand "$w.yscroll set"
  bind $w.$column.list <Next>  "DirCanvas:scroll_windows $w scroll  1 pages"
  bind $w.$column.list <Prior> "DirCanvas:scroll_windows $w scroll -1 pages"
  bind $w.$column.list <Down>  "DirCanvas:scroll_windows $w scroll  1 units"
  bind $w.$column.list <Up>    "DirCanvas:scroll_windows $w scroll -1 units"
  bind $w.$column.list <B2-Motion> "DirCanvas:drag_windows $w %W %y"
  bind $w.$column.list <MouseWheel> \
      "DirCanvas:scroll_windows $w scroll \[expr {-(%D/120)*4}\] units"
  bind $w.$column.list <ButtonPress-4> \
      "DirCanvas:scroll_windows $w scroll -1 units"
  bind $w.$column.list <ButtonPress-5> \
      "DirCanvas:scroll_windows $w scroll 1 units"

  frame $w.$column.head -relief raised -bd 2
  label $w.$column.head.lbl -text "$headtext"
  button $w.$column.head.sbut -image arr_dn -relief flat \
    -highlightthickness 0 -bg $cvsglb(fmbg)
  set arr($column) $w.$column.head.sbut
  gen_log:log D "$w.$column.head.sbut"


  bind $w.$column.head.sbut <ButtonPress-1> "DirCanvas:toggle_col $w $column"
  bind $w.$column.head.sbut <ButtonPress-2> "DirCanvas:sort_by_col $w $column -decreasing"
  bind $w.$column.head.sbut <ButtonPress-3> "DirCanvas:sort_by_col $w $column -increasing"

  scrollbar $w.$column.xscroll -orient horizontal -width 10 \
     -command "$w.$column.list xview"
  pack $w.$column.xscroll -side bottom -fill x

  if {$column == "datecol"} {
    if {$cvscfg(showdatecol)} {
      DirCanvas:map_column $w datecol
    } else {
      gen_log:log T "LEAVE (skipping datecol)"
    }
    return
  }
  if {$column == "statcol"} {
    if {($incvs || $insvn || $inrcs) && $cvscfg(showstatcol)} {
      DirCanvas:map_column $w statcol
    } else {
      gen_log:log T "LEAVE (skipping statcol)"
    }
    return
  }
  if {$column == "editcol"} {
    if {($incvs || $insvn || $inrcs) && $cvscfg(showeditcol)} {
      DirCanvas:map_column $w editcol
    } else {
      gen_log:log T "LEAVE (skipping editcol)"
    }
    return
  }
  DirCanvas:map_column $w $column
}

proc DirCanvas:map_column {w column} {

  #gen_log:log T "ENTER ($w $column)"
  set mapped_columns [pack slaves $w]
  gen_log:log D "$mapped_columns"

  if {[lsearch -exact $mapped_columns "$w.statcol"] > -1} {
    set leftcol "$w.statcol"
  } else {
    set leftcol "$w.filecol"
  }

  if {$column == "datecol"} {
    pack $w.$column -after $leftcol -side left -fill both -expand yes
  } elseif {$column == "statcol"} {
    pack $w.$column -after $w.filecol -side left -fill both -expand yes
  } elseif {$column == "editcol"} {
    pack $w.$column -after $w.wrevcol -side left -fill both -expand yes
  } else {
    pack $w.$column -side left -fill both -expand yes
  }
  pack $w.$column.head -side top -fill x -expand no
  pack $w.$column.head.sbut -side right
  pack $w.$column.head.lbl -side right -fill x -expand yes
  pack $w.$column.list -side top -fill both -ipadx 2 -expand yes

  #gen_log:log T "LEAVE"
}

#
# Pass configuration options to the list widget
#
proc DirCanvas:config {w args} {
  gen_log:log T "ENTER ($w $args)"
  eval $w.filecol.list config $args
  eval $w.statcol config $args
  eval $w.datecol config $args
  eval $w.wrevcol config $args
  eval $w.editcol config $args
  gen_log:log T "LEAVE"
}

#
# Insert a new element $v into the list $w.
#
proc DirCanvas:newitem {w f} {
  global DirList
  global Filelist
  global cvsglb

  #gen_log:log T "ENTER ($w $f)"

  set DirList($w:$f:name) $f
  #gen_log:log D "Newitem $f status $Filelist($f:status)"
  set DirList($w:$f:status) $Filelist($f:status)
  set DirList($w:$f:date) $Filelist($f:date)
  set DirList($w:$f:sticky) $Filelist($f:stickytag)
  set DirList($w:$f:option) $Filelist($f:option)
  #gen_log:log D "Newitem $f option $Filelist($f:option)"
  # Why did I do this?
  #set DirList($w:$f:option) ""
  if { [info exists Filelist($f:editors)]} {
    set DirList($w:$f:editors) $Filelist($f:editors)
  } else {
    set DirList($w:$f:editors) ""
  }
  set DirList($w:$f:selected) 0

  DirCanvas:buildwhenidle $w
  #gen_log:log T "LEAVE"
}

proc DirCanvas:loadimages { } {
  global cvscfg

  image create photo paper \
    -format gif -file [file join $cvscfg(bitmapdir) paper.gif]
  image create photo cvsdir \
    -format gif -file [file join $cvscfg(bitmapdir) cvsdir.gif]
  image create photo svndir \
    -format gif -file [file join $cvscfg(bitmapdir) svndir.gif]
  image create photo rcsdir \
    -format gif -file [file join $cvscfg(bitmapdir) rcsdir.gif]
  image create photo folder \
    -format gif -file [file join $cvscfg(bitmapdir) folder.gif]
  image create photo dir_ok \
    -format gif -file [file join $cvscfg(bitmapdir) dir_ok.gif]
  image create photo dir_ques \
    -format gif -file [file join $cvscfg(bitmapdir) dir_ques.gif]
  image create photo dir_plus \
    -format gif -file [file join $cvscfg(bitmapdir) dir_plus.gif]
  image create photo dir_minus \
    -format gif -file [file join $cvscfg(bitmapdir) dir_minus.gif]

  image create photo stat_ques \
    -format gif -file [file join $cvscfg(bitmapdir) stat_ques.gif]
  image create photo stat_ex \
    -format gif -file [file join $cvscfg(bitmapdir) stat_ex.gif]
  image create photo stat_kb \
    -format gif -file [file join $cvscfg(bitmapdir) stat_kb.gif]
  image create photo stat_plus_kb \
    -format gif -file [file join $cvscfg(bitmapdir) stat_plus_kb.gif]
  image create photo stat_ok \
    -format gif -file [file join $cvscfg(bitmapdir) stat_ok.gif]
  image create photo stat_ood \
    -format gif -file [file join $cvscfg(bitmapdir) stat_ood.gif]
  image create photo stat_merge \
    -format gif -file [file join $cvscfg(bitmapdir) stat_merge.gif]
  image create photo stat_mod \
    -format gif -file [file join $cvscfg(bitmapdir) stat_mod.gif]
  image create photo stat_plus \
    -format gif -file [file join $cvscfg(bitmapdir) stat_plus.gif]
  image create photo stat_minus \
    -format gif -file [file join $cvscfg(bitmapdir) stat_minus.gif]
  image create photo stat_conf \
    -format gif -file [file join $cvscfg(bitmapdir) stat_conf.gif]
}

#
# Delete element $v from the list $w.
# deleted.
#
proc DirCanvas:delitem {w v} {
  gen_log:log T "ENTER ($w $v)"
  DirCanvas:buildwhenidle $w
  gen_log:log T "LEAVE"
}

proc DirCanvas:deltree {w} {
  global DirList

  catch {destroy $w.filecol}
  catch {destroy $w.statcol}
  catch {destroy $w.datecol}
  catch {destroy $w.wrevcol}
  catch {destroy $w.editcol}
  catch {destroy $w.yscroll}
  foreach t [array names DirList $w:*] {
    unset DirList($t)
  }
}

proc DirCanvas:flash {w y} {
  global cvsglb

  DirCanvas:setTextHBox $w $w.filecol.list.tx$y
}

proc DirCanvas:unflash {w y f} {
  global DirList
  #global cvsglb

  # Don't unflash if this is one that is selected:
  if { ! $DirList($w:$f:selected) } {
    DirCanvas:clearTextHBox $w $w.filecol.list.tx$y
    #if {! [file exists ./$f]} {
      # If a file CVS knows about doesn't exist, write its name in light ink
      #$w.filecol.list itemconfigure $w.filecol.list.tx$y -fill $cvsglb(dfg)
    #}
  }
}

#
# Change the selection to the indicated item
#
proc DirCanvas:setselection {w y f} {
  global DirList
  global cvsglb

  gen_log:log T "ENTER ($w $y $f)"

  DirCanvas:unselectall $w 1
  gen_log:log D "adding \"$f\""
  set DirList($w:$f:selected) 1
  set DirList($w:selection) [list "$f"]
  set cvsglb(current_selection) $DirList($w:selection)
  DirCanvas:setTextHBox $w $w.filecol.list.tx$y

  # This seems to be necessary to enable some OS's (esp. Mandrake)
  # to get a double-click
  after 250

  gen_log:log T "LEAVE"
}

proc DirCanvas:addselection {w y f} {
  global DirList
  global cvsglb

  gen_log:log T "ENTER ($w $y $f)"

  regsub -all {\%\%} $f {%} fn
  regsub -all {\\\$} $fn {$} fn
  # If it's already selected, unselect it
  if { $DirList($w:$fn:selected) } {
    gen_log:log D "\"$fn\" was selected - unselecting"
    set DirList($w:$fn:selected) 0
    set idx [lsearch -exact $DirList($w:selection) "$fn"]
    if {$idx > -1} {
      gen_log:log D "found \"$fn\" - removing from selection list"
      set DirList($w:selection) [lreplace $DirList($w:selection) $idx $idx]
      gen_log:log D "$DirList($w:selection)"
      DirCanvas:clearTextHBox $w $w.filecol.list.tx$y
    }
  } else {
    gen_log:log D "adding \"$fn\""
    DirCanvas:setTextHBox $w $w.filecol.list.tx$y
    set DirList($w:$fn:selected) 1
    lappend DirList($w:selection) "$fn"
  }
  set cvsglb(current_selection) $DirList($w:selection)
  gen_log:log D "selection is \"$cvsglb(current_selection)\""
  gen_log:log T "LEAVE"
}


# clear any text highlight box (used by set/clearselection)
proc DirCanvas:clearTextHBox {w id} {
   global cvsglb

    # clear the tag corresponding to the text label
    catch {$w.filecol.list delete HBox$id}
    $w.filecol.list itemconfigure $id -fill $cvsglb(fg)
}

# set a text highligh box (used by set/clearselection)
proc DirCanvas:setTextHBox {w id} {
   global cvsglb

   # get the bounding box for the text id
   set bbox [$w.filecol.list bbox $id]
   if {[llength $bbox]==4} {
    # create rectangle with fill, tagged with the same ID as the text, so we can delete it later
    set i [eval $w.filecol.list create rectangle $bbox -fill $cvsglb(hlbg) -tag HBox$id -outline \"\"]

    $w.filecol.list itemconfigure $id -fill $cvsglb(hlfg)
    $w.filecol.list lower $i
  }
}


proc DirCanvas:addrange {w y f} {
  global DirList
  global cvsglb

  gen_log:log T "ENTER ($w $y $f)"
  if {! [info exists DirList($w:selection)] || [llength $DirList($w:selection)] < 1} {
    DirCanvas:clearTextHBox $w $w.filecol.list.tx$y
    set DirList($w:$f:selected) 1
    lappend DirList($w:selection) "$f"
    set cvsglb(current_selection) $DirList($w:selection)
    return
  }
  set sel1 [lindex $DirList($w:selection) 0]

  set iy $DirList($w:$sel1:y)
  gen_log:log D "Selection 1  :  $sel1 y=$iy"
  gen_log:log D "New Selection:  $f y=$y\n"

  if { $y > $iy } {
    foreach item [array names DirList $w:*:name] {
      set j $DirList($item)
      set jy $DirList($w:$j:y)
      if { $jy > $iy && $y > $jy} {
        gen_log:log D "$j y=$jy"
        DirCanvas:setTextHBox $w $w.filecol.list.tx$jy
        set DirList($w:$j:selected) 1
        if {[lsearch -exact $DirList($w:selection) $j] == -1} {
          lappend DirList($w:selection) "$j"
        }
      }
    }
  } elseif {$y < $iy } {
    foreach item [array names DirList $w:*:name] {
      set j $DirList($item)
      set jy $DirList($w:$j:y)
      if { $jy < $iy && $y < $jy} {
        gen_log:log D "$j y=$jy"
        DirCanvas:setTextHBox $w $w.filecol.list.tx$jy
        set DirList($w:$j:selected) 1
        if {[lsearch -exact $DirList($w:selection) $j] == -1} {
          lappend DirList($w:selection) "$j"
        }
      }