home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / modules.tcl.z / modules.tcl
Encoding:
Text File  |  1999-04-16  |  12.2 KB  |  455 lines
  1. #
  2. # TCL Library for tkCVS
  3. #
  4.  
  5. #
  6. # $Id: modules.tcl,v 1.5 1995/08/19 11:47:30 del Exp $
  7. #
  8. # Procedures to parse the CVS modules file and store whatever is
  9. # read into various associative arrays, sorted, and unsorted lists.
  10. #
  11.  
  12. #
  13. # Global variables:
  14. #
  15. # env
  16. #   The unix environment.
  17. # cvsroot
  18. #   The location of the CVSROOT directory.
  19. # mtitle
  20. #   For each module, the name of the module.
  21. # dtitle
  22. #   For each directory, the name of the directory.
  23. # dcontents
  24. #   For each directory, the list of modules within it.
  25. # dsubmenus
  26. #   For each directory, the list of subdirectories within it.
  27. # cvscfg
  28. #   General configuration variables (array)
  29. # filenames
  30. #   For each module, the list of files that it contains.
  31. # location
  32. #   For each module, its location in the repository.
  33.  
  34. proc read_modules_setup {} {
  35. #
  36. # Read one pass through the modules file.
  37. #
  38.   global env
  39.   global cvsroot
  40.   global mtitle
  41.   global dtitle
  42.   global dcontents
  43.   global dsubmenus
  44.   global cvscfg
  45.   global filenames
  46.   global location
  47.  
  48.   if {! [info exists env(CVSROOT)]} {
  49.     cvserror "Your CVSROOT variable is not set."
  50.     exit
  51.   }
  52.  
  53.   set cvsroot $env(CVSROOT)
  54.   if {[string match "*:*" $cvsroot]} {
  55.     #
  56.     # Remote repository.  Create a temporary modules file by dumping
  57.     # the remote file.  This means we must be using CVS version 1.5
  58.     #
  59.     set cvscfg(cvsver) 1.5
  60.     set cvscfg(remote) 1
  61.     set pid [pid]
  62.     set cvscfg(modfile) /var/tmp/modules-$pid
  63.     catch {exec cvs co -p modules > $cvscfg(modfile)}
  64.   } else {
  65.     #
  66.     # Not a remote repository.
  67.     #
  68.     set cvscfg(remote) 0
  69.     if {! [file isdirectory $cvsroot]} {
  70.       cvserror "Your CVSROOT variable is set incorrectly."
  71.       exit
  72.     }
  73.     if {[file readable $cvsroot/CVSROOT/modules]} {
  74.       set cvscfg(cvsver) 1.3
  75.       set cvscfg(modfile) $cvsroot/CVSROOT/modules
  76.     } elseif {[file readable $cvsroot/CVSROOT.adm/modules,v]} {
  77.       set cvscfg(cvsver) 1.2
  78.       set cvscfg(modfile) $cvsroot/CVSROOT.adm/modules
  79.       if { ! [file readable $cvsroot/CVSROOT.adm/modules]} {
  80.         cvserror "Please change your mkmodules file to create CVSROOT.adm/modules"
  81.         exit
  82.       }
  83.     } else {
  84.       cvserror "I cannot read\n$cvsroot/CVSROOT/modules\nCheck file permissions!"
  85.       exit
  86.     }
  87.   }
  88.  
  89.   catch {unset mtitle}
  90.   catch {unset dtitle}
  91.   catch {unset dcontents}
  92.   catch {unset dsubmenus}
  93.  
  94.   # Set up a top level directory for "aliases"
  95.   set dtitle(aliases) "Aliases"
  96.  
  97.   # Include a default name for the "world" alias that everyone tends
  98.   # to ignore.
  99.   set mtitle(world) "The Whole CVS Repository."
  100.  
  101.   # Read through the entire modules file to get out the module names.
  102.  
  103.   set modules [open $cvscfg(modfile)]
  104.   while {[gets_full_line $modules line] >= 0} {
  105.     # Split and parse the line
  106.     if {$line != {}} {
  107.       set text [split $line "\t"]
  108.  
  109.       # #D describes a directory title.
  110.  
  111.       if {[lindex $text 0] == "#D"} {
  112.         set dname [lindex $text 1]
  113.     set dtitle($dname) [lindex $text 2]
  114.         set layers [split $dname "/"]
  115.     # puts "$dname is called $dtitle($dname)"
  116.     if {[llength $layers] > 1} {
  117.       set pname [file dirname $dname]
  118.       if [info exists dsubmenus($pname)] {
  119.         lappend dsubmenus($pname) $dname
  120.       } else {
  121.         set dsubmenus($pname) $dname
  122.       }
  123.       # puts "$dname added to dsubmenus ( $pname )"
  124.     }
  125.         continue
  126.       }
  127.  
  128.       # #M means this is a module title
  129.  
  130.       if {[lindex $text 0] == "#M"} {
  131.         set mcode [lindex $text 1]
  132.     set mtitle($mcode) [lindex $text 2]
  133.         continue
  134.       }
  135.  
  136.       # Any other non-comment means that this is a module.  These
  137.       # can be separated by whitespace not just tabs.
  138.       set text [clean_list $line]
  139.       set mcode [lindex $text 0]
  140.       # puts "Processing $mcode"
  141.  
  142.       # Process aliases as part of the "aliases" directory.
  143.  
  144.       if {! [regexp {^#} $mcode] && \
  145.           [regexp {^-a} [lindex $text 1]] } {
  146.     if [info exists mtitle($mcode)] {
  147.       # puts "$mcode is an alias"
  148.           set filenames($mcode) ",,#ALIAS"
  149.           if [info exists dcontents(aliases)] {
  150.             lappend dcontents(aliases) $mcode
  151.           } else {
  152.             set dcontents(aliases) $mcode
  153.           }
  154.     } else {
  155.       # puts "$mcode has no title -- ignoring"
  156.         }
  157.       }
  158.  
  159.       # Process all other modules as part of their parent directories.
  160.       # puts -nonewline stderr [lindex $text 0]
  161.       # puts -nonewline stderr " -- "
  162.       # puts -nonewline stderr [llength $text]
  163.       if {! [regexp {^#} $mcode] && \
  164.           ! [regexp {^-a} [lindex $text 1]] } {
  165.         set mcode [lindex $text 0]
  166.         set mname [lindex $text 1]
  167.         set location($mcode) $mname
  168.         set layers [split $mname "/"]
  169.         # puts -nonewline stderr " -- "
  170.         # puts stderr $layers
  171.         # If the text list has more than two elements, then this
  172.         # module has files.  In that case it is a child of the current
  173.         # directory of the module, not the parent directory.
  174.         if {[llength $text] > 2 && ! [regexp {[\w*&]} $text] } {
  175.           set pname $mname
  176.           set filenames($mcode) [lrange $text 2 end]
  177.         } else {
  178.           set pname [file dirname $mname]
  179.           # In this case filenames($mcode) is unset.  Take this to mean
  180.           # that the module comprises all files (recursively) in the
  181.           # module directory.  If filenames is needed later it can be
  182.           # established by reading the directory.
  183.         }
  184.     if [info exists mtitle($mcode)] {
  185.       # puts stderr "$mcode in $mname is called $mtitle($mcode)"
  186.           if {[llength $layers] > 1} {
  187.             if [info exists dcontents($pname)] {
  188.               lappend dcontents($pname) $mcode
  189.             } else {
  190.               set dcontents($pname) $mcode
  191.             }
  192.             # puts stderr "$mcode added to dcontents ( $pname )"
  193.           } else {
  194.             # The module is a submodule of a directory, because the defined
  195.             # directory is identical with a top level dir but the module
  196.             # contains a subset of files, thus add the module to the list.
  197.             # The module appears in the reports and 'check-out' window.
  198.             if { "$layers" == "$pname" } {
  199.               if [info exists dcontents($pname)] {
  200.                 lappend dcontents($pname) $mcode
  201.               } else {
  202.                 set dcontents($pname) $mcode
  203.               }
  204.             } else {
  205.             # puts stderr "$mcode is a top level directory -- ignoring"
  206.             }
  207.           }
  208.     } else {
  209.       # puts stderr "$mcode has no title -- ignoring"
  210.         }
  211.       }
  212.  
  213.     }
  214.   # No more lines in modules
  215.   }
  216.   close $modules
  217.   #
  218.   # If this was a remote repository, then we must now delete the
  219.   # temp file.
  220.   #
  221.   if {$cvscfg(remote)} {
  222.     catch {exec rm -f $cvscfg(modfile)}
  223.   }
  224.   # report_on_menu
  225.   gather_mod_index
  226. }
  227.  
  228. proc gather_mod_index {} {
  229. #
  230. # Creates a new global list called modlist_by_title that
  231. # contains a sorted list of the module titles.  The module
  232. # code is appended to the module title, separated by a tab.
  233. #
  234.   global mtitle
  235.   global modlist_by_title
  236.  
  237.   if {! [info exists mtitle]} {
  238.     set modlist_by_title {}
  239.     return
  240.   }
  241.  
  242.   set modlist {}
  243.  
  244.   foreach mcode [array names mtitle] {
  245.     lappend modlist "$mtitle($mcode)\t$mcode"
  246.   }
  247.  
  248.   set modlist_by_title [lsort $modlist]
  249. }
  250.  
  251. proc list_mcodes {modtitle} {
  252. #
  253. # Returns a list of module codes that match a module title.
  254. #
  255.   global mtitle
  256.  
  257.   if {! [info exists mtitle]} {
  258.     return {}
  259.   }
  260.  
  261.   set modlist {}
  262.  
  263.   foreach mcode [array names mtitle] {
  264.     if {$mtitle($mcode) == $modtitle} {
  265.       lappend modlist $mcode
  266.     }
  267.   }
  268.  
  269.   return $modlist
  270. }
  271.  
  272. proc clean_list {line} {
  273. #
  274. # Returns a list clean of null items after splitting line.
  275. # Also removes any -<x> options and their arguments from the list.
  276. #
  277. # If the line is an alias line (like "myfiles -a hisfiles") then just
  278. # return "myfiles -a".  tkCVS handles aliases as a special case.
  279. #
  280. # If the line contains any other options (like "myfiles -i checkinprog dir/files")
  281. # then remove the options and their arguments (so return "myfiles dir/files"
  282. # only).  -i/-o/etc options are supported by CVS but ignored by tkCVS.
  283. #
  284. # Arguments apart from options and their option arguments are preserved.
  285. # (eg: myfiles -i ciprog dir/files my1 my2 returns myfiles dir/files my1 my2).
  286. # These can be used to select the file names for a module.  NOTE:  THIS IS
  287. # NOT RECOMMENDED!  CVS will not stop you attempting "cvs add" on such a
  288. # module, but the "cvs add" will not add the file names to the module in the
  289. # modules database!
  290. #
  291. # skip_args:
  292. #   Set to 1 to skip the next item in the loop.  Do this when
  293. #   the item is -<x> where x is not "a".
  294. #
  295.  
  296.   set oldlist [split $line]
  297.   set skip_args 0
  298.   # puts stderr $oldlist
  299.  
  300.   foreach item $oldlist {
  301.     # If the item is "-a" then completely ignore this line (don't do aliases).
  302.     if {$item == "-a"} {
  303.       if [info exists newlist] {
  304.         set newlist [lindex $newlist 0]
  305.       } else {
  306.         set newlist "error_in_modules_file"
  307.       }
  308.       lappend newlist $item
  309.       return $newlist
  310.     }
  311.     # If the item is any other option then skip this item and the next one.
  312.     if [regexp {^-} $item] {
  313.       set skip_args 1
  314.       continue
  315.     }
  316.     # If the item is non-blank then process it.
  317.     if {$item != {}} {
  318.       # However, if the last item was an option then skip this one.
  319.       if $skip_args {
  320.         set skip_args 0
  321.         continue
  322.       }
  323.       # Add the item to the list, or create the list if it is empty.
  324.       if [info exists newlist] {
  325.         lappend newlist $item
  326.       } else {
  327.         set newlist $item
  328.       }
  329.     }
  330.   }
  331.  
  332.   if [info exists newlist] {
  333.     # puts stderr $newlist
  334.     return $newlist
  335.   } else {
  336.     return {}
  337.   }
  338. }
  339.  
  340. proc gets_full_line {file varname} {
  341. #
  342. # Gets a full line of text from file, taking into account that
  343. # the line may be split by backslashes.
  344. #
  345.   upvar $varname line
  346.   set numchars 0
  347.   set myline ""
  348.   set line ""
  349.  
  350.   while 1 {
  351.     set getchars [gets $file myline]
  352.     # If we hit the end of the file then go home.
  353.     if {$getchars == -1} {
  354.       if {$numchars == 0} return -1
  355.       return $numchars
  356.     } else {
  357.       incr numchars $getchars
  358.       set line [format "%s%s" $line $myline]
  359.       if {$getchars == 0} {
  360.         return $numchars
  361.       }
  362.       # If there is no trailing backslash, go home.
  363.       if {[string index $myline [expr [string length $myline] - 1]] != "\\"} {
  364.         return $numchars
  365.       }
  366.       # If there is one, chop it off and reloop.
  367.       set line [string range $line 0 [expr [string length $line] - 2]]
  368.       incr numchars -1
  369.     }
  370.   }
  371. }
  372.  
  373. proc find_filenames {mcode} {
  374. #
  375. # This does the (if required) work of setting up the filenames
  376. # array for a module, containing the list of file names within it.
  377. #
  378.   global filenames
  379.   global cvsroot
  380.   global location
  381.   global cwd
  382.  
  383.   # If the list already exists, go home.
  384.   if [info exists filenames($mcode)] return
  385.  
  386.   # All of this stuff must be done from within the repository, so
  387.   # go there now.
  388.   if [catch {cd $cvsroot/$location($mcode)}] {
  389.     # If the directory doesn't exist, go home.
  390.     return
  391.   }
  392.  
  393.   # cd to the module location and find all of the files in it.
  394.   set fd [open "|find . -type f -print"]
  395.   while {[gets $fd line] != -1} {
  396.     # strip off the leading "./" that find puts in.
  397.     set fname [string range $line 2 end]
  398.     # only bother with this if it is a ,v file.
  399.     if [regexp {,v$} $fname] {
  400.       # Strip off the ,v bit.
  401.       set fname [string range $fname 0 [expr [string length $fname] - 3]]
  402.       if [info exists filenames($mcode)] {
  403.         lappend filenames($mcode) $fname
  404.       } else {
  405.         set filenames($mcode) $fname
  406.       }
  407.     }
  408.   }
  409.   catch {close $fd}
  410.  
  411.   # Go home now.
  412.   cd $cwd
  413. }
  414.  
  415. #
  416. # Two recursive debug procedures can be used as templates for
  417. # other stuff later.
  418. #
  419.  
  420. proc report_on_menu {} {
  421.   global dtitle
  422.  
  423.   if {! [info exists dtitle]} {
  424.     puts "No #D lines found in modules"
  425.     return
  426.   }
  427.  
  428.   foreach dname [array names dtitle] {
  429.     if {[file dirname $dname] == "."} {
  430.       puts "$dname : $dtitle($dname) =>"
  431.       report_on_dir $dname {  }
  432.     }
  433.   }
  434. }
  435.  
  436. proc report_on_dir {dname indent} {
  437.   global mtitle
  438.   global dtitle
  439.   global dcontents
  440.   global dsubmenus
  441.  
  442.   if [info exists dsubmenus($dname)] {
  443.     foreach subdir $dsubmenus($dname) {
  444.       puts "$indent$subdir : $dtitle($subdir) =>"
  445.       report_on_dir $subdir "$indent  "
  446.     }
  447.   }
  448.   if [info exists dcontents($dname)] {
  449.     foreach mname $dcontents($dname) {
  450.       puts "$indent$mname = $mtitle($mname)"
  451.     }
  452.   }
  453. }
  454.  
  455.