#
# TCL Library for tkCVS
#

#
# $Id: modules.tcl,v 1.5 1995/08/19 11:47:30 del Exp $
#
# Procedures to parse the CVS modules file and store whatever is
# read into various associative arrays, sorted, and unsorted lists.
#

#
# Global variables:
#
# env
#   The unix environment.
# cvsroot
#   The location of the CVSROOT directory.
# mtitle
#   For each module, the name of the module.
# dtitle
#   For each directory, the name of the directory.
# dcontents
#   For each directory, the list of modules within it.
# dsubmenus
#   For each directory, the list of subdirectories within it.
# cvscfg
#   General configuration variables (array)
# filenames
#   For each module, the list of files that it contains.
# location
#   For each module, its location in the repository.

proc read_modules_setup {} {
#
# Read one pass through the modules file.
#
  global env
  global cvsroot
  global mtitle
  global dtitle
  global dcontents
  global dsubmenus
  global cvscfg
  global filenames
  global location

  if {! [info exists env(CVSROOT)]} {
    cvserror "Your CVSROOT variable is not set."
    exit
  }

  set cvsroot $env(CVSROOT)
  if {[string match "*:*" $cvsroot]} {
    #
    # Remote repository.  Create a temporary modules file by dumping
    # the remote file.  This means we must be using CVS version 1.5
    #
    set cvscfg(cvsver) 1.5
    set cvscfg(remote) 1
    set pid [pid]
    set cvscfg(modfile) /var/tmp/modules-$pid
    catch {exec cvs co -p modules > $cvscfg(modfile)}
  } else {
    #
    # Not a remote repository.
    #
    set cvscfg(remote) 0
    if {! [file isdirectory $cvsroot]} {
      cvserror "Your CVSROOT variable is set incorrectly."
      exit
    }
    if {[file readable $cvsroot/CVSROOT/modules]} {
      set cvscfg(cvsver) 1.3
      set cvscfg(modfile) $cvsroot/CVSROOT/modules
    } elseif {[file readable $cvsroot/CVSROOT.adm/modules,v]} {
      set cvscfg(cvsver) 1.2
      set cvscfg(modfile) $cvsroot/CVSROOT.adm/modules
      if { ! [file readable $cvsroot/CVSROOT.adm/modules]} {
        cvserror "Please change your mkmodules file to create CVSROOT.adm/modules"
        exit
      }
    } else {
      cvserror "I cannot read\n$cvsroot/CVSROOT/modules\nCheck file permissions!"
      exit
    }
  }

  catch {unset mtitle}
  catch {unset dtitle}
  catch {unset dcontents}
  catch {unset dsubmenus}

  # Set up a top level directory for "aliases"
  set dtitle(aliases) "Aliases"

  # Include a default name for the "world" alias that everyone tends
  # to ignore.
  set mtitle(world) "The Whole CVS Repository."

  # Read through the entire modules file to get out the module names.

  set modules [open $cvscfg(modfile)]
  while {[gets_full_line $modules line] >= 0} {
    # Split and parse the line
    if {$line != {}} {
      set text [split $line "\t"]

      # #D describes a directory title.

      if {[lindex $text 0] == "#D"} {
        set dname [lindex $text 1]
	set dtitle($dname) [lindex $text 2]
        set layers [split $dname "/"]
	# puts "$dname is called $dtitle($dname)"
	if {[llength $layers] > 1} {
	  set pname [file dirname $dname]
	  if [info exists dsubmenus($pname)] {
	    lappend dsubmenus($pname) $dname
	  } else {
	    set dsubmenus($pname) $dname
	  }
	  # puts "$dname added to dsubmenus ( $pname )"
	}
        continue
      }

      # #M means this is a module title

      if {[lindex $text 0] == "#M"} {
        set mcode [lindex $text 1]
	set mtitle($mcode) [lindex $text 2]
        continue
      }

      # Any other non-comment means that this is a module.  These
      # can be separated by whitespace not just tabs.
      set text [clean_list $line]
      set mcode [lindex $text 0]
      # puts "Processing $mcode"

      # Process aliases as part of the "aliases" directory.

      if {! [regexp {^#} $mcode] && \
          [regexp {^-a} [lindex $text 1]] } {
	if [info exists mtitle($mcode)] {
	  # puts "$mcode is an alias"
          set filenames($mcode) ",,#ALIAS"
          if [info exists dcontents(aliases)] {
            lappend dcontents(aliases) $mcode
          } else {
            set dcontents(aliases) $mcode
          }
	} else {
	  # puts "$mcode has no title -- ignoring"
        }
      }

      # Process all other modules as part of their parent directories.
      # puts -nonewline stderr [lindex $text 0]
      # puts -nonewline stderr " -- "
      # puts -nonewline stderr [llength $text]
      if {! [regexp {^#} $mcode] && \
          ! [regexp {^-a} [lindex $text 1]] } {
        set mcode [lindex $text 0]
        set mname [lindex $text 1]
        set location($mcode) $mname
        set layers [split $mname "/"]
        # puts -nonewline stderr " -- "
        # puts stderr $layers
        # If the text list has more than two elements, then this
        # module has files.  In that case it is a child of the current
        # directory of the module, not the parent directory.
        if {[llength $text] > 2 && ! [regexp {[\w*&]} $text] } {
          set pname $mname
          set filenames($mcode) [lrange $text 2 end]
        } else {
          set pname [file dirname $mname]
          # In this case filenames($mcode) is unset.  Take this to mean
          # that the module comprises all files (recursively) in the
          # module directory.  If filenames is needed later it can be
          # established by reading the directory.
        }
	if [info exists mtitle($mcode)] {
	  # puts stderr "$mcode in $mname is called $mtitle($mcode)"
          if {[llength $layers] > 1} {
            if [info exists dcontents($pname)] {
              lappend dcontents($pname) $mcode
            } else {
              set dcontents($pname) $mcode
            }
            # puts stderr "$mcode added to dcontents ( $pname )"
          } else {
            # The module is a submodule of a directory, because the defined
            # directory is identical with a top level dir but the module
            # contains a subset of files, thus add the module to the list.
            # The module appears in the reports and 'check-out' window.
            if { "$layers" == "$pname" } {
              if [info exists dcontents($pname)] {
                lappend dcontents($pname) $mcode
              } else {
                set dcontents($pname) $mcode
              }
            } else {
            # puts stderr "$mcode is a top level directory -- ignoring"
            }
          }
	} else {
	  # puts stderr "$mcode has no title -- ignoring"
        }
      }

    }
  # No more lines in modules
  }
  close $modules
  #
  # If this was a remote repository, then we must now delete the
  # temp file.
  #
  if {$cvscfg(remote)} {
    catch {exec rm -f $cvscfg(modfile)}
  }
  # report_on_menu
  gather_mod_index
}

proc gather_mod_index {} {
#
# Creates a new global list called modlist_by_title that
# contains a sorted list of the module titles.  The module
# code is appended to the module title, separated by a tab.
#
  global mtitle
  global modlist_by_title

  if {! [info exists mtitle]} {
    set modlist_by_title {}
    return
  }

  set modlist {}

  foreach mcode [array names mtitle] {
    lappend modlist "$mtitle($mcode)\t$mcode"
  }

  set modlist_by_title [lsort $modlist]
}

proc list_mcodes {modtitle} {
#
# Returns a list of module codes that match a module title.
#
  global mtitle

  if {! [info exists mtitle]} {
    return {}
  }

  set modlist {}

  foreach mcode [array names mtitle] {
    if {$mtitle($mcode) == $modtitle} {
      lappend modlist $mcode
    }
  }

  return $modlist
}

proc clean_list {line} {
#
# Returns a list clean of null items after splitting line.
# Also removes any -<x> options and their arguments from the list.
#
# If the line is an alias line (like "myfiles -a hisfiles") then just
# return "myfiles -a".  tkCVS handles aliases as a special case.
#
# If the line contains any other options (like "myfiles -i checkinprog dir/files")
# then remove the options and their arguments (so return "myfiles dir/files"
# only).  -i/-o/etc options are supported by CVS but ignored by tkCVS.
#
# Arguments apart from options and their option arguments are preserved.
# (eg: myfiles -i ciprog dir/files my1 my2 returns myfiles dir/files my1 my2).
# These can be used to select the file names for a module.  NOTE:  THIS IS
# NOT RECOMMENDED!  CVS will not stop you attempting "cvs add" on such a
# module, but the "cvs add" will not add the file names to the module in the
# modules database!
#
# skip_args:
#   Set to 1 to skip the next item in the loop.  Do this when
#   the item is -<x> where x is not "a".
#

  set oldlist [split $line]
  set skip_args 0
  # puts stderr $oldlist

  foreach item $oldlist {
    # If the item is "-a" then completely ignore this line (don't do aliases).
    if {$item == "-a"} {
      if [info exists newlist] {
        set newlist [lindex $newlist 0]
      } else {
        set newlist "error_in_modules_file"
      }
      lappend newlist $item
      return $newlist
    }
    # If the item is any other option then skip this item and the next one.
    if [regexp {^-} $item] {
      set skip_args 1
      continue
    }
    # If the item is non-blank then process it.
    if {$item != {}} {
      # However, if the last item was an option then skip this one.
      if $skip_args {
        set skip_args 0
        continue
      }
      # Add the item to the list, or create the list if it is empty.
      if [info exists newlist] {
        lappend newlist $item
      } else {
        set newlist $item
      }
    }
  }

  if [info exists newlist] {
    # puts stderr $newlist
    return $newlist
  } else {
    return {}
  }
}

proc gets_full_line {file varname} {
#
# Gets a full line of text from file, taking into account that
# the line may be split by backslashes.
#
  upvar $varname line
  set numchars 0
  set myline ""
  set line ""

  while 1 {
    set getchars [gets $file myline]
    # If we hit the end of the file then go home.
    if {$getchars == -1} {
      if {$numchars == 0} return -1
      return $numchars
    } else {
      incr numchars $getchars
      set line [format "%s%s" $line $myline]
      if {$getchars == 0} {
        return $numchars
      }
      # If there is no trailing backslash, go home.
      if {[string index $myline [expr [string length $myline] - 1]] != "\\"} {
        return $numchars
      }
      # If there is one, chop it off and reloop.
      set line [string range $line 0 [expr [string length $line] - 2]]
      incr numchars -1
    }
  }
}

proc find_filenames {mcode} {
#
# This does the (if required) work of setting up the filenames
# array for a module, containing the list of file names within it.
#
  global filenames
  global cvsroot
  global location
  global cwd

  # If the list already exists, go home.
  if [info exists filenames($mcode)] return

  # All of this stuff must be done from within the repository, so
  # go there now.
  if [catch {cd $cvsroot/$location($mcode)}] {
    # If the directory doesn't exist, go home.
    return
  }

  # cd to the module location and find all of the files in it.
  set fd [open "|find . -type f -print"]
  while {[gets $fd line] != -1} {
    # strip off the leading "./" that find puts in.
    set fname [string range $line 2 end]
    # only bother with this if it is a ,v file.
    if [regexp {,v$} $fname] {
      # Strip off the ,v bit.
      set fname [string range $fname 0 [expr [string length $fname] - 3]]
      if [info exists filenames($mcode)] {
        lappend filenames($mcode) $fname
      } else {
        set filenames($mcode) $fname
      }
    }
  }
  catch {close $fd}

  # Go home now.
  cd $cwd
}

#
# Two recursive debug procedures can be used as templates for
# other stuff later.
#

proc report_on_menu {} {
  global dtitle

  if {! [info exists dtitle]} {
    puts "No #D lines found in modules"
    return
  }

  foreach dname [array names dtitle] {
    if {[file dirname $dname] == "."} {
      puts "$dname : $dtitle($dname) =>"
      report_on_dir $dname {  }
    }
  }
}

proc report_on_dir {dname indent} {
  global mtitle
  global dtitle
  global dcontents
  global dsubmenus

  if [info exists dsubmenus($dname)] {
    foreach subdir $dsubmenus($dname) {
      puts "$indent$subdir : $dtitle($subdir) =>"
      report_on_dir $subdir "$indent  "
    }
  }
  if [info exists dcontents($dname)] {
    foreach mname $dcontents($dname) {
      puts "$indent$mname = $mtitle($mname)"
    }
  }
}

