branch_diagram.tcl

TKCVS Source Code For CVS。

      $logcanvas.menubar.view.update add radiobutton -label "Every Revision" \
        -selectcolor $selcolor \
        -variable [namespace current]::opt(update_drawing) -value 0
      $logcanvas.menubar.view.update add radiobutton -label "Every Branch" \
        -selectcolor $selcolor \
        -variable [namespace current]::opt(update_drawing) -value 1
      $logcanvas.menubar.view.update add radiobutton -label "When Finished" \
        -selectcolor $selcolor \
        -variable [namespace current]::opt(update_drawing) -value 2
      $logcanvas.menubar.view add separator
      $logcanvas.menubar.view add cascade -label "Tree Layout" \
        -menu $logcanvas.menubar.view.tree
      menu $logcanvas.menubar.view.tree
      $logcanvas.menubar.view.tree add checkbutton -label \
        "Show empty branches" \
        -variable [namespace current]::opt(show_empty_branches) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.tree add checkbutton -label \
        "Show intermediate revisions" \
        -variable [namespace current]::opt(show_inter_revs) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.tree add checkbutton -label \
        "Show merges" \
        -variable [namespace current]::opt(show_merges) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view add cascade -label "Branch Layout" \
        -menu $logcanvas.menubar.view.branch
      menu $logcanvas.menubar.view.branch
      $logcanvas.menubar.view.branch add command -label "Turn all options on" \
        -command [namespace code {
          set opt(show_root_rev) [set opt(show_root_tags) 1]
          DrawTree
        }]
      $logcanvas.menubar.view.branch add command -label "Turn all options off" \
        -command [namespace code {
          set opt(show_root_rev) [set opt(show_root_tags) 0]
          DrawTree
        }]
      $logcanvas.menubar.view.branch add separator
      $logcanvas.menubar.view.branch add checkbutton -label "Show revision" \
        -variable [namespace current]::opt(show_root_rev) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.branch add checkbutton -label "Show label" \
        -variable [namespace current]::opt(show_root_tags) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view add cascade -label "Revision Layout" \
        -menu $logcanvas.menubar.view.rev
      menu $logcanvas.menubar.view.rev
      $logcanvas.menubar.view.rev add command -label "Turn all options on" \
        -command [namespace code {
          set opt(show_tags) [\
          set opt(show_box_rev) [\
          set opt(show_box_revwho) [\
          set opt(show_box_revdate) [\
          set opt(show_box_revtime) 1]]]]
          DrawTree
        }]
      $logcanvas.menubar.view.rev add command -label "Turn all options off" \
        -command [namespace code {
          set opt(show_tags) [\
          set opt(show_box_rev) [\
          set opt(show_box_revwho) [\
          set opt(show_box_revdate) [\
          set opt(show_box_revtime) 0]]]]
          DrawTree
        }]
      $logcanvas.menubar.view.rev add separator
      $logcanvas.menubar.view.rev add checkbutton -label "Show tags" \
        -variable [namespace current]::opt(show_tags) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.rev add checkbutton -label "Show revision" \
        -variable [namespace current]::opt(show_box_rev) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.rev add checkbutton -label "Show author" \
        -variable [namespace current]::opt(show_box_revwho) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.rev add checkbutton -label "Show date" \
        -variable [namespace current]::opt(show_box_revdate) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view.rev add checkbutton -label "Show time" \
        -variable [namespace current]::opt(show_box_revtime) \
        -onvalue 1 -offvalue 0 \
        -selectcolor $selcolor \
        -command [namespace code { DrawTree }]
      $logcanvas.menubar.view add separator
      $logcanvas.menubar.view add cascade -label "Size" \
        -menu $logcanvas.menubar.view.size
      menu $logcanvas.menubar.view.size
      foreach {label factor} $logcfg(scaling_options) {
        $logcanvas.menubar.view.size add radiobutton -label $label \
          -variable [namespace current]::opt(scale) -value $factor \
          -selectcolor $selcolor \
          -command [namespace code { DrawTree }]
      }
      $logcanvas.menubar.view add separator
      $logcanvas.menubar.view add command -label "Save options" \
        -command [namespace code {
          SaveOptions
        }]
      menu_std_help $logcanvas.menubar
      if {$tcl_platform(platform) != "windows"} {
        wm iconbitmap $logcanvas @$cvscfg(bitmapdir)/branch.xbm
      }
      wm protocol $logcanvas WM_DELETE_WINDOW \
        [namespace code {$logcanvas.close invoke}]
      frame $logcanvas.up -relief groove -border 2
      set textfont $cvscfg(listboxfont)
      set disbg [lindex [$logcanvas.up configure -background] 4]
      label $logcanvas.up.lfname -width 12 -anchor w
      entry $logcanvas.up.rfname -font $textfont -relief groove \
        -readonlybackground $cvsglb(readonlybg)
        
      button $logcanvas.up.bmodbrowse -image Modules -command modbrowse_run
      button $logcanvas.up.bworkdir -image Workdir -command { workdir_setup }
      pack $logcanvas.up -side top -fill x
      foreach fm {A B} {
        label $logcanvas.up.rev${fm}_lvers -text "Revision $fm"
        label $logcanvas.up.rev${fm}_rvers -text {} \
           -anchor w -font $textfont
  
        label $logcanvas.up.rev${fm}_ldate -text "Committed"
        label $logcanvas.up.rev${fm}_rdate -text {} \
           -anchor w -font $textfont
        label $logcanvas.up.rev${fm}_lwho -text " by "
        label $logcanvas.up.rev${fm}_rwho -text {} \
           -anchor w -font $textfont
        label $logcanvas.up.log${fm}_lcomment -text "Log $fm"
         
        frame $logcanvas.up.log${fm}_rlogfm -bd 3 -bg $cvscfg(colour$fm)
        text  $logcanvas.up.log${fm}_rlogfm.rcomment -height 5 \
           -fg $cvsglb(textfg) -bg $cvsglb(textbg)\
           -yscrollcommand [namespace code\
           "$logcanvas.up.log${fm}_rlogfm.yscroll set"]
           scrollbar $logcanvas.up.log${fm}_rlogfm.yscroll \
           -command [namespace code\
           "$logcanvas.up.log${fm}_rlogfm.rcomment yview"]
      }
      grid columnconf $logcanvas.up 5 -weight 1
      grid $logcanvas.up.lfname -column 0 -row 0 -sticky nw
      grid $logcanvas.up.rfname -column 1 -row 0 -columnspan 5 -sticky ew
      grid $logcanvas.up.bworkdir -column 6 -row 0 -rowspan 2 -sticky e\
        -padx 2 -pady 1
      grid $logcanvas.up.bmodbrowse -column 7 -row 0 -rowspan 2 -sticky e\
        -padx 2 -pady 1
      grid $logcanvas.up.revA_lvers -column 0 -row 1 -sticky w
      grid $logcanvas.up.revA_rvers -column 1 -row 1 -sticky w
      grid $logcanvas.up.revA_ldate -column 2 -row 1 -sticky w
      grid $logcanvas.up.revA_rdate -column 3 -row 1 -sticky w
      grid $logcanvas.up.revA_lwho -column 4 -row 1 -sticky w
      grid $logcanvas.up.revA_rwho -column 5 -row 1 -sticky ew
      grid $logcanvas.up.logA_lcomment -column 0 -row 2 -sticky nw
      grid $logcanvas.up.logA_rlogfm -column 1 -row 2 -columnspan 7 -sticky ew
      pack $logcanvas.up.logA_rlogfm.yscroll -side right -fill y
      pack $logcanvas.up.logA_rlogfm.rcomment -side left -fill x -expand y
      grid $logcanvas.up.revB_lvers -column 0 -row 3 -sticky w
      grid $logcanvas.up.revB_rvers -column 1 -row 3 -sticky w
      grid $logcanvas.up.revB_ldate -column 2 -row 3 -sticky w
      grid $logcanvas.up.revB_rdate -column 3 -row 3 -sticky w
      grid $logcanvas.up.revB_lwho -column 4 -row 3 -sticky w
      grid $logcanvas.up.revB_rwho -column 5 -row 3 -sticky ew
      grid $logcanvas.up.logB_lcomment -column 0 -row 4 -sticky nw
      grid $logcanvas.up.logB_rlogfm -column 1 -row 4 -columnspan 7 -sticky ew
      pack $logcanvas.up.logB_rlogfm.yscroll -side right -fill y
      pack $logcanvas.up.logB_rlogfm.rcomment -side left -fill x -expand y
      # Pack the bottom before the middle so it doesnt disappear if
      # the window is resized smaller
      frame $logcanvas.down -relief groove -border 2
      pack $logcanvas.down -side bottom -fill x
      # The canvas for the big picture
      canvas $logcanvas.canvas -relief sunken -border 2 \
        -height 300 \
        -yscrollcommand [namespace code "$logcanvas.yscroll set"] \
        -xscrollcommand [namespace code "$logcanvas.xscroll set"]
      scrollbar $logcanvas.xscroll -relief sunken -orient horizontal \
        -command [namespace code "$logcanvas.canvas xview"]
      scrollbar $logcanvas.yscroll -relief sunken \
        -command [namespace code "$logcanvas.canvas yview"]
      #
      # Create buttons
      #
      frame $logcanvas.down.btnfm
      frame $logcanvas.down.closefm -relief groove -bd 2
      button $logcanvas.refresh -image Refresh \
        -command [namespace code {
                 $scope\::reloadLog
               }]
      button $logcanvas.view -image Fileview
      button $logcanvas.annotate -image Annotate
      button $logcanvas.diff -image Diff \
        -command [namespace code {
          comparediff_r [$logcanvas.up.revA_rvers cget -text] \
          [$logcanvas.up.revB_rvers cget -text] $logcanvas $filename
        }]
      button $logcanvas.delta -image Mergediff
      button $logcanvas.viewtags -image Tags \
        -command [namespace code {
                   variable revtags
                   variable revbtags
                   set taglist {}
                   foreach r [lsort -command sortrevs \
                       [concat [array names revtags] \
                               [array names revbtags]]] {
                     if [info exists revtags($r)] {
                       append taglist "$r: $revtags($r)\n"
                     } elseif [info exists revbtags($r)] {
                       append taglist "$r: $revbtags($r)\n"
                     }
                   }
                   view_output::new Tags $taglist
                 }]
      button $logcanvas.close -text "Close" \
        -command [namespace code {
                 global cvscfg
                 variable logcanvas
                 set cvscfg(loggeom) [wm geometry $logcanvas]
                 destroy $logcanvas
                 namespace delete [namespace current]
                 exit_cleanup 0
               }]
      pack $logcanvas.refresh \
        -in $logcanvas.down -side left \
        -ipadx 4 -ipady 4
      pack $logcanvas.down.btnfm -side left -fill y -expand 1
      pack $logcanvas.view \
           $logcanvas.annotate \
           $logcanvas.diff \
           $logcanvas.delta \
           $logcanvas.viewtags \
        -in $logcanvas.down.btnfm -side left \
        -ipadx 4 -ipady 4
      pack $logcanvas.down.closefm -side right
      pack $logcanvas.close \
        -in $logcanvas.down.closefm -side right \
        -fill both -expand 1

      set_tooltips $logcanvas.refresh \
        {"Re-read the log information"}
      set_tooltips $logcanvas.up.bworkdir \
        {"Open the Working Directory Browser"}
      set_tooltips $logcanvas.up.bmodbrowse \
        {"Open the Repository Browser"}
      set_tooltips $logcanvas.view \
        {"View a version of the file"}
      set_tooltips $logcanvas.annotate \
        {"View revision where each line was modified"}
      set_tooltips $logcanvas.diff \
        {"Compare two versions of the file"}
      set_tooltips $logcanvas.delta \
        {"Merge changes to current"}
      set_tooltips $logcanvas.viewtags \
        {"List all the file\'s tags"}
  
      #
      # Put the canvas on to the display.
      #
      pack $logcanvas.xscroll -side bottom -fill x -padx 1 -pady 1
      pack $logcanvas.yscroll -side right -fill y -padx 1 -pady 1
      pack $logcanvas.canvas -fill both -expand 1
      scrollbindings $logcanvas.canvas
  
      #
      # Window manager stuff.
      #
      wm minsize $logcanvas 1 1
      if {[info exists cvscfg(loggeom)]} {
        wm geometry $logcanvas $cvscfg(loggeom)
      }
  
      $logcanvas.canvas bind active <Enter> \
        "$logcanvas.canvas config -cursor hand2"
      $logcanvas.canvas bind active <Leave> \
        "$logcanvas.canvas config -cursor {}"
  

      $logcanvas.canvas bind tag <Button-1> \
        [namespace code "PopupTags %X %Y"]

      $logcanvas.canvas bind box <ButtonPress-1> \
        [namespace code "RevSelect A"]
      # Tcl/TK for Windows doesn't do Button 3, so we duplicate it on Button 2
      $logcanvas.canvas bind box <ButtonPress-2> \
        [namespace code "RevSelect B"]
      $logcanvas.canvas bind box <ButtonPress-3> \
        [namespace code "RevSelect B"]

      # Clicking in a blank part of the canvas unselects boxes
      bind $logcanvas.canvas <ButtonPress-1> \
        [namespace code "Unselect A"]
      bind $logcanvas.canvas <ButtonPress-2> \
        [namespace code "Unselect B"]
      bind $logcanvas.canvas <ButtonPress-3> \
        [namespace code "Unselect B"]

      focus $logcanvas.canvas
      $logcanvas.canvas xview moveto 0
      $logcanvas.canvas yview moveto 0

      return [list [namespace current] $logcanvas]
    }
  }
}