dialog.tcl

TKCVS Source Code For CVS。

    set dynamic_dialog(outmode) 0
  } else {
    set dynamic_dialog(outmode) 1
  }
  set dynamic_dialog(outfile) "patchfile.patch"
  set dynamic_dialog(fullA) "$cvsroot$pathA"
  if {$pathB == ""} {
    set dynamic_dialog(fullB) ""
  } else {
    set dynamic_dialog(fullB) "$cvsroot$pathB"
  }

  # field  req type labeltext          data
  set dialog_form_patch {
  1         0     l {Repository Paths} 1
  pathA     1     t {Path A}           {}
  pathB     0     t {Path B}           {}
  3         0     l {Destination}      1
  outmode   0     r {Output Mode}      {{To Screen} 0 {To File} 1}
  outfile   0     t {Output File}      {outfile}
  4         0     l {Old Revision}     1
  revA      0     t {Revision}         {}
  dateA     0     t {Date}             {}
  5         0     l {New Revision}     1
  revB      0     t {Revision}         {}
  dateB     0     t {Date}             {}
  }
  # Action function
  set dialog_action {
    # Make new fullA and fullB from the pathA and pathB entries
    set dynamic_dialog(fullA) "$dynamic_dialog(cvsroot)/$dynamic_dialog(pathA)"
    if {$dynamic_dialog(pathB) == ""} {
      set dynamic_dialog(fullB) ""
    } else {
      set dynamic_dialog(fullB) "$dynamic_dialog(cvsroot)/$dynamic_dialog(pathB)"
    }
    svn_patch $dynamic_dialog(fullA) \
       $dynamic_dialog(fullB) \
       $dynamic_dialog(revA) $dynamic_dialog(dateA) \
       $dynamic_dialog(revB) $dynamic_dialog(dateB) \
       $dynamic_dialog(outmode) $dynamic_dialog(outfile)
  }

  set form [dialog_FormCreate "SVN Diff/Patch" $dialog_form_patch]
  gen_log:log T "LEAVE"
}

proc add_dialog {args} {
  global cvs
  global incvs
  global insvn

  gen_log:log T "ENTER ($args)"

  set binflag ""
  toplevel .add
  grab set .add

  set filelist [join $args]
  if {$filelist == ""} {
    set mess "This will add all new files"
  } else {
    set mess "This will add these files:\n\n"
    foreach file $filelist {
      append mess "   $file\n"
    }
  }

  message .add.top -justify left -aspect 300 -relief groove \
    -text "Add a file or files to the module.  The repository\
           will not be changed until you do a commit."
  pack .add.top -side top -fill x

  message .add.middle -text $mess -aspect 200
  pack .add.middle -side top -fill x
  frame .add.down
  button .add.down.add -text "Add"
  if {$incvs} {
    .add.down.add configure -command {
      grab release .add
      destroy .add
      cvs_add $binflag [workdir_list_files]
    }
    checkbutton .add.binary -text "-kb (binary)" \
       -variable binflag -onvalue "-kb" -offvalue ""
    pack .add.binary -side top
  } elseif {$insvn} {
    .add.down.add configure -command {
      grab release .add
      destroy .add
      svn_add [workdir_list_files]
    }
  }

  button .add.down.cancel -text "Cancel" \
    -command { grab release .add; destroy .add }
  pack .add.down -side bottom -fill x -expand 1
  pack .add.down.add .add.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .add "Add Files"
  wm minsize .add 1 1

  gen_log:log T "LEAVE"
}

proc merge_dialog { sys fromrev sincerev frombranch file } {
  global cvscfg
  global cvsglb
  global cvs
  global current_tagname

  gen_log:log T "ENTER ($sys \"$fromrev\" \"$sincerev\" \"$frombranch\" \"$file\")"

  if {$fromrev == {}} {
     cvsfail "You must specify a branch to merge from!"
     return
  }

  # Tag where we merged from
  if {[llength $current_tagname] == 1} {
    set curr_tag $current_tagname
  } else {
    set curr_tag "trunk"
  }

  if {$sincerev == {}} {
    set since "\"\""
    set mess "Merge revision $fromrev"
  } else {
    set mess "Merge the changes between revision $sincerev and $fromrev"
    append mess " (if $sincerev > $fromrev the changes are removed)"
  }
  append mess " to the current revision ($curr_tag)"

  # Construct tag names
  set totagbegin [string first "_BRANCH_" $cvscfg(mergetoformat)]
  set totagend [expr {$totagbegin + 8}]
  set toprefix [string range $cvscfg(mergetoformat) 0 [expr {$totagbegin - 1}]]
  set fromtagbegin [string first "_BRANCH_" $cvscfg(mergefromformat)]
  set fromprefix [string range $cvscfg(mergefromformat) 0 [expr {$fromtagbegin - 1}]]
  set datef [string range $cvscfg(mergetoformat) $totagend end]
  set today [clock format [clock seconds] -format "$datef"]

  set curr $curr_tag
  set from $frombranch
  if {$curr == "trunk"} {set curr $cvscfg(mergetrunkname)}
  if {$from == "trunk"} {set from $cvscfg(mergetrunkname)}
  set mtag "${toprefix}_${curr}_$today"
  set ftag "${fromprefix}_${from}_$today"
  # I had symbolic tags in mind, but some people are using untagged versions.
  # Substitute the dots, which are illegal for tagnames.
  regsub -all {\.} $mtag {-} mtag
  regsub -all {\.} $ftag {-} ftag

  toplevel .merge
  frame .merge.top

  message .merge.top.m1 -aspect 600 -text "$mess"
  frame .merge.top.f
  checkbutton .merge.top.f.fromtag \
    -text "Apply the tag" \
    -variable cvscfg(auto_tag)
  entry .merge.top.f.ent -textvariable mtag \
    -width 32 -relief groove \
    -readonlybackground $cvsglb(readonlybg)
  .merge.top.f.ent delete 0 end
  message .merge.top.m2 -aspect 600 -text "to revision $fromrev"
  frame .merge.bottom -relief raised -bd 2
  button .merge.bottom.apply -text "Apply"
  button .merge.bottom.ok -text "OK"
  button .merge.bottom.cancel -text "Cancel" \
     -command {destroy .merge}

  pack .merge.bottom -side bottom -expand 1 -fill x
  pack .merge.bottom.apply -side left -expand 1
  pack .merge.bottom.ok -side left -expand 1
  pack .merge.bottom.cancel -side left -expand 1

  pack .merge.top -side top -fill x
  pack .merge.top.m1 -side top -fill x -expand y


  switch -- $sys {
    "CVS" {
       pack .merge.top.f -side top -padx 2 -pady 4
       pack .merge.top.f.fromtag -side left
       pack .merge.top.f.ent -side left
       pack .merge.top.m2 -side top -fill x -expand y
       .merge.top.f.ent insert end $mtag
       .merge.top.f.ent configure -state readonly
       if {$fromrev == "trunk"} { set fromrev "HEAD" }
       .merge.bottom.apply configure \
          -command "cvs_merge $fromrev \"$sincerev\" $mtag $ftag $file"
       .merge.bottom.ok configure \
          -command "cvs_merge $fromrev \"$sincerev\" $mtag $ftag $file; \
                    destroy .merge"
     }
    "SVN" {
       pack .merge.top.f -side top -padx 2 -pady 4
       pack .merge.top.f.fromtag -side left
       pack .merge.top.f.ent -side left
       pack .merge.top.m2 -side top -fill x -expand y
       #set ftag "${fromprefix}_${from}_$today"

       .merge.top.f.ent insert end $mtag
       .merge.top.f.ent configure -state readonly
       #if {$fromrev == "trunk"} { set fromrev "HEAD" }

       .merge.bottom.apply configure \
          -command "svn_merge $fromrev $sincerev $frombranch $mtag $ftag $file"
       .merge.bottom.ok configure \
          -command "svn_merge $fromrev $sincerev $frombranch $mtag $ftag $file; \
                    destroy .merge"
     }
  }
  gen_log:log T "LEAVE"
}

proc file_tag_dialog {branch} {
  global incvs insvn inrcs
  global cvscfg
  global branchflag

  gen_log:log T "ENTER"

  set branchflag $branch

  toplevel .tag
  #grab set .tag

  frame .tag.top
  pack .tag.top -side top -fill x

  set msg ""
  if {$incvs} {
    set msg "Apply a new tag or branch tag \
             to the marked files, recursively.\
             Will change the repository.\
             If a branch, it can also update local directory if desired."
  } elseif {$insvn} {
    set msg "Create a new branch or tag copy \
             of the files in this directory"
  }

  message .tag.top.msg -justify left -aspect 300 -relief groove \
    -text $msg
  label .tag.top.lbl -text "Tag Name" -anchor w
  entry .tag.top.entry -relief sunken -textvariable usertagname
  checkbutton .tag.top.branch -text "Branch tag (-b)" \
     -variable branchflag -onvalue "yes" -offvalue "no" \
     -command { 
        if {$branchflag == "no"} {\
           .tag.mid.upd config -state disabled; set updflag "no" } \
        else {.tag.mid.upd config -state normal } \
      }
  checkbutton .tag.top.force -text "Move existing (-F)" \
     -variable forceflag -onvalue "yes" -offvalue "no"

  frame .tag.mid -relief groove -bd 2
  checkbutton .tag.mid.upd -text "Update current directory to be on the new tag" \
      -variable updflag -onvalue "yes" -offvalue "no"

  grid columnconf .tag.top 1 -weight 1
  grid rowconf .tag.top 3 -weight 1
  grid .tag.top.msg -column 0 -row 0 -columnspan 2 -pady 2 -sticky ew
  grid .tag.top.lbl -column 0 -row 1 -sticky nw
  grid .tag.top.entry -column 1 -row 1 -sticky ew
  grid .tag.top.branch -column 1 -row 2 -sticky w
  if {$incvs} {
    grid .tag.top.force -column 1 -row 3 -sticky w
  }

  pack .tag.mid -side top
  pack .tag.mid.upd

  frame .tag.down -relief groove -bd 2
  pack .tag.down -side bottom -fill x -expand 1
  button .tag.down.tag -text "Tag"
  if {$incvs} {
    .tag.down.tag configure -command {
      cvs_tag $usertagname $forceflag $branchflag $updflag \
          [workdir_list_files]
      grab release .tag
      destroy .tag
    }
  } elseif {$insvn} {
    .tag.down.tag configure -command {
      svn_tag $usertagname no $branchflag $updflag \
          [workdir_list_files]
      grab release .tag
      destroy .tag
    }
  }
  button .tag.down.cancel -text "Cancel" \
    -command { grab release .tag; destroy .tag }

  pack .tag.down.tag .tag.down.cancel -in .tag.down -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  if {$branchflag == "no"} {
     .tag.mid.upd config -state disabled
     set updflag "no"
  } else {
     .tag.mid.upd config -state normal
  }

  wm title .tag "tag"
  wm minsize .tag 1 1
  gen_log:log T "LEAVE"
}

proc rtag_dialog { cvsroot module branch } {
  global cvscfg

  gen_log:log T "ENTER ($cvsroot $module $branch)"

  toplevel .modtag
  grab set .modtag

  frame .modtag.top
  pack .modtag.top -side top -fill x

  message .modtag.top.lbl -aspect 300 -relief groove \
    -text "Tag the module \"$module\" with the new tag you specify.\
           If you fill in \"Existing Tag\", the revisions having that tag will get\
           the new tag.  Otherwise, the head revision will be tagged."
  label .modtag.top.olbl -text "Existing Tag" -anchor w
  entry .modtag.top.oentry -textvariable otag \
    -relief sunken
  label .modtag.top.nlbl -text "New Tag" -anchor w
  entry .modtag.top.nentry -textvariable ntag \
    -relief sunken
  checkbutton .modtag.top.branch -text "Branch tag (-b)" \
     -variable branch -onvalue "yes" -offvalue "no"
  checkbutton .modtag.top.force -text "Move existing (-F)" \
     -variable force -onvalue "yes" -offvalue "no"

  grid columnconf .modtag.top 1 -weight 1
  grid rowconf .modtag.top 4 -weight 1
  grid .modtag.top.lbl -column 0 -row 0 -columnspan 2 -pady 2 -sticky ew
  grid .modtag.top.olbl -column 0 -row 1 -sticky nw
  grid .modtag.top.oentry -column 1 -row 1
  grid .modtag.top.nlbl -column 0 -row 2 -sticky nw
  grid .modtag.top.nentry -column 1 -row 2
  grid .modtag.top.branch -column 1 -row 3 -sticky w
  grid .modtag.top.force -column 1 -row 4 -sticky w

  frame .modtag.down -relief groove -bd 2
  pack .modtag.down -side top -fill x

  button .modtag.down.tag -text "Tag" \
    -command "
               cvs_rtag $cvsroot $module $branch \$force \$otag \$ntag; \
               .modtag.down.cancel invoke
             "

  button .modtag.down.cancel -text "Cancel" \
    -command {
               grab release .modtag
               destroy .modtag
             }

  pack .modtag.down.tag .modtag.down.cancel -in .modtag.down -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  bind .modtag.top.nentry <Return> \
    { .modtag.down.tag invoke }

  wm title .modtag "Tag Module"
  wm minsize .modtag 1 1
  gen_log:log T "LEAVE"