home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / import.tcl.z / import.tcl
Encoding:
Text File  |  1999-04-16  |  7.2 KB  |  270 lines
  1. #
  2. # Tcl Library for tkCVS
  3. #
  4.  
  5. #
  6. # $Id: import.tcl,v 1.15 1995/11/07 00:59:55 davide Exp $
  7. #
  8. # Adds a new document to the repository.
  9. #
  10.  
  11. proc import_setup {} {
  12.   global cvsglb
  13.  
  14.   toplevel .import
  15.   frame .import.left
  16.   frame .import.right
  17.   frame .import.down -relief groove -border 2
  18.  
  19.   # When packing, I only want the right hand side and the buttons
  20.   # to be interactively strechable (in case the user wants more space
  21.   # to enter long document names).
  22.  
  23.   pack .import.down -side bottom -fill x -expand 1
  24.   pack .import.left -side left -fill y
  25.   pack .import.right -side left -fill both -expand 1
  26.  
  27.   label .import.lnewdir  -text "Module Directory" -anchor w
  28.   label .import.lnewname -text "Module Name" -anchor w
  29.   label .import.lnewvers  -text "Version Number" -anchor w
  30.   label .import.lnewcode -text "Module Code" -anchor w
  31.  
  32.   entry .import.tnewdir -relief sunken -textvariable cvsglb(newdir) -width 40
  33.   entry .import.tnewname -relief sunken -textvariable cvsglb(newname) -width 40
  34.   entry .import.tnewvers -relief sunken -textvariable cvsglb(newvers) -width 40
  35.   entry .import.tnewcode -relief sunken -textvariable cvsglb(newcode) -width 40
  36.  
  37.   # bind_motifentry .import.tnewdir
  38.   # bind_motifentry .import.tnewname
  39.   # bind_motifentry .import.tnewvers
  40.   # bind_motifentry .import.tnewcode
  41.  
  42.   pack .import.lnewdir .import.lnewname \
  43.     .import.lnewvers .import.lnewcode -in .import.left \
  44.     -side top -fill x -pady 3
  45.  
  46.   pack .import.tnewdir .import.tnewname \
  47.     .import.tnewvers .import.tnewcode -in .import.right \
  48.     -side top -fill both -expand 1 -pady 3
  49.  
  50.   button .import.ok -text "OK" \
  51.     -command do_import
  52.   button .import.newdir -text "New Directory" \
  53.     -command inewdir_run
  54.   button .import.quit -text "Quit" \
  55.     -command { wm withdraw .import }
  56.  
  57.   pack .import.ok .import.newdir .import.quit -in .import.down -side left \
  58.     -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1
  59.  
  60.   wm withdraw .import
  61.   wm title .import "Import a New Module"
  62.   wm minsize .import 1 1
  63.  
  64.   toplevel .inewdir
  65.   frame .inewdir.left
  66.   frame .inewdir.right
  67.   frame .inewdir.down -relief groove -border 2
  68.  
  69.   # When packing, I only want the right hand side and the buttons
  70.   # to be interactively strechable (in case the user wants more space
  71.   # to enter long document names).
  72.  
  73.   pack .inewdir.down -side bottom -fill x -expand 1
  74.   pack .inewdir.left -side left -fill y
  75.   pack .inewdir.right -side left -fill both -expand 1
  76.  
  77.   label .inewdir.lnewdir  -text "New Directory Location" -anchor w
  78.   label .inewdir.lnewname -text "New Directory Name" -anchor w
  79.  
  80.   entry .inewdir.tnewdir -relief sunken -textvariable cvsglb(dnewdir) -width 40
  81.   entry .inewdir.tnewname -relief sunken -textvariable cvsglb(dnewname) -width 40
  82.  
  83.   # bind_motifentry .inewdir.tnewdir
  84.   # bind_motifentry .inewdir.tnewname
  85.  
  86.   pack .inewdir.lnewdir .inewdir.lnewname \
  87.     -in .inewdir.left \
  88.     -side top -fill x -pady 3
  89.  
  90.   pack .inewdir.tnewdir .inewdir.tnewname \
  91.     -in .inewdir.right \
  92.     -side top -fill both -expand 1 -pady 3
  93.  
  94.   button .inewdir.ok -text "OK" \
  95.     -command do_inewdir
  96.   button .inewdir.quit -text "Quit" \
  97.     -command { wm withdraw .inewdir }
  98.  
  99.   pack .inewdir.ok .inewdir.quit -in .inewdir.down -side left \
  100.     -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1
  101.  
  102.   wm withdraw .inewdir
  103.   wm title .inewdir "Import a New Directory"
  104.   wm minsize .inewdir 1 1
  105. }
  106.  
  107. proc import_run {} {
  108.   global cvsglb
  109.   global cvscfg
  110.   global cwd
  111.  
  112.   if {$cvscfg(cvsver) < 1.3} {
  113.     cvserror "This function is not available in CVS version $cvscfg(cvsver).
  114.  
  115. Please upgrade your CVS to version 1.3 or later or use Add instead."
  116.     return 1
  117.   }
  118.  
  119.   set cvsglb(newcode) [file tail $cwd]
  120.   wm deiconify .import
  121. }
  122.  
  123. proc inewdir_run {} {
  124.   wm deiconify .inewdir
  125. }
  126.  
  127. proc do_import {} {
  128.   global cvsglb
  129.   global cvs
  130.   global cwd
  131.   global incvs
  132.   global dtitle
  133.   global dcontents
  134.  
  135.   # Error checks
  136.  
  137.   if {$incvs} {
  138.     cvserror "This directory is already in CVS.\nCant import here!"
  139.     return 1
  140.   }
  141.   if { $cvsglb(newdir) == "" } {
  142.     cvserror "You must type in a directory!"
  143.     return 1
  144.   }
  145.   if { $cvsglb(newname) == "" } {
  146.     cvserror "You must type in a module name!"
  147.     return 1
  148.   }
  149.   if { $cvsglb(newvers) == "" } {
  150.     cvserror "You must type in a version number!"
  151.     return 1
  152.   }
  153.   if { $cvsglb(newcode) == "" } {
  154.     cvserror "You must type in a module code!"
  155.     return 1
  156.   }
  157.  
  158.   # Check that all apropriate Directories in newdirname exist
  159.   set cvsglb(newdir) [string trimleft $cvsglb(newdir) "/"]
  160.   set checkdirname [file dirname $cvsglb(newdir)]
  161.   if {$checkdirname != "."} {
  162.     if {[lsearch -exact [array names dtitle] $checkdirname] == -1} {
  163.      cvserror "The upper directory doesnt exist."
  164.      return 1
  165.     }
  166.   }
  167.  
  168.   set create_module 1
  169.   if {[lsearch -exact [array names dtitle] $cvsglb(newdir)] >= 0} {
  170.     set mess "NOTE:  You are importing a new baseline of a directory that already exists!"
  171.     set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  172.     if {$confirm == 0} {
  173.       set create_module 0
  174.     } else {
  175.       return 1
  176.     }
  177.   }
  178.   set ndir [file dirname $cvsglb(newdir)]
  179.   if { [info exists dcontents($ndir)] && {$create_module == 0}} {
  180.     if {[lsearch -exact $dcontents($ndir) $cvsglb(newcode)] >= 0} {
  181.       set mess "NOTE:  You are importing over a directory that already exists!"
  182.       set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit] 
  183.       if {$confirm == 0} {
  184.         set create_module 0
  185.       } else {
  186.         return 1
  187.       }
  188.     }
  189.   }
  190.  
  191.   # Make a baseline tag
  192.  
  193.   set versions [split $cvsglb(newvers) ".,/ -"]
  194.   set baseline "baseline-[join $versions {_}]"
  195.  
  196.   feedback_cvs "Importing $cvsglb(newcode), please wait"
  197.   catch \
  198.     {exec $cvs import -m "Imported using tkCVS" \
  199.                $cvsglb(newdir) VENDOR $baseline} \
  200.     view_this
  201.   feedback_cvs ""
  202.  
  203.   view_output "CVS Import" $view_this
  204.  
  205.   # Update the modules file.
  206.  
  207.   if {$create_module == 1} {
  208.     cd
  209.     catch {exec $cvs co modules}
  210.     cd modules
  211.     set modfile [open modules a]
  212.       puts $modfile ""
  213.       puts $modfile "#M    $cvsglb(newcode)    $cvsglb(newname)"
  214.       puts $modfile "$cvsglb(newcode)    $cvsglb(newdir)"
  215.     close $modfile
  216.     catch {exec $cvs ci -m "added $cvsglb(newcode)" modules}
  217.     cd $cwd
  218.   }
  219.  
  220.   read_modules_setup
  221.   checkout_fill_listbox
  222.   wm withdraw .import
  223. }
  224.  
  225. proc do_inewdir {} {
  226.   global cvsglb
  227.   global cvs
  228.   global cwd
  229.   global dtitle
  230.  
  231.   # Error checks
  232.  
  233.   if { $cvsglb(dnewdir) == "" } {
  234.     cvserror "You must type in a directory!"
  235.     return 1
  236.   }
  237.   if { $cvsglb(dnewname) == "" } {
  238.     cvserror "You must type in a directory name!"
  239.     return 1
  240.   }
  241.  
  242.   # Check that all apropriate Directories in newdirname exist
  243.   set cvsglb(dnewdir) [string trimleft $cvsglb(dnewdir) "/"]
  244.   set checkdirname [file dirname $cvsglb(dnewdir)]
  245.   if {$checkdirname != "."} {
  246.     if {[lsearch -exact [array names dtitle] $checkdirname] == -1} {
  247.      cvserror "The upper directory doesnt exist."
  248.      return 1
  249.     }
  250.   }
  251.  
  252.   if {[lsearch -exact [array names dtitle] $cvsglb(dnewdir)] >= 0} {
  253.      cvserror "This directory already exists!"
  254.      return 1
  255.   }
  256.  
  257.   cd
  258.   catch {exec $cvs co modules}
  259.   cd modules
  260.   set modfile [open modules a]
  261.     puts $modfile ""
  262.     puts $modfile "#D    $cvsglb(dnewdir)    $cvsglb(dnewname)"
  263.   close $modfile
  264.   catch {exec $cvs ci -m "added $cvsglb(dnewdir)" modules}
  265.   cd $cwd
  266.  
  267.   read_modules_setup
  268.   checkout_fill_listbox
  269. }
  270.