dircanvas.tcl

TKCVS Source Code For CVS。

    }
  }

  DirCanvas:setTextHBox $w $w.filecol.list.tx$y
  set DirList($w:$f:selected) 1
  if {[lsearch -exact $DirList($w:selection) $f] == -1} {
    lappend DirList($w:selection) "$f"
  }

  set cvsglb(current_selection) $DirList($w:selection)
  gen_log:log D "selection is \"$cvsglb(current_selection)\""
  gen_log:log T "LEAVE"
}

proc DirCanvas:unselectall {w force} {
  global DirList
  global cvsglb

  gen_log:log T "ENTER ($w)"
  # Don't clear unless we aren't over anything
  if { $force || [ $w.filecol.list gettags current ] == "" } {
    foreach s [array names DirList $w:*:name] {
      set f $DirList($s)
      set y $DirList($w:$f:y)
      set DirList($w:$f:selected) 0
      DirCanvas:clearTextHBox $w $w.filecol.list.tx$y
      # Prepending ./ to the filename prevents tilde expansion
      #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)
      #}
    }
    set DirList($w:selection) {}
    set cvsglb(current_selection) {}
  }
  gen_log:log T "LEAVE"
}

proc DirCanvas:areaStart {w x y} {
  global areaX1 areaY1
  global areaX2 areaY2

  gen_log:log T "ENTER ($w $x $y)"
  $w delete area
  set areaX1 [$w canvasx $x]
  set areaY1 [$w canvasy $y]
  set areaX2 $areaX1
  set areaY2 $areaY1
}

proc DirCanvas:areaStroke {w x y} {
  global areaX1 areaY1
  global areaX2 areaY2
  global cvsglb
  global cvscfg

  set x [$w canvasx $x]
  set y [$w canvasy $y]
  if {$areaY1 != $y && $areaX1 != $x} {
    $w delete area
    $w addtag area withtag \
      [$w create rect $areaX1 $areaY1 $x $y -outline $cvsglb(glb_highlight)]
    set areaX2 $x
    set areaY2 $y
  }
}

proc DirCanvas:areaFind {w} {
  global areaX1 areaY1
  global areaX2 areaY2
  global DirList

  gen_log:log T "ENTER ($w)"
  gen_log:log D "$areaX1 $areaY1 $areaX2 $areaY2"
  set items {}
  foreach i [$w find enclosed $areaX1 $areaY1 $areaX2 $areaY2] {
    lappend items $i
  }
  foreach i [$w find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
      lappend items $i
  }
  gen_log:log D "Items in area: $items"
  set parent [winfo parent [winfo parent $w]]
  foreach i $items {
    set itags [$w gettags $i]
    if { [string match .workdir* [lindex $itags 0]]  } {
      set iy [lindex $itags 1]
      gen_log:log D "$w tx$iy"
      DirCanvas:addselection $parent $iy [lindex $itags 2]
    }
  }
  $w delete area
}

# Internal use only.
# Draw the files on the canvas
proc DirCanvas:build {w} {
  global DirList
  global Filelist
  global cvscfg
  global cvsglb
  global incvs
  global insvn
  global inrcs

  gen_log:log T "ENTER ($w)"
  set flist $w.filecol.list
  foreach b [winfo children $flist] {
    destroy $b
  }
  $flist delete all
  $w.statcol.list delete all
  $w.datecol.list delete all
  $w.wrevcol.list delete all
  $w.editcol.list delete all
  catch {unset DirList($w:buildpending)}

  set x 3
  set lblx 21
  set y 20
  set imy [expr {[image height paper] + 2}]
  set fy [font metrics $cvscfg(listboxfont) -displayof $flist -linespace]
  set fy [expr {$fy + 2}]
  if {$imy > $fy} {
    set yincr $imy
    gen_log:log D "Y spacing: $y set from icon"
  } else {
    set yincr $fy
    gen_log:log D "Y spacing: $y set from font"
  }

  set maxlbl 0; set longlbl ""
  set maxstat 0; set longstat ""
  set maxdate 0; set longdate ""
  set maxtag 0; set longtag ""
  set maxed 0; set longed ""

  set sortcol [lindex $cvsglb(sort_pref) 0]
  set sortsense [lindex $cvsglb(sort_pref) 1]
  if { (!($incvs || $inrcs))  && ( $sortcol == "editcol" || $sortcol == "wrevcol") } {
    gen_log:log T "setting sort to column \"filecol!\""
    set sortcol "filecol"
    set sortsense "-decreasing"
  }

  set rtype ""
  if {$inrcs} {
    set rtype "RCS"
  } elseif {$incvs} {
    set rtype "CVS"
  } elseif {$insvn} {
    set rtype "SVN"
  }
  gen_log:log D "Directory Type: $rtype"

  gen_log:log D "sortcol=$sortcol  sortsense=$sortsense"

  set AllColumns {}
  foreach k [array names DirList $w:*:name] {
    set key $DirList($k)
    set DirList($w:$k:allcolumns) [list $key $DirList($w:$key:status) \
      $DirList($w:$key:date) $DirList($w:$key:sticky) $DirList($w:$key:editors)]
    lappend AllColumns $DirList($w:$k:allcolumns)
  }

  set itemlist {}
  # Always sort by name first
  set sortedlist [lsort $sortsense -index 0 $AllColumns]
  switch -- $sortcol {
   "filecol" {
    # Only by name
   }
   "statcol" {
    set sortedlist [lsort $sortsense -index 1 $sortedlist]
   }
   "datecol" {
    set sortedlist [lsort $sortsense -index 2 $sortedlist]
   }
   "wrevcol" {
    set sortedlist [lsort -dictionary $sortsense -index 3 $sortedlist]
   }
   "editcol" {
    set sortedlist [lsort $sortsense -index 4 $sortedlist]
   }
  }

  # Create items.
  foreach item $sortedlist {
    set f [lindex $item 0]
    set flen [string length $f]
    if {$flen > $maxlbl} {
      set maxlbl $flen
      set longlbl $f
    }
    incr y -$yincr
    set lblfg $cvsglb(fg)

    # Up-to-date
    #  The file is identical with the latest revision in the repository for the
    #    branch in use
    # Locally Modified
    #  You have edited the file, and not yet committed your changes.
    # Locally Added
    #  You have added the file with add, and not yet committed your changes.
    # Locally Removed
    #  You have removed the file with remove, and not yet committed your changes
    # Needs Checkout
    #  Someone else has committed a newer revision to the repository. The name
    #    is slightly misleading; you will ordinarily use update rather than
    #    checkout to get that newer revision.
    # Needs Patch
    #  Like Needs Checkout, but the CVS server will send a patch rather than the
    #    entire file. Sending a patch or sending an entire file accomplishes
    #    the same thing.
    # Needs Merge
    #  Someone else has committed a newer revision to the repository, and you
    #    have also made modifications to the file.
    # Unresolved Conflict
    #  This is like Locally Modified, except that a previous update command gave
    #    a conflict. You need to resolve the conflict as described in section
    #    Conflicts example.
    # Unknown
    #  CVS doesn't know anything about this file. For example, you have created
    #     a new file and have not run add.

    # Prepending ./ to the filename prevents tilde expansion
    #if {! [file exists ./$f]} {
      # If a file CVS knows about doesn't exist, write its name in light ink
      #set lblfg $cvsglb(dfg)
    #}

    switch -glob -- $DirList($w:$f:status) {
     "<file>" {
       set DirList($w:$f:icon) paper
       set DirList($w:$f:popup) paper_pop
      }
     "<dir> " {
       set DirList($w:$f:icon) folder
       set DirList($w:$f:popup) svnfolder_pop
     }
     "<dir> Up-to-date" {
       set DirList($w:$f:icon) dir_ok
       set DirList($w:$f:popup) svnfolder_pop
     }
     "<dir> Not managed*" {
       set DirList($w:$f:icon) dir_ques
       set DirList($w:$f:popup) svnfolder_pop
     }
     "<dir> Locally Added" {
       set DirList($w:$f:icon) dir_plus
       set DirList($w:$f:popup) svnfolder_pop
     }
     "<dir> Locally Removed" {
       set DirList($w:$f:icon) dir_minus
       set DirList($w:$f:popup) svnfolder_pop
     }
     "<directory>" {
       set DirList($w:$f:icon) folder
       switch -- $rtype {
         "CVS" {
            set DirList($w:$f:popup) incvs_folder_pop
          }
          default {
            set DirList($w:$f:popup) folder_pop
          }
        }
      }
     "<directory:CVS>" {
       set DirList($w:$f:icon) cvsdir
       switch -- $rtype {
         "CVS" {
            set DirList($w:$f:popup) cvscvs_pop
          }
          default {
            set DirList($w:$f:popup) cvsdir_pop
          }
        }
      }
     "<directory:SVN>" {
       set DirList($w:$f:icon) svndir
       set DirList($w:$f:popup) svndir_pop
      }
     "<directory:RCS>" {
       set DirList($w:$f:icon) rcsdir
       set DirList($w:$f:popup) rcsdir_pop
      }
     "Up-to-date" {
       set DirList($w:$f:icon) stat_ok
       switch -- $rtype {
          "CVS" {
            set DirList($w:$f:popup) stat_cvsok_pop
            if {[string match "*-kb*" $DirList($w:$f:option)]} {
              set DirList($w:$f:icon) stat_kb
            }
          }
          "SVN" {
            set DirList($w:$f:popup) stat_svnok_pop
          }
          default {
            set DirList($w:$f:popup) paper_pop
          }
        }
      }
     "Missing*" {
        set DirList($w:$f:icon) stat_ex
        set DirList($w:$f:popup) needsupdate_pop
      }
     "Needs Checkout" {
       # Prepending ./ to the filename prevents tilde expansion
       if {[file exists ./$f]} {
         set DirList($w:$f:icon) stat_ood
        } else {
         set DirList($w:$f:icon) stat_ex
        }
        set DirList($w:$f:popup) needsupdate_pop
      }
      "Needs Patch" {
       set DirList($w:$f:icon) stat_ood
       set DirList($w:$f:popup) needsupdate_pop
      }
      "Out-of-date" {
       set DirList($w:$f:icon) stat_ood
       set DirList($w:$f:popup) needsupdate_pop
      }
      "Needs Merge" {
       set DirList($w:$f:icon) stat_merge
       set DirList($w:$f:popup) stat_merge_pop
      }
      "Locally Modified" {
       set DirList($w:$f:icon) stat_mod
       set DirList($w:$f:popup) stat_mod_pop
      }
      "Locally Added" {
       set DirList($w:$f:icon) stat_plus
       set DirList($w:$f:popup) stat_plus_pop
       if {[string match "*-kb*" $DirList($w:$f:option)]} {
         set DirList($w:$f:icon) stat_plus_kb
       }
      }
      "Locally Removed" {
       set DirList($w:$f:icon) stat_minus
       set DirList($w:$f:popup) stat_plus_pop
      }
      "*onflict*" {
       set DirList($w:$f:icon) stat_conf
       set DirList($w:$f:popup) stat_conf_pop
      }
      "Not managed*" {
       set DirList($w:$f:icon) stat_ques
       set DirList($w:$f:popup) paper_pop
      }
      "RCS Up-to-date" {
       set DirList($w:$f:icon) stat_ok
       set DirList($w:$f:popup) rcs_pop
      }
      "RCS Modified" {
       set DirList($w:$f:icon) stat_mod
       set DirList($w:$f:popup) rcs_pop
      }
      "RCS Needs Checkout" {
       set DirList($w:$f:icon) stat_ex
       set DirList($w:$f:popup) rcs_pop
      }
      default {
       set DirList($w:$f:icon) paper
       set DirList($w:$f:popup) paper_pop
      }
    }

    # Easy way to unselect everything by clicking in a blank area
    bind $flist <1> "DirCanvas:unselectall $w 0"
    bind $flist <Shift-1> " "

    bind $flist <2> "DirCanvas:areaStart $flist %x %y"
    bind $flist <B2-Motion> "DirCanvas:areaStroke $flist %x %y; \
                             DirCanvas:drag_windows $w %W %y"
    bind $flist <B2-Motion><ButtonRelease-2> "DirCanvas:unselectall $w 1; \
                                              DirCanvas:areaFind $flist"
    bind $flist <3> "DirCanvas:areaStart $flist %x %y"
    bind $flist <Shift-3> "DirCanvas:areaStart $flist %x %y"
    bind $flist <B3-Motion> "DirCanvas:areaStroke $flist %x %y; \
                             DirCanvas:drag_windows $w %W %y"
    bind $flist <B3-Motion><ButtonRelease-3> "DirCanvas:unselectall $w 1; \
                                              DirCanvas:areaFind $flist"
    # In the bindings, filenames need any single percents replaced with
    # double to avoid interpretation as an event field
    regsub -all {\%} $f {%%} fn
    regsub -all {\$} $fn {\$} fn

    # The "x" tag is used for area selection.
    # Draw the icon
     set k [$flist create image $x $y -image $DirList($w:$f:icon) \
       -anchor w -tags [list x $y] ]
     $flist bind $k <1> "DirCanvas:setselection $w $y \"$fn\""
     $flist bind $k <Shift-1> "DirCanvas:addrange $w $y \"$fn\""
     $flist bind $k <Control-1> "DirCanvas:addselection $w $y \"$fn\""
     $flist bind $k <Double-1> {workdir_edit_file [workdir_list_files]}
     $flist bind $k <2> "DirCanvas:areaStart $flist %x %y; \
                         DirCanvas:popup $flist $y %X %Y \"$fn\""
     $flist bind $k <3> "DirCanvas:areaStart $flist %x %y; \
                         DirCanvas:popup $flist $y %X %Y \"$fn\""

    # Draw the label
     $flist create text $lblx $y  -text $f -font $cvscfg(listboxfont) \
       -anchor w -tags [list $flist.tx$y $y $fn] -fill $lblfg
     $flist bind $flist.tx$y <1> "DirCanvas:setselection $w $y \"$fn\""
     $flist bind $flist.tx$y <Shift-1> "DirCanvas:addrange $w $y \"$fn\""
     $flist bind $flist.tx$y <Enter> "DirCanvas:flash $w $y"
     $flist bind $flist.tx$y <Leave> "DirCanvas:unflash $w $y \"$fn\""
     $flist bind $flist.tx$y <Control-1> "DirCanvas:addselection $w $y \"$fn\""
     $flist bind $flist.tx$y <Double-1> {workdir_edit_file [workdir_list_files]}
     $flist bind $flist.tx$y <2> "DirCanvas:areaStart $flist %x %y; \
                                  DirCanvas:popup $flist $y %X %Y \"$fn\""
     $flist bind $flist.tx$y <3> "DirCanvas:areaStart $flist %x %y; \
                                  DirCanvas:popup $flist $y %X %Y \"$fn\""

    set DirList($w:$f:y) $y
    set DirList($flist:$y) $f

    set status $DirList($w:$f:status)
    set k [$w.statcol.list create text 8 $y -fill $cvsglb(fg) \
       -text $status -font $cvscfg(listboxfont) -anchor w]
    set slen [string length $status]
    if {$slen > $maxstat} {
      set maxstat $slen
      set longstat $status
    }

    set date $DirList($w:$f:date)
    set k [$w.datecol.list create text 4 $y -fill $cvsglb(fg) \
       -text $date -font $cvscfg(listboxfont) -anchor w]
    set dlen [string length $date]
    if {$dlen > $maxdate} {
      set maxdate $dlen
      set longdate $date
    }

    if {[info exists DirList($w:$f:sticky)]} {
      set tag $DirList($w:$f:sticky)
      set k [$w.wrevcol.list create text 4 $y -fill $cvsglb(fg) \
         -text $tag -font $cvscfg(listboxfont) -anchor w]
      set tlen [string length $tag]
      if {$tlen > $maxtag} {
        set maxtag $tlen
        set longtag $tag
      }
    }

    set editors $DirList($w:$f:editors)
    set k [$w.editcol.list create text 4 $y -fill $cvsglb(fg) \
       -text $editors -font $cvscfg(listboxfont) -anchor w]
    set edlen [string length $editors]
    if {$edlen > $maxed} {
      set maxed $edlen
      set longed $editors
    }
  }

  # See which optional columns we need to draw
  if {$incvs || $insvn || $inrcs} {
    if {$cvscfg(showstatcol)} {