dircanvas.tcl

TKCVS Source Code For CVS。

      DirCanvas:map_column $w statcol
    } else {
      pack forget $w.statcol
    }
    if {$cvscfg(showeditcol)} {
      DirCanvas:map_column $w editcol
    } else {
      pack forget $w.editcol
    }
  }
  if {$cvscfg(showdatecol)} {
    DirCanvas:map_column $w datecol
  } else {
    pack forget $w.datecol
  }


  set wid [font measure $cvscfg(listboxfont) -displayof $w $longlbl]
  set DirList($w:filecolwidth) [expr {$x + $wid + $lblx + 8}]
  # Set a minimum width for the labels.  Otherwise ".." can be hard to select.
  set minlabel 6
  foreach labl [$flist find withtag lbl] {
    set itags [$flist gettags $labl]
    set iy [lindex $itags 1]
    if {[string length $DirList($flist:$iy)] < $minlabel} {
      $flist.tx$iy configure -width $minlabel
    }
  }
  # Don't let the column be too wide.
  set maxcolwid 200
  gen_log:log D "filecol width $DirList($w:filecolwidth)"
  if {$wid < $maxcolwid} {
    $flist configure -width $DirList($w:filecolwidth)
  } else {
    gen_log:log D "Reducing filecol width from $wid to $maxcolwid"
    $flist configure -width $maxcolwid
  }
  $flist configure -xscrollcommand "$w.filecol.xscroll set"

  set wid [font measure $cvscfg(listboxfont) -displayof $w $longstat]
  set DirList($w:statcolwidth) [expr {$wid + 6}]
  gen_log:log D "statcol width $DirList($w:statcolwidth)"
  if {$wid < $maxcolwid} {
    $w.statcol.list configure -width $DirList($w:statcolwidth)
  } else {
    gen_log:log D "Reducing statcol width from $wid to $maxcolwid"
    $w.statcol.list configure -width $maxcolwid
  }
  $w.statcol.list configure -xscrollcommand "$w.statcol.xscroll set"

  set wid [font measure $cvscfg(listboxfont) -displayof $w $longdate]
  set DirList($w:datecolwidth) [expr {$wid + 6}]
  if {$wid < $maxcolwid} {
    $w.datecol.list configure -width $DirList($w:datecolwidth)
  } else {
    gen_log:log D "Reducing datecol width from $wid to $maxcolwid"
    $w.datecol.list configure -width $maxcolwid
  }
  $w.datecol.list configure -xscrollcommand "$w.datecol.xscroll set"


  if {$incvs || $insvn || $inrcs} {
    set wid [font measure $cvscfg(listboxfont) -displayof $w $longtag]
    set DirList($w:revcolwidth) [expr {$wid + 6}]
    gen_log:log D "width of $w.wrevcol $maxtag chars ($wid)"
    # Don't let the column be too wide.
    if {$wid < $maxcolwid} {
      $w.wrevcol.list configure -width $DirList($w:revcolwidth)
    } else {
      gen_log:log D "Reducing wrevcol width from $wid to $maxcolwid"
      $w.wrevcol.list configure -width $maxcolwid
    }
    $w.wrevcol.list configure -xscrollcommand "$w.wrevcol.xscroll set"

    set wid [font measure $cvscfg(listboxfont) -displayof $w $longed]
    set DirList($w:edcolwidth) [expr {$wid + 6}]
    gen_log:log D "width of $w.editcol $maxed chars ($wid)"
    if {$wid < $maxcolwid} {
      $w.editcol.list configure -width $DirList($w:edcolwidth)
    } else {
      gen_log:log D "Reducing editcol width from $wid to $maxcolwid"
      $w.editcol.list configure -width $maxcolwid
    }
    $w.editcol.list configure -xscrollcommand "$w.editcol.xscroll set"
  }

  # Scroll to the top of the lists
  set fbbox [$flist bbox all]
  #gen_log:log D "fbbox   \"$fbbox\""
  if {[llength $fbbox] == 4} {
    set ylen [expr {[lindex $fbbox 3] - [lindex $fbbox 1]}]

    set wview [winfo height $flist]
    $w.yscroll set 0 [expr ($wview * 1.0) / ($ylen * 1.0)]

    $flist config -scrollregion $fbbox
    $flist yview moveto 0

    if {$cvscfg(showdatecol)} {
      set fbbox [$w.datecol.list bbox all]
      set botx [lindex $fbbox 0]
      set boty [lindex $fbbox 1]
      $w.datecol.list config -scrollregion \
        [list $botx $boty \
          [expr {$botx + $DirList($w:datecolwidth)}] \
          [expr {$boty + $ylen}]]
      $w.datecol.list yview moveto 0
    }

    if {$incvs || $insvn || $inrcs} {
      set fbbox [$w.wrevcol.list bbox all]
      set botx [lindex $fbbox 0]
      set boty [lindex $fbbox 1]
      $w.wrevcol.list config -scrollregion \
        [list $botx $boty \
          [expr {$botx + $DirList($w:revcolwidth)}] \
          [expr {$boty + $ylen}]]
      $w.wrevcol.list yview moveto 0

      if {$cvscfg(showstatcol)} {
        set fbbox [$w.statcol.list bbox all]
        set botx [lindex $fbbox 0]
        set boty [lindex $fbbox 1]
        $w.statcol.list config -scrollregion \
          [list $botx $boty \
            [expr {$botx + $DirList($w:statcolwidth)}] \
            [expr {$boty + $ylen}]]
        $w.statcol.list yview moveto 0
      }

      if {$cvscfg(showeditcol)} {
        set fbbox [$w.editcol.list bbox all]
        set botx [lindex $fbbox 0]
        set boty [lindex $fbbox 1]
        $w.editcol.list config -scrollregion \
          [list $botx $boty \
            [expr {$botx + $DirList($w:edcolwidth)}] \
            [expr {$boty + $ylen}]]
        $w.editcol.list yview moveto 0
      }
    }
  }
  # Reset the scrollbar.  Otherwise it fills the trough
  DirCanvas:scroll_windows $w scroll 0 units
  #gen_log:log D "[array names DirList $w:*:selected]"
  gen_log:log T "LEAVE"
}

# Internal use only
# Call DirCanvas:build the next time we're idle
proc DirCanvas:buildwhenidle {w} {
  global DirList

  if {![info exists DirList($w:buildpending)]} {
    set DirList($w:buildpending) 1
    after idle "DirCanvas:build $w"
  }
}

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

  #gen_log:log T "ENTER ($w $args)"
  set way [lindex $args 1]
  set units [lindex $args 2]
  set yget [$w.yscroll get]
  set first [lindex $yget 0]
  set last [lindex $yget 1]
  # If you dont do this, the scrollbar fills the whole trough when
  # you page past the top or bottom with the arrow keys
  case $units {
    {units pages} {
      if {$way < 0} {
        if {$first == 0} {
          return
        }
      } else {
        if {$last == 1} {
          return
        }
      }
    }
  }
  eval $w.filecol.list yview $args
  if {$cvscfg(showdatecol)} {
    eval $w.datecol.list yview $args
  }
  if {$incvs || $insvn || $inrcs} {
    eval $w.wrevcol.list yview $args
    if {$cvscfg(showstatcol)} {
      eval $w.statcol.list yview $args
    }
    if {$cvscfg(showeditcol)} {
      eval $w.editcol.list yview $args
    }
  }
}

proc DirCanvas:drag_windows {w W y} {
#Scrolling caused by dragging
  global incvs
  global insvn
  global inrcs
  global cvscfg
  global cvsglb

  set height [$W cget -height]
  #gen_log:log D "$w %y $height"
  if {$y < 0} {set y 0}
  if {$y > $height} {set y $height}
  set yfrac [expr {double($y) / $height}]

  eval $w.filecol.list yview moveto $yfrac
  if {$cvscfg(showdatecol)} {
    eval $w.datecol.list yview moveto $yfrac
  }
  if {$incvs || $insvn || $inrcs} {
    eval $w.wrevcol.list yview moveto $yfrac
    if {$cvscfg(showstatcol)} {
      eval $w.statcol.list yview moveto $yfrac
    }
    if {$cvscfg(showeditcol)} {
      eval $w.editcol.list yview moveto $yfrac
    }
  }
}

proc DirCanvas:sort_by_col {w col sense} {
  global DirList
  global cvsglb
  global arr

  gen_log:log T "ENTER ($w $col $sense)"
  foreach a [array names arr] {
    catch "$arr($a) configure -image arr_dn"
  }
  set cvsglb(sort_pref) [list $col $sense]

  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"
    $arr($col) configure -image arh_dn
    if {$col == "statcol"} {$arr(filestatcol) configure -image arh_dn}
  }
  if {$col != "statcol"} {
    $arr(filestatcol) configure -image arr_dn
  }

  gen_log:log D "  $cvsglb(sort_pref)"

  DirCanvas:build $w
  gen_log:log T "LEAVE"
}

proc DirCanvas:toggle_col {w col} {
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER ($col)"
  set cur_col [lindex $cvsglb(sort_pref) 0]
  set cur_sense [lindex $cvsglb(sort_pref) 1]

  if {$col == $cur_col} {
    # if it's the currently sorted column, reverse the direction.
    if {[string match "-incr*" $cur_sense]} {
      set sense "-decreasing"
    } else {
      set sense "-increasing"
    }
  } else {
    # Otherwise, default to decreasing (down)
    set sense "-decreasing"
  }

  gen_log:log D "sort column $col $sense"
  DirCanvas:sort_by_col $w $col $sense

  gen_log:log T "LEAVE"
}

proc DirCanvas:makepopup {w} {
#
# Context-sensitive popups for list items
# We build them all at once here, then bind canvas items to them as appropriate
#
  gen_log:log T "ENTER ($w)"

  # For plain files in an un-versioned directory
  menu $w.paper_pop -tearoff 0
  $w.paper_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.paper_pop add command -label "Delete Locally" \
    -command { workdir_delete_file [workdir_list_files] }

  # For plain directories in an un-versioned directory
  menu $w.folder_pop -tearoff 0
  $w.folder_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.folder_pop add command -label "Delete Locally" \
    -command { workdir_delete_file [workdir_list_files] }

  # For plain directories in CVS
  menu $w.incvs_folder_pop -tearoff 0
  $w.incvs_folder_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.incvs_folder_pop add command -label "CVS Add Recursively" \
    -command { addir_dialog [workdir_list_files] }
  $w.incvs_folder_pop add command -label "Delete Locally" \
    -command { workdir_delete_file [workdir_list_files] }

  # For CVS directories when cwd is in CVS
  menu $w.cvscvs_pop -tearoff 0
  $w.cvscvs_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.cvscvs_pop add command -label "CVS Remove Recursively" \
    -command { subtractdir_dialog [workdir_list_files] }

  # For CVS directories when cwd isn't in CVS
  menu $w.cvsdir_pop -tearoff 0
  $w.cvsdir_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.cvsdir_pop add command -label "CVS Release" \
    -command { release_dialog [workdir_list_files] }

  # For CVS files
  menu $w.stat_cvsok_pop -tearoff 0
  $w.stat_cvsok_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.stat_cvsok_pop add command -label "Browse the Log Diagram" \
    -command { cvs_branches [workdir_list_files] }
  $w.stat_cvsok_pop add command -label "CVS Annotate/Blame" \
    -command { cvs_annotate $current_tagname [workdir_list_files] }
  $w.stat_cvsok_pop add command -label "CVS Remove" \
    -command { subtract_dialog [workdir_list_files] }
  $w.stat_cvsok_pop add command -label "Set Binary Flag" \
     -command { cvs_binary [workdir_list_files] }
  $w.stat_cvsok_pop add command -label "Unset Binary Flag" \
     -command { cvs_ascii [workdir_list_files] }

  # For CVS files that are not up-to-date
  menu $w.needsupdate_pop -tearoff 0
  $w.needsupdate_pop add command -label "Update" \
    -command { \
        cvs_update {BASE} {Normal} {Remove} {No} { } [workdir_list_files] }
  $w.needsupdate_pop add command -label "Update with Options" \
    -command update_run

  # For CVS files that need merging
  menu $w.stat_merge_pop -tearoff 0
  $w.stat_merge_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.stat_merge_pop add command -label "Diff" \
    -command { comparediff [workdir_list_files] }
  $w.stat_merge_pop add command -label "CVS Annotate/Blame" \
    -command { cvs_annotate $current_tagname [workdir_list_files] }
  $w.stat_merge_pop add command -label "Browse the Log Diagram" \
    -command { cvs_branches [workdir_list_files] }

  # For CVS files that are modified
  menu $w.stat_mod_pop -tearoff 0
  $w.stat_mod_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.stat_mod_pop add command -label "Diff" \
    -command { comparediff [workdir_list_files] }
  $w.stat_mod_pop add command -label "Commit" \
    -command { cvs_commit_dialog }
  $w.stat_mod_pop add command -label "Revert" \
    -command { cvs_revert [workdir_list_files] }

  # For CVS files that have been added or removed but not commited
  menu $w.stat_plus_pop -tearoff 0
  $w.stat_plus_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.stat_plus_pop add command -label "Commit" \
    -command { cvs_commit_dialog }

  # For CVS files with conflicts
  menu $w.stat_conf_pop -tearoff 0
  $w.stat_conf_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.stat_conf_pop add command -label "Merge Conflict" \
    -command { cvs_merge_conflict [workdir_list_files] }
  $w.stat_conf_pop add command -label "CVS Annotate/Blame" \
    -command { cvs_annotate $current_tagname [workdir_list_files] }
  $w.stat_conf_pop add command -label "Browse the Log Diagram" \
    -command { cvs_branches [workdir_list_files] }

  # For RCS files
  menu $w.rcs_pop -tearoff 0
  $w.rcs_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.rcs_pop add command -label "Browse the Log Diagram" \
    -command { rcs_branches [workdir_list_files] }
  $w.rcs_pop add command -label "RCS Lock" \
    -command { rcs_lock lock [workdir_list_files] }
  $w.rcs_pop add command -label "RCS Unlock" \
    -command { rcs_lock unlock [workdir_list_files] }
  $w.rcs_pop add command -label "Delete Locally" \
    -command { workdir_delete_file [workdir_list_files] }
  $w.rcs_pop add command -label "Revert" \
    -command { rcs_revert [workdir_list_files] }

  # For SVN files
  menu $w.stat_svnok_pop -tearoff 0
  $w.stat_svnok_pop add command -label "Edit" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.stat_svnok_pop add command -label "SVN Log" \
    -command { svn_log [workdir_list_files] }
  $w.stat_svnok_pop add command -label "Browse the Log Diagram" \
    -command { svn_branches [workdir_list_files] }
  $w.stat_svnok_pop add command -label "SVN Annotate/Blame" \
    -command { svn_annotate "" [workdir_list_files] }
  $w.stat_svnok_pop add command -label "Revert" \
    -command { svn_revert [workdir_list_files] }
  $w.stat_svnok_pop add command -label "SVN Remove" \
    -command { subtract_dialog [workdir_list_files] }

  # For SVN directories
  menu $w.svnfolder_pop -tearoff 0
  $w.svnfolder_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.svnfolder_pop add command -label "SVN Log" \
    -command { svn_log [workdir_list_files] }
  $w.svnfolder_pop add command -label "Browse the Log Diagram" \
    -command { svn_branches [workdir_list_files] }
  $w.svnfolder_pop add command -label "SVN Remove" \
    -command { subtract_dialog [workdir_list_files] }

  # For SVN directories
  menu $w.svndir_pop -tearoff 0
  $w.svndir_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }
  $w.svndir_pop add command -label "SVN Log" \
    -command { svn_log [workdir_list_files] }

  # For RCS directories
  menu $w.rcsdir_pop -tearoff 0
  $w.rcsdir_pop add command -label "Descend" \
    -command { workdir_edit_file [workdir_list_files] }

  gen_log:log T "LEAVE"
}

proc DirCanvas:popup {w y X Y f} {
  global DirList

  gen_log:log T "ENTER ($w $y $X $Y $f)"
  set parent [winfo parent [winfo parent $w]]
  DirCanvas:setselection $parent $y $f
  tk_popup $parent.$DirList($parent:$f:popup) $X $Y
  gen_log:log T "LEAVE"
}