⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dialog.tcl

📁 TKCVS Source Code For CVS。
💻 TCL
📖 第 1 页 / 共 4 页
字号:
}

proc subtract_dialog {args} {
  global incvs
  global insvn

  gen_log:log T "ENTER ($args)"

  set filelist [join $args]
  if {$filelist == ""} {
    cvsfail "Please select some files to delete first!" .workdir
    return
  }

  foreach f $filelist {
    if {$incvs && [file isdirectory $f]} {
      cvsfail "$f is a directory. Try \"Remove Recursively\" instead" .workdir
      return
    }
  }

  toplevel .subtract
  grab set .subtract

  set mess "This will remove these files:\n\n"
  foreach file $filelist {
    append mess "   $file\n"
  }

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

  message .subtract.middle -text $mess -aspect 200
  pack .subtract.middle -side top -fill x
  frame .subtract.down
  button .subtract.down.remove -text "Remove"
  if {$incvs} {
    .subtract.down.remove configure -command {
      grab release .subtract
      destroy .subtract
      cvs_remove [workdir_list_files]
    }
  } elseif {$insvn} {
    .subtract.down.remove configure -command {
      grab release .subtract
      destroy .subtract
      svn_remove [workdir_list_files]
    }
  }
  
  button .subtract.down.cancel -text "Cancel" \
    -command { grab release .subtract; destroy .subtract }
  pack .subtract.down -side bottom -fill x -expand 1
  pack .subtract.down.remove .subtract.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .subtract "Remove Files"
  wm minsize .subtract 1 1

  gen_log:log T "LEAVE"
}

proc edit_dialog {args} {
  global incvs

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "."} {
    cvsfail "Please select some files to edit first!" .workdir
    return
  }
  toplevel .editflag
  grab set .editflag

  set filelist [join $args]
  set mess "This will set the edit flag on these files:\n\n"
  foreach file $filelist {
    append mess "   $file\n"
  }

  message .editflag.top -justify left -aspect 300 -relief groove \
    -text "Set the edit flag on a file or files from the module"
  pack .editflag.top -side top -fill x

  message .editflag.middle -text $mess -aspect 200
  pack .editflag.middle -side top -fill x

  frame .editflag.down
  button .editflag.down.remove -text "Edit" \
    -command {
      grab release .editflag
      destroy .editflag
      cvs_edit [workdir_list_files]
    }
  button .editflag.down.cancel -text "Cancel" \
    -command { grab release .editflag; destroy .editflag }
  pack .editflag.down -side bottom -fill x -expand 1
  pack .editflag.down.remove .editflag.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .editflag "Edit Files"
  wm minsize .editflag 1 1

  gen_log:log T "LEAVE"
}

proc unedit_dialog {args} {
  global incvs

  gen_log:log T "ENTER ($args)"
  if {! $incvs} {
    cvs_notincvs
    return 1
  }

  if {$args == "."} {
    cvsfail "Please select some files to unedit first!" .workdir
    return
  }
  toplevel .uneditflag
  grab set .uneditflag

  set filelist [join $args]
  set mess "This will reset the edit flag on these files:\n\n"
  foreach file $filelist {
    append mess "   $file\n"
  }

  message .uneditflag.top -justify left -aspect 300 -relief groove \
    -text "Reset the edit flag on a file or files from the module."
  pack .uneditflag.top -side top -fill x

  message .uneditflag.middle -text $mess -aspect 200
  pack .uneditflag.middle -side top -fill x

  frame .uneditflag.down
  button .uneditflag.down.remove -text "Unedit" \
    -command {
      grab release .uneditflag
      destroy .uneditflag
      cvs_unedit [workdir_list_files]
    }
  button .uneditflag.down.cancel -text "Cancel" \
    -command { grab release .uneditflag; destroy .uneditflag }
  pack .uneditflag.down -side bottom -fill x -expand 1
  pack .uneditflag.down.remove .uneditflag.down.cancel -side left \
    -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  wm title .uneditflag "Unedit Files"
  wm minsize .uneditflag 1 1

  gen_log:log T "LEAVE"
}

#
# Set up a small(?) update dialog.
#
proc update_run {} {
  global cvsglb
  global cvscfg

  gen_log:log T "ENTER"

  if {[winfo exists .update]} {
    wm deiconify .update
    raise .update
    grab set .update
    gen_log:log T "LEAVE"
    return
  }

  # Set defaults if not already set
  if {! [info exists cvsglb(tagmode_selection)]} {
    update_set_defaults
  }

  toplevel .update
  grab set .update
  frame .update.explaintop
  frame .update.options
  frame .update.down

  frame .update.options.keep -relief groove -border 2
  frame .update.options.trunk -relief groove -border 2
  frame .update.options.getrev -relief groove -border 2
  frame .update.options.newdir -relief groove -border 2
  frame .update.options.normbin -relief groove -border 2
  frame .update.getrevleft
  frame .update.getrevright
  frame .update.getreventry

  frame .update.getdirsleft
  frame .update.getdirsright
  frame .update.getdirsentry

  pack .update.down -side bottom -fill x
  pack .update.explaintop -side top -fill x -pady 1
  pack .update.options -side top -fill x -pady 1


  # Provide an explanation of this dialog box
  label .update.explain1 -relief raised -bd 1 \
    -text "Update files in local directory"

 message .update.explain2 -font $cvscfg(listboxfont) \
     -justify left -width 400 \
     -text "Always recursive.
Empty directories always pruned (-P).
'Reset defaults' button will show defaults."

  pack .update.explain1 .update.explain2 \
    -in .update.explaintop -side top -fill x

  pack .update.options.keep -in .update.options -side top -fill x
  pack .update.options.trunk -in .update.options -side top -fill x
  pack .update.options.getrev -in .update.options -side top -fill x
  pack .update.options.newdir -in .update.options -side top -fill x
  pack .update.options.normbin -in .update.options -side top -fill x


  # If the user wants to simply do a normal update
  radiobutton .update.options.keep.select -text "Keep same branch or trunk." \
    -variable cvsglb(tagmode_selection) -value "Keep" -anchor w

  message .update.options.keep.explain1 -font $cvscfg(listboxfont) \
    -justify left -width 400 \
    -text "If local directory is on main trunk, get latest on main trunk.
If local directory is on a branch, get latest on that branch.
If local directory/file has \"sticky\" non-branch tag, no update."

  pack .update.options.keep.select -in .update.options.keep \
    -side top -fill x
  pack .update.options.keep.explain1 \
    -in .update.options.keep -side top -fill x -pady 1 -ipady 0

  # If the user wants to update to the head revision
  radiobutton .update.options.trunk.select \
    -text "Update local files to be on main trunk (-A)" \
    -variable cvsglb(tagmode_selection) -value "Trunk" -anchor w

  message .update.options.trunk.explain1 -font $cvscfg(listboxfont) \
    -justify left -width 400 \
    -text "Advice:  If your local directories are currently on a branch, \
you may want to commit any local changes to that branch first."

  pack .update.options.trunk.select \
    -in .update.options.trunk -side top -fill x
  pack .update.options.trunk.explain1 \
    -in .update.options.trunk -side top -fill x -pady 1 -ipady 0

  # If the user wants to update local files to a branch/tag

  # Where user enters a tag name (optional)
  radiobutton .update.options.getrev.select \
    -text "Update (-r) local files to be on tag/branch:" \
    -variable cvsglb(tagmode_selection) -value "Getrev" -anchor w

  message .update.options.getrev.explain -font $cvscfg(listboxfont) \
    -justify left -width 400 \
    -text "Advice:  Update local files to main trunk (head) first.
Note:  The tag will be 'sticky' for the directory and for each file."

  label .update.lname -text "Tag Name" -anchor w

  entry .update.tname -relief sunken -textvariable cvsglb(updatename)

  # bind_motifentry .update.tname

  pack .update.lname -in .update.getrevleft \
    -side top -fill x -pady 4

  pack .update.tname -in .update.getrevright \
    -side top -fill x -padx 2 -pady 4

  # Where user chooses the action to take if tag is not on a file
  label .update.lnotfound -text "If tag not found for file," \
    -anchor w

  radiobutton .update.notfoundremove -text "Remove file from local directory" \
    -variable cvsglb(action_notag) -value "Remove"

  radiobutton .update.notfoundhead -text "Get head revision (-f)" \
    -variable cvsglb(action_notag) -value "Get_head"

  pack .update.options.getrev.select -in .update.options.getrev \
    -side top -fill x
  pack .update.options.getrev.explain -in .update.options.getrev \
    -side top -fill x
  pack .update.getreventry -in .update.options.getrev \
    -side top -fill x
  pack .update.lnotfound -in .update.options.getrev \
    -side top -fill x
  pack .update.notfoundhead .update.notfoundremove \
    -in .update.options.getrev -side bottom -anchor w \
    -ipadx 8 -padx 4

  pack .update.getrevleft -in .update.getreventry \
     -side left -fill y
  pack .update.getrevright -in .update.getreventry \
     -side left -fill both -expand 1


  # Where user chooses whether to pick up directories not currently in local
  label .update.lalldirs \
    -text "If directory is in repository but not in local:" -anchor w

  radiobutton .update.noalldirs -text "Ignore it" \
    -variable cvsglb(get_all_dirs) -value "No" -anchor w
  radiobutton .update.getalldirs -text "Get it (-d)" \
    -variable cvsglb(get_all_dirs) -value "Yes" -anchor w

  label .update.lgetdirname -text "Specific directory (optional)" -anchor w
  entry .update.tgetdirname -relief sunken -textvariable cvsglb(getdirname)

  pack .update.lgetdirname -in .update.getdirsleft \
    -side top -fill x
  pack .update.tgetdirname -in .update.getdirsright \
    -side top -fill x -padx 2 -pady 1

  pack .update.getdirsleft -in .update.getdirsentry \
    -side left -fill y
  pack .update.getdirsright -in .update.getdirsentry \
    -side left -fill both -expand 1

  pack .update.lalldirs -in .update.options.newdir \
    -side top -fill x
  pack .update.getdirsentry -in .update.options.newdir \
    -side bottom -fill x
  pack .update.noalldirs .update.getalldirs -in .update.options.newdir \
    -side left -fill both -ipadx 2 -ipady 2 -padx 4 -expand 1

  # Where user chooses whether file is normal or binary
  label .update.lnormalbinary -text "Treat each file as:" -anchor w

  radiobutton .update.normalfile -text "Normal File" \
    -variable cvsglb(norm_bin) -value "Normal" -anchor w
  radiobutton .update.binaryfile -text "Binary File (-kb)" \
    -variable cvsglb(norm_bin) -value "Binary" -anchor w

  pack .update.lnormalbinary -in .update.options.normbin -side top -fill both
  pack .update.normalfile .update.binaryfile -in .update.options.normbin \
    -side left -fill both -ipadx 2 -ipady 2 -padx 4 -expand 1

  # The OK/Cancel buttons
  button .update.ok -text "OK" \
    -command { grab release .update; wm withdraw .update; update_with_options }

  button .update.apply -text "Apply" \
    -command update_with_options

  button .update.reset -text "Reset defaults" \
    -command update_set_defaults

  button .update.quit -text "Close" \
    -command { grab release .update; wm withdraw .update }

  pack .update.ok .update.apply .update.reset .update.quit -in .update.down \
    -side left -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1

  # Window Manager stuff
# wm withdraw .update
  wm title .update "Update a Module"
  wm minsize .update 1 1
  gen_log:log T "LEAVE"
}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -