help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH] gst-package rewrite


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH] gst-package rewrite
Date: Fri, 22 Jun 2007 17:54:05 +0200
User-agent: Thunderbird 2.0.0.4 (Macintosh/20070604)

This package does another substantial improvement to package management, as it rewrites gst-package in Smalltalk.

scripts/Package.st is just a translation of the old script (just better because it uses objects to do the parsing). It could use a further rewrite, but this one was already quite a feat. It only emits commands to stdout, leaving the execution to gst-package.in. This is just a complication maybe, but the important part is to pave the way for installing packages as .star files, and getting rid of the broken sed-based XML parsing that gst-package was attempting.

Again, this is not complete in any way, but at least it will provide some uniform benefits from using a better XML parser -- Mike already beat me pretty hard because of this:

http://www.nabble.com/-RFC--handle-paths-in-a-saner-way-tf3186649.html#a8901274


One problem is that gst-package is not available anymore at configure time, which forced me to rewrite the creation of the stamp files used to drive the generation of documentation. In turn, this forced me to rename the blox-tk and blox-gtk directory to blox/tk and blox/gtk (just because "blox-tk_PACKAGE" is not a valid makefile variable name).

There are more improvements in the Package object model. It uses exceptions to detect unavailable packages, which makes the system more flexible. gst-package uses this to give an error on unavailable packages instead of just skipping them.

Another feature is that Package objects now store the exact same data that is available in packages.xml. This is needed to correctly derive the directory of the distributed and installed files.

Paolo
2007-06-22  Paolo Bonzini  <address@hidden>

        * kernel/PkgLoader.st: Store info in objects as it is in packages.xml,
        resolving filenames at load time.  Add DisabledPackage.
        * scripts/Package.st: New.

A/ blox
A  blox/stamp-classes
A  i18n/stamp-classes
A  kernel/stamp-classes
A  scripts/Package.st
A  tcp/stamp-classes
M  configure.ac
M  doc/Makefile.am
M  gst-package.in
M  Makefile.am
M  kernel/PkgLoader.st
M  packages.xml.in
/> blox-gtk     blox/gtk
/> blox-tk      blox/tk

* modified files

--- orig/Makefile.am
+++ mod/Makefile.am
@@ -22,13 +22,20 @@ ACLOCAL_AMFLAGS = -I build-aux
 PACKAGE=smalltalk
 
 DIST_SUBDIRS = lib-src snprintfv lightning sigsegv libffi opcode libgst \
-       i18n tcp examples blox-tk . gtk tests doc
+       i18n tcp examples blox/tk . gtk tests doc
 
 SUBDIRS = lib-src lightning $(subdirs)
 if ENABLE_DISASSEMBLER
 SUBDIRS += opcode
 endif
-SUBDIRS += libgst i18n tcp examples blox-tk . doc gtk tests
+SUBDIRS += libgst i18n tcp examples blox/tk . doc gtk tests
+
+# Running gst inside the build directory...
+
+GST_ARGUMENTS = --no-user-files --kernel-dir="@abs_top_srcdir@/kernel" \
+          --image-dir="@abs_top_builddir@"
+GST = ./gst $(GST_ARGUMENTS)
+GST_PACKAGE = GST=./gst GSTARGS='$(GST_ARGUMENTS)' ./gst-package 
--srcdir="$(srcdir)" -I gst.im 
 
 
 ###########################################################
@@ -55,8 +62,7 @@ nodist_pkgconfig_DATA = gnu-smalltalk.pc
 pkglib_DATA = libc.la
 noinst_DATA = gst.im
 dist_noinst_DATA += smalltalk-mode.el.in gst-mode.el.in .gdbinit \
-       kernel/stamp-classes blox-tk/stamp-classes tcp/stamp-classes \
-       i18n/stamp-classes scripts/Finish.st scripts/GenLibDoc.st \
+       scripts/Finish.st scripts/GenLibDoc.st \
        scripts/GenBaseDoc.st scripts/Convert.st gsticon.ico
 
 if WITH_EMACS
@@ -99,7 +105,6 @@ endif
 
 # By default, we do not build the installed VM as a shared library: it is
 # a bit slower, and on x86 we also exchange the PIC register for the frame
-# which makes the VM undebuggable except with very recent (3.4) gcc.
 gst_LDFLAGS = -export-dynamic -static
 
 nodist_noinst_HEADERS = config.h
@@ -110,11 +115,51 @@ gsticon.o: gsticon.ico
        echo ProgramIcon ICON `$(CYGPATH_W) gsticon.ico` | windres -o gsticon.o
 
 gst.im: $(bin_PROGRAMS) $(srcdir)/kernel/stamp-classes
-       ./gst --no-user-files --kernel-dir="@abs_top_srcdir@/kernel" \
-         --image-dir="@abs_top_builddir@" -iQ /dev/null
+       $(GST) -iQ /dev/null
 
 all-local:
 
+
+###########################################################
+#
+#        Stamp classes for various packages
+#
+#       Used for building the image and the documentation
+#
+###########################################################
+
+CLASS_STAMP = $(srcdir)/blox/stamp-classes $(srcdir)/tcp/stamp-classes $ \
+       $(srcdir)/i18n/stamp-classes $(srcdir)/kernel/stamp-classes
+
+blox_PACKAGE=BloxTK
+tcp_PACKAGE=TCP
+i18n_PACKAGE=I18N
+kernel_PACKAGE=Kernel
+
+-include $(srcdir)/blox/stamp-classes
+-include $(srcdir)/kernel/stamp-classes
+-include $(srcdir)/i18n/stamp-classes
+-include $(srcdir)/tcp/stamp-classes
+
+all-local: $(CLASS_STAMP)
+
+# The slow rule for building the stamp-classes files uses gst-package, and
+# depends on packages.xml in order to run# when the list of files in the
+# package might have changed.  The fast rule just touches the file.  We
+# could actually do without double-colon rules by using another stamp file
+# which depends on packages.xml and rebuilds all the stamp-classes files.
+
+$(CLASS_STAMP):: packages.xml.in
+
+$(srcdir)/%/stamp-classes: packages.xml.in
+       dir=$*; package=$($*_PACKAGE); \
+       (echo '$@:: \'; \
+         $(GST_PACKAGE) --list-files $$package packages.xml | \
+           tr -d \\r | tr \\n ' '; \
+       echo; \
+       echo '  touch $@') > $@
+
+
 ###########################################################
 #
 #        Rules for distributing the superops program
@@ -149,15 +194,20 @@ dist-hook: gst-package
          -e "s/@\(NCURSES_DISABLED\)@/disabled-/" \
          -e "s/@\(VERSION\)@/@VERSION@/" \
          $(srcdir)/packages.xml.in > $(distdir)/packages.xml
-       ./gst-package --distdir="$(distdir)" --srcdir="$(srcdir)" \
-         --dist $(distdir)/packages.xml
+       $(GST_PACKAGE) --dist --distdir="$(distdir)" packages.xml
+       @for i in $(CLASS_STAMP); do \
+         dir=`dirname $$i`; dir=`basename $$dir`; \
+         echo cp -p $$i $(distdir)/$$dir/stamp-classes; \
+         cp -p $$i $(distdir)/$$dir/stamp-classes; \
+       done
 
 # Build an image after installing the data; install-data runs after
 # install-exec, so the gst executable is already in bindir.
 install-data-hook: gst-package
        rm -f $(DESTDIR)$(pkgdatadir)/packages.xml
-       ./gst-package --srcdir="$(srcdir)" --no-load --destdir="$(DESTDIR)" \
-         --target-dir="$(pkgdatadir)" packages.xml
+       $(GST_PACKAGE) \
+         --no-load --destdir="$(DESTDIR)" --target-dir="$(pkgdatadir)" \
+         packages.xml
        $(mkdir_p) $(DESTDIR)$(imagedir)
        rm -f $(DESTDIR)$(imagedir)/gst.im
        cd $(DESTDIR)$(imagedir) && \
@@ -168,6 +218,8 @@ install-data-hook: gst-package
            "$(pkgdatadir)" "$(imagedir)" $(MODULES)
 
 uninstall-local:: gst-package
-       ./gst-package --uninstall --destdir="$(DESTDIR)" packages.xml
+       $(GST_PACKAGE) \
+         --uninstall --destdir="$(DESTDIR)" --target-dir="$(pkgdatadir)" \
+         packages.xml
        -rm -f $(DESTDIR)$(pkgdatadir)/packages.xml
        -rm -f $(DESTDIR)$(imagedir)/gst.im


--- orig/configure.ac
+++ mod/configure.ac
@@ -369,30 +369,14 @@ AC_CONFIG_FILES(packages.xml)
 AC_CONFIG_FILES(libc.la)
 
 dnl Master Makefile
-AC_CONFIG_FILES(Makefile, [
-  echo 'Makefile: packages.xml' >> Makefile
-  for i in blox-tk:BloxTK tcp:TCP i18n:I18N kernel:Kernel; do
-    package=`echo $i | sed s/.*://`
-    dir=`echo $i | sed s/:.*//`
-
-    echo
-    echo "all-local: \$(top_srcdir)/$dir/stamp-classes"
-    echo "\$(top_srcdir)/$dir/stamp-classes: \\"
-
-    ./gst-package --list-files $package packages.xml | \
-      sed -n 's,.*\.st$,& \\,p'
-
-    echo
-    echo "     echo timestamp > \$(top_srcdir)/$dir/stamp-classes"
-  done >> Makefile
-])
+AC_CONFIG_FILES(Makefile)
 
 dnl VM makefiles
 AC_CONFIG_FILES(doc/Makefile lib-src/Makefile libgst/Makefile)
 AC_CONFIG_FILES(opcode/Makefile lightning/Makefile tests/Makefile)
 
 dnl Modules makefiles
-AC_CONFIG_FILES(blox-tk/Makefile examples/Makefile)
+AC_CONFIG_FILES(blox/tk/Makefile examples/Makefile)
 AC_CONFIG_FILES(i18n/Makefile tcp/Makefile)
 AC_CONFIG_FILES(gtk/Makefile)
 


--- orig/doc/Makefile.am
+++ mod/doc/Makefile.am
@@ -39,7 +39,7 @@ $(srcdir)/gst.1: $(top_srcdir)/libgst/li
 
 PUBLISHED_NAMESPACES = Smalltalk SystemExceptions NetClients VFS
 
-$(srcdir)/blox.texi: $(top_srcdir)/blox-tk/stamp-classes
+$(srcdir)/blox.texi: $(top_srcdir)/blox/stamp-classes
        rm -f $(srcdir)/blox.texi
        cd $(srcdir) && @abs_top_builddir@/gst -I @abs_top_builddir@/gst.im \
            -f ../scripts/GenLibDoc.st BLOX BloxTK blox.texi Blox.st


--- orig/gst-package.in
+++ mod/gst-package.in
@@ -1,4 +1,5 @@
 #! /bin/sh
+
 #######################################################################
 #
 #   Smalltalk package installer
@@ -9,47 +10,49 @@
 
 #######################################################################
 #
-# Copyright 1999,2000,2001,2002
-# Free Software Foundation, Inc.
+# Copyright 2007 Free Software Foundation, Inc.
 # Written by Paolo Bonzini.
 #
-# This file is part of GNU Smalltalk
+# This file is part of GNU Smalltalk.
 #
-# GNU Smalltalk is free software; you can redistribute it
-# and/or modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2, or (at
-# your option) any later version.
+# GNU Smalltalk is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2, or (at your option) any later version.
 # 
-# The GNU Smalltalk is distributed in the hope that it will be
-# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
+# GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+# details.
 # 
-# You should have received a copy of the GNU General Public License
-# along with the GNU Smalltalk; see the file COPYING.
-# If not, write to the Free Software Foundation, 59 Temple Place - Suite
-# 330, Boston, MA 02110-1301, USA.  
-#
-#######################################################################"
+# You should have received a copy of the GNU General Public License along with
+# GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
+#
+########################################################################
+
+OPTIONS='-h|--help --version --no-load --no-install --uninstall --dist
+       -t|--target-directory: --list-files: --list-packages
+       --srcdir: --distdir|--destdir:
+       -n|--dry-run -I|--image-file:'
+
address@hidden@
address@hidden@
+: address@hidden@/gst}
 
-
-: ${prefix:address@hidden@}
-: ${exec_prefix:address@hidden@}
-: ${datarootdir:address@hidden@}
-: ${AWK:=gawk}
-: ${GST_LOAD:=${exec_prefix}/bin/gst-load}
 : address@hidden@}
+: address@hidden@}
+ mkdir_p='mkdir -p'
 
 case "$INSTALL" in
   */install-sh | *"/install-sh -c" | \
   */install.sh | *"/install.sh -c" | \
   install-sh | "install-sh -c" | \
   install.sh | "install.sh -c")
-    display_install=install
+    display_INSTALL=install
     INSTALL=func_install
     ;;
   *)
-    display_install="$INSTALL"
+    display_INSTALL="$INSTALL"
     ;;
 esac
 
@@ -101,310 +104,77 @@ mkdir_p ()
   return "$errstatus"
 }
 
-error () {
-  echo "$0": "$@" >&2
-  exit 1
+show_command () {
+  save_INSTALL=$INSTALL
+  INSTALL=$display_INSTALL
+  mkdir_p='mkdir -p'
+  eval echo "$cmd"
+  INSTALL=$save_INSTALL
+  mkdir_p='mkdir_p'
 }
 
-if test -n "$SMALLTALK_IMAGE" && test -d "$SMALLTALK_IMAGE"; then
-  install_dir=$SMALLTALK_IMAGE
-else
-  install_dir="@datadir@/@PACKAGE@"
-fi
-
-request_help=false
-request_version=false
-options_error=false
-load=:
-install=:
-dist=false
-list_files=
-uninstall=false
-dry_run=false
-DESTDIR=
-srcdir=.
-files=
-
-# Command line parsing.
-
-while [ -n "$1" ]; do
-  case $1 in
-       --v | --ve | --ver | --vers | --versi | --versio | \
-       --version)       request_version=:                 ;;
-
-       --h | --he | --hel | \
-       --help)          request_help=:                    ;;
-
-       --no-l | --no-lo | --no-loa | \
-       --no-load)       load=false                        ;;
-
-       --no-i | --no-in | --no-ins | --no-inst | \
-       --no-insta | --no-instal | \
-       --no-install)    install=false                     ;;
-
-       --u | --un | --uni | --unin | --unins | --uninst | \
-       --uninsta | --uninstal | \
-       --uninstall)     load=false; uninstall=:           ;;
-
-       --di | --dis | \
-       --dist)          load=false; dist=:                ;;
-
-        -t | --t | --ta | --tar | --targ | --targe | --target | --target- | \
-        --target-d | --target-di | --target-dir | --target-dire | \
-       --target-direc | --target-direct | --target-directo | \
-       --target-director | --target-directory)  
-                        shift; install_dir="$1" ;;
-
-        --t=* | --ta=* | --tar=* | --targ=* | --targe=* | --target=* | \
-       --target-=* | --target-d=* | --target-di=* | --target-dir=* | \
-       --target-dire=* | --target-direc=* | --target-direct=* | \
-       --target-directo=* | --target-director=* | --target-directory=*)  
-                        install_dir="`echo $1 | sed s/^[^=]*=//`" ;;
-
-        -t*)
-                        install_dir="`echo $1 | sed s/^-t//`" ;;
-
-       --l=* | --li=* | --lis=* | --list=* | --list-=* | \
-       --list-f=* | --list-fi=* | --list-fil=* | --list-file=* | \
-       --list-files=*)  list_files="$list_files `echo $1 | sed s/.*=//`"
-                                                          ;;
-
-       --l | --li | --lis | --list | --list- | \
-       --list-f | --list-fi | --list-fil | --list-file | \
-       --list-files)    shift; list_files="$list_files $1" ;;
-
-       --s | --sr | --src | --srcd | --srcdi | \
-       --srcdir)        shift; srcdir="$1"                ;;
-
-       --s=* | --sr=* | --src=* | --srcd=* | --srcdi=* | \
-       --srcdir=*)      srcdir="`echo $1 | sed s/.*=//`"  ;;
-
-       --distd | --distdi | --distdir | \
-       --de | --des | --dest | --destd | --destdi | \
-       --destdir)       shift; DESTDIR="$1"               ;;
-
-       --distd=* | --distdi=* | --distdir=* | \
-       --de=* | --des=* | --dest=* | --destd=* | --destdi=* | \
-       --destdir=*)     DESTDIR="`echo $1 | sed s/.*=//`" ;;
-
-       -n | --dr | --dry | --dry- | --dry-r | --dry-ru | \
-       --dry-run)       dry_run=:                         ;;
+# The same shell functions used in gst-load and gst-sunit.
 
-       -*)              options_error=:                   ;;
-
-       *)               files="$files $1"                 ;;
-  esac
+gst () {
+  script=$1
   shift
-done
-
-# Do --help and --version.
-
-if [ -z "$files" ] || $request_help || $options_error; then
-  cat <<EOF
-Syntax: gst-package [OPTION]... FILES...
-
-    -n, --dry-run               print commands rather than running them
-       --no-load               don't load the Smalltalk files in the image
-        --no-install            don't copy the files
-        --uninstall             remove the packages mentioned in the FILES
-        --dist                  create symbolic links of non-built files
-        --list-files PKG        just output the list of files in the package
-       --srcdir DIR            look for non-built files in directory DIR
-       --distdir DIR           for --dist, place files in directory DIR
-       --destdir DIR           prefix the destination directory with DIR
-        --target-directory DIR  install the files in DIR (unused for --dist)
-
-       --help                  display this message and exit
-       --version               print version information and exit
-
-Except in uninstall and list files mode, gst-package requires write
-access to the \`packages.xml' file in the GNU Smalltalk image directory,
-and merges the XML package files on the command line with that file.
-
-The default target directory is $install_dir.
-
-EOF
-  # Unless --help was passed, return an error.
-  $request_help && exit 0
-  exit 1
-fi
-
-if $request_version; then
-  echo GNU Smalltalk package installer, version @VERSION@
-  exit 0
-fi
-
-# Process --list-files now, then exit.
-
-if [ -n "$list_files" ]; then
-  for pkg in $list_files; do
-    dir="`sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-            -e 's,.*<directory>\([^<]*\)<.directory>,\1,p' $files | sed 1q`"
-
-    sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-       -e 's,.*<built-file>\([^<]*[^/]\)<.built-file>,\1,p' \
-       -e 's,.*<file>\([^<]*[^/]\)<.file>,\1,p' $files | while read file; do
-      case $file in
-        /*) echo "$file" ;;
-       *) echo "$dir/$file" ;;
-      esac
-    done
-  done
-  exit 0
-fi
-
-# Create the installation directory.
-
-if $dist; then
-  install_dir=
-  if test -z "$DESTDIR"; then
-    error Using --dist without specifying --distdir 
+  if test x${image_file:+set} = xset; then
+    eval \"\$GST\" "$GSTARGS" -I \"\$image_file\" -qK \"\$script\" -a 
\"address@hidden"
   else
-    mkdir_p "$DESTDIR"
+    eval \"\$GST\" "$GSTARGS" -qK \"\$script\" -a \"address@hidden"
   fi
-else
-  case $install_dir in
-    /*)
-      mkdir_p "$DESTDIR$install_dir"
-      ;;
-    *)
-      if test -z "$DESTDIR"; then
-        mkdir_p "$install_dir"
-        (cd "$install_dir" 2> /dev/null && install_dir=`pwd`)
-      else
-        error Target directory must be absolute when DESTDIR is used
-      fi
-      ;;
-  esac
-fi
-
-
-# Extract the name of the packages to be (un)installed.
-
-pkgs=`sed -e '/<name>/!d' \
-          -e 's,.*<name>\([^<]*\)<.name>,\1 ,' $files `
-
-if $uninstall; then
-  for pkg in $pkgs; do
-    dir="`sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-            -e 's,.*<directory>\([^<]*\)<.directory>,\1,p' $files | sed 1q`"
-
-    sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-       -e 's,.*<built-file>\([^<]*[^/]\)<.built-file>,\1,p' \
-       -e 's,.*<file>\([^<]*[^/]\)<.file>,\1,p' $files | while read file; do
-      case $file in
-        /*) dest=$DESTDIR$file ;;
-       *) dest="$DESTDIR$install_dir/$dir/$file" ;;
-      esac
+} 
 
-      echo "rm -f $dest"
-      $dry_run || rm -f "$dest"
-    done
-  done
-  exit 0
-fi
+show_help () {
+  eval \"\$GST\" "$GSTARGS" -qK scripts/Package.st -a \$1
+  exit $?
+}
 
-# If we are installing, add packages.xml to the list
-# and merge the supplied packages files with it
+getopt () {
+  eval \"\$GST\" "$GSTARGS" -qK scripts/Getopt.st -a \"\$OPTIONS\" 
\"address@hidden"
+}
 
-if $dist; then
-  :
-else
-  base="$DESTDIR$install_dir/packages.xml"
-  if test -f $base; then
-    merged_files="$base"
-    for file in $files; do
-      test $file -ef $base || merged_files="$merged_files $file"
-    done
-  else
-    merged_files="$files"
-  fi
+getopt "$@" | {
+  load_dry_run=
+  load_test=
+  list=false
+  run_cmd=eval
+  files=
+  srcdir=
+  while read opt arg; do
+    case $opt in
+      ERROR) show_help --bad ;;
+      --help) show_help --help ;;
+      --dist | --uninstall | --no-load) load_dry_run=-n ;;
+      --test) load_test=--test ;;
+      --dry-run) run_cmd=: ;;
+      --list-files) list=: ;;
+      --list-packages) list=: ;;
+      --srcdir) srcdir=$arg ;;
+      --image-file)
+       test x${image_file:+set} = xset && show_help --bad
+       image_file=$arg ;;
+      --) files="$files '$arg'" ;;
+    esac
+  done
 
-  echo "Merging $files into $base..."
-  $dry_run || {
-    sed -e '$i\
-</packages>' -e '/<.packages>/,/<packages>/d' $merged_files > packages.tmp
-
-    mv packages.tmp $DESTDIR$install_dir/packages.xml
-  }
-fi
-
-if $install; then
-  for pkg in $pkgs; do
-    dir="`sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-            -e 's,.*<directory>\([^<]*\)<.directory>,\1,p' $files | sed 1q`"
-    dirs="`sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-             -e 's,.*<built-file>\([^<]*\)/<.built-file>,\1,p' \
-             -e 's,.*<file>\([^<]*\)/<.file>,\1,p' $files `"
-
-    for subdir in . $dirs; do
-      case $subdir in
-        /*) dest=$DESTDIR$subdir ;;
-       *) dest=$DESTDIR$install_dir/$dir/$subdir ;;
-      esac
+  set -e
 
-      mkdir_p "$dest"
+  if $list; then
+    gst scripts/Package.st "$@"
+  else
+    gst scripts/Package.st "$@" | while read cmd; do
+      show_command "$cmd"
+      $run_cmd "$cmd"
     done
 
-    if $dist; then
-      wd=`cd $srcdir && pwd`
-      sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-         -e 's,.*<file>\([^<]*[^/]\)<.file>,\1,p' $files | while read file; do
-        case $file in
-          /*)
-          dest=$DESTDIR$file
-          orig_file=$file ;;
-         *)
-          dest="$DESTDIR/$dir/$file"
-          file=$dir/$file
-          orig_file=$file
-          if test -f $file; then file=`pwd`/$file; else file=$wd/$file; fi ;;
-        esac
-
-       test -f "$file" || {
-         echo gst-package: "$orig_file" not found
-         exit 1
-       }
-
-        echo "@LN_S@ -f $file $dest"
-        $dry_run || @LN_S@ -f "$file" "$dest"
-      done
-
-    else
-      sed -ne '/<name>'"$pkg"'<.name>/,/<.*package>/!d' \
-         -e 's,.*<built-file>\([^<]*[^/]\)<.built-file>,\1,p' \
-         -e 's,.*<file>\([^<]*[^/]\)<.file>,\1,p' $files | while read file; do
-        case "$file" in
-          /*)
-           dest="$DESTDIR$file"
-           orig_file=$file ;;
-         *)
-           dest="$DESTDIR$install_dir/$dir/$file"
-           file=$dir/$file
-           orig_file=$file
-           test -f "$file" || file=$srcdir/$file ;;
-        esac
-
-       test -f "$file" || {
-         echo gst-package: "$orig_file" not found
-         exit 1
-       }
-
-        if test -x "$file"; then
-         echo "$display_install -m 755 $file $dest"
-          $dry_run || $INSTALL -m 755 "$file" "$dest"
-       else
-         echo "$display_install -m 644 $file $dest"
-          $dry_run || $INSTALL -m 644 "$file" "$dest"
-       fi
-      done
+    if test "$run_cmd" = eval && test "$load_test,$load_dry_run" != ,-n; then
+      packages=`eval gst scripts/Package.st \
+               ${srcdir:+"--srcdir=$srcdir"} \
+               --list-packages "$files" `
+      "@bindir@/gst-load" \
+               ${image_file:+"--image-file=$image_file"} \
+               $load_dry_run $load_test $packages
     fi
-  done
-fi
-
-if $load && [ -n "$pkgs" ]; then
-  echo ${GST_LOAD} $pkgs
-  $dry_run || ${GST_LOAD} $pkgs
-fi
-
-exit 0
+  fi
+}


--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -33,6 +33,20 @@
 
 Namespace current: Kernel!
 
+Notification subclass: #PackageSkip
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Language-Packaging'
+!
+
+Exception subclass: #PackageNotAvailable
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Language-Packaging'
+!
+
 Object subclass: #PackageGroup
        instanceVariableNames: ''
        classVariableNames: ''
@@ -96,7 +110,7 @@ XML.'!
 Namespace current: Smalltalk!
 
 Kernel.PackageInfo subclass: #Package
-       instanceVariableNames: 'features prerequisites builtFiles files fileIns 
directory libraries modules callouts namespace sunitScripts test'
+       instanceVariableNames: 'features prerequisites builtFiles files fileIns 
relativeDirectory baseDirectories libraries modules callouts namespace 
sunitScripts test'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Language-Packaging'
@@ -107,6 +121,22 @@ Package comment:
 information on a Smalltalk package, and can output my description in
 XML.'!
 
+Namespace current: Kernel!
+
+Package subclass: #DisabledPackage
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Language-Packaging'
+!
+
+DisabledPackage comment:
+'I am not part of a standard Smalltalk system. I store internally the
+information on a Smalltalk package, and can output my description in
+XML.'!
+
+Namespace current: Smalltalk!
+
 Object subclass: #PackageLoader
        instanceVariableNames: ''
        classVariableNames: ''
@@ -132,7 +162,7 @@ printOn: aStream
     self
        do: [ :each |
            aStream space: 2.
-           each printOn: aStream tag: 'package' indent: 2.
+           each printOn: aStream indent: 2.
            aStream nl ]
        separatedBy: [ aStream nl ].
     aStream nextPutAll: '</packages>'
@@ -222,6 +252,12 @@ new
     ^super new initialize
 ! !
 
+!Kernel.PackageDirectories methodsFor: 'copying'!
+
+postCopy
+    dirs := dirs copy
+! !
+
 !Kernel.PackageDirectories methodsFor: 'accessing'!
 
 add: aDirectory
@@ -317,21 +353,38 @@ refresh
     "Private - Process the XML source in the packages file, creating
      Package objects along the way."
 
-    | cdata file stack ch tag package allDirs |
+    packages := LookupTable new.
+    self refreshPackageList.
+    self refreshStarList
+!
+
+refreshPackageList
+    | file allDirs |
     allDirs := Smalltalk imageLocal
        ifTrue: [ { Directory image }, baseDirectories ]
        ifFalse: [ baseDirectories ].
+
     allDirs isEmpty ifTrue: [ ^self ].
 
     file := [ FileStream open: fileName mode: FileStream read ]
        on: Error
        do: [ :ex | ^self ].
 
-    packages := LookupTable new.
-    [ self parse: file baseDirectories: allDirs ]
+    [
+        [ self parse: file baseDirectories: allDirs ]
+           on: PackageNotAvailable
+           do: [ :ex | ex resignalAs: PackageSkip new ] ]
         ensure: [ file close ].
 
-    (Directory name: (File pathFor: fileName))
+    packages := packages reject: [ :each | each isDisabled ]
+!
+
+refreshStarList
+    | dir |
+    dir := Directory name: (File pathFor: fileName).
+    dir exists ifFalse: [ ^self].
+
+    dir
        namesMatching: '*.star'
        do: [ :starName |
            | package |
@@ -362,13 +415,25 @@ parse: file baseDirectories: baseDirs
            open
                ifFalse: [
                    tag := file upTo: $>.
-                   tag = 'packages' ifFalse: [ ^self error: 'expected packages 
tag' ].
+                   tag = 'packages' ifFalse: [
+                       ^self error: 'expected packages tag' ].
+                   tag = 'package' ifTrue: [
+                       package := Package new parse: file tag: 'package' ].
                    open := true ]
                ifTrue: [
                    file skip: -1.
-                   package := Package parse: file.
-                   (package notNil and: [ package baseDirectories: baseDirs ])
-                       ifTrue: [ packages at: package name put: package ] ] ] ]
+                   package := Package parse: file ].
+
+           package notNil ifTrue: [
+               package name isNil ifTrue: [
+                   ^self error: 'missing package name in ', fileName ].
+
+               [
+                   package baseDirectories: baseDirs.
+                   packages at: package name put: package ]
+                       on: PackageSkip
+                       do: [ :ex | ex return ] ].
+           package := nil ] ]
 ! !
 
 
@@ -397,7 +462,11 @@ printXmlOn: aStream collection: aCollect
     ]!
 
 printOn: aStream
-    self printOn: aStream tag: 'package' indent: 0
+    self printOn: aStream indent: 0
+!
+
+printOn: aStream indent: indent
+    self printOn: aStream tag: 'package' indent: indent
 !
 
 printOn: aStream tag: tag indent: indent
@@ -466,11 +535,11 @@ printOn: aStream tag: tag indent: indent
        collection: self modules asSortedCollection
        tag: 'module'
        indent: indent.
-    self directory isNil
+    self relativeDirectory isNil
        ifFalse: [
            aStream
                nextPutAll: '  <directory>';
-               nextPutAll: self directory;
+               nextPutAll: self relativeDirectory;
                nextPutAll: '</directory>';
                nl; space: indent ].
 
@@ -557,6 +626,11 @@ callouts
      modules are loaded so that you can do a kind of versioning."
     self subclassResponsibility!
 
+relativeDirectory
+    "Answer the directory from which to load the package, relative to the 
package
+     file."
+    self subclassResponsibility!
+
 directory
     "Answer the base directory from which to load the package."
     self subclassResponsibility!
@@ -627,6 +701,9 @@ callouts
      modules are loaded so that you can do a kind of versioning."
     ^self loadedPackage callouts!
 
+relativeDirectory
+    ^'.'!
+
 directory
     ^fileName, '#uzip'!
 
@@ -649,6 +726,7 @@ loadedPackage
     package isNil ifTrue: [
        ^self error: 'invalid disabled-package tag inside a star file' ].
 
+    package relativeDirectory: self relativeDirectory.
     package baseDirectories: { self directory }.
     package name isNil
        ifTrue: [ package name: self name ]
@@ -677,29 +755,39 @@ parse: file
 
        ch isAlphaNumeric ifTrue: [
            tag := file upTo: $>.
-           tag = 'package' ifTrue: [ ^Package new parse: file tag: tag ].
-           tag = 'disabled-package' ifTrue: [ Package new parse: file tag: 
tag. ^nil ].
+           tag = 'package'
+               ifTrue: [ ^Package new parse: file tag: tag ].
+           tag = 'disabled-package'
+               ifTrue: [ ^DisabledPackage new parse: file tag: tag ].
         ]
     ] repeat
 ! !
 
 !Package methodsFor: 'accessing'!
 
+isDisabled
+    ^false
+!
+
 test
     "Answer the test sub-package."
     ^test!
 
 test: aPackage
     "Set the test sub-package to be aPackage."
-    aPackage test isNil ifFalse: [
-       self error: 'test packages must not be nested' ].
-    aPackage name isNil ifFalse: [
-       self error: 'test package must not have names' ].
+    aPackage test isNil
+       ifFalse: [ self error: 'test packages must not be nested' ].
+    aPackage name isNil
+       ifFalse: [ self error: 'test package must not have names' ].
+
     aPackage prerequisites add: 'SUnit'; add: self name.
-    aPackage directory isNil ifTrue: [
-        aPackage directory: self directory ].
-    aPackage namespace isNil ifTrue: [
-        aPackage namespace: self namespace ].
+    aPackage namespace isNil
+       ifTrue: [ aPackage namespace: self namespace ].
+    aPackage relativeDirectory isNil
+       ifTrue: [ aPackage relativeDirectory: self relativeDirectory ].
+
+    self baseDirectories isNil ifFalse: [
+        aPackage baseDirectories: self baseDirectories ].
     test := aPackage!
 
 namespace
@@ -764,12 +852,17 @@ callouts
     callouts isNil ifTrue: [ callouts := Set new ].
     ^callouts!
 
-baseDirectories: baseDirectories
-    "Resolve the names in the package according to the base directories
-     in baseDirectories, which depend on where the packages.xml is found:
-     the three possible places are 1) the system kernel directory's parent
-     directory, 2) the local kernel directory's parent directory, 3) the
-     local image directory (in order of decreasing priority).
+baseDirectories
+    ^baseDirectories
+!
+
+baseDirectories: aCollection
+    "Check if it's possible to resolve the names in the package according to
+     the base directories in baseDirectories, which depend on where
+     the packages.xml is found: the three possible places are 1) the
+     system kernel directory's parent directory, 2) the local kernel
+     directory's parent directory, 3) the local image directory (in
+     order of decreasing priority).
 
      For a packages.xml found in the system kernel directory's parent
      directory, all three directories are searched.  For a packages.xml
@@ -777,56 +870,62 @@ baseDirectories: baseDirectories
      directories 2 and 3 are searched.  For a packages.xml directory in
      the local image directory, instead, only directory 3 is searched."
 
-    files := self findBaseDirs: baseDirectories for: self files.
-    fileIns := self findBaseDirs: baseDirectories for: self fileIns.
-    builtFiles := self findBaseDirs: baseDirectories for: self builtFiles.
-
-    (self test notNil and: [ (self test baseDirectories: baseDirectories) not 
])
-       ifTrue: [ ^false ].
-
-    files isNil | fileIns isNil | builtFiles isNil ifTrue: [ ^false ].
-
-    self directory isNil ifFalse: [
-        baseDirectories
-           do: [ :dir || name |
-                name := Directory append: self directory to: dir.
-                name := Directory append: self directory to: dir.
-                (Directory exists: name) ifTrue: [ directory := name. ^true ] 
] ].
+    baseDirectories := aCollection.
+    self findPathsFor: self files.
+    "self findPathsFor: self fileIns."
+    "self findPathsFor: self builtFiles."
+    self directory.
 
-    ^false
+    self test notNil ifTrue: [ self test baseDirectories: aCollection ].
 !
 
-findBaseDirs: baseDirectories for: aCollection
+findPathsFor: aCollection
     "Resolve the names in aCollection according to the base directories
      in baseDirectories, and return the collection with the full filenames, or
      nil if no directory was found for one or more file in aCollection."
     ^aCollection collect: [ :fileName || name |
-        name := self findBaseDirs: baseDirectories forFile: fileName.
-        name isNil ifTrue: [ ^nil ] ifFalse: [ name ]]
+        name := self findPathFor: fileName ]
 !
 
-findBaseDirs: baseDirectories forFile: fileName
+findPathFor: fileName
     "Try appending 'self directory' and fileName to each of the directory
      in baseDirectories, and return the path to the first tried filename that
      exists.  Return nil if no directory is found that contains the file."
     | name |
     baseDirectories do: [ :dir |
        name := dir.
-       self directory isNil ifFalse: [
-            name := Directory append: self directory to: dir ].
+       self relativeDirectory isNil ifFalse: [
+            name := Directory append: self relativeDirectory to: dir ].
         name := Directory append: fileName to: name.
         (File exists: name) ifTrue: [ ^name ] ].
-    ^nil
+
+    "TODO: should put the name and baseDirectories into the exception."
+    "name printNl.  baseDirectories printNl."
+    PackageNotAvailable signal: self
 !
 
 
 directory
     "Answer the base directory from which to load the package."
-    ^directory!
 
-directory: dir
-    "Set the base directory from which to load the package to dir."
-    directory := dir!
+    self relativeDirectory isNil ifTrue: [ ^nil ].
+
+    self baseDirectories
+       do: [ :dir || name |
+            name := Directory append: self relativeDirectory to: dir.
+            (Directory exists: name) ifTrue: [ ^name ] ].
+
+    PackageNotAvailable signal: self!
+
+relativeDirectory
+    "Answer the directory, relative to the packages file, from which to load
+     the package."
+    ^relativeDirectory!
+
+relativeDirectory: dir
+    "Set the directory, relative to the packages file, from which to load
+     the package, to dir."
+    relativeDirectory := dir!
 
 createNamespace
     "Private - Create the path of namespaces indicated by our
@@ -847,12 +946,14 @@ loaded
 primFileIn
     "Private - File in the given package without paying attention at
      dependencies and C callout availability"
-    | dir namespace |
 
+    | dir namespace |
     self loaded ifTrue: [ ^self ].
+
+    dir := Directory working.
+    namespace := Namespace current.
     [
-        dir := Directory working.
-        namespace := Namespace current.
+        | loadedFiles |
         Namespace current: self createNamespace.
         self directory isNil ifFalse: [ Directory working: self directory ].
         self libraries do: [ :each | DLD addLibrary: each ].
@@ -863,7 +964,8 @@ primFileIn
                 (CFunctionDescriptor isFunction: func)
                     ifFalse: [ ^self error: 'C callout not available: ', func 
]]].
 
-        self fileIns do: [ :each | FileStream fileIn: each ].
+        loadedFiles := self findPathsFor: self fileIns.
+       loadedFiles do: [ :each | FileStream fileIn: each ].
         self name isNil ifFalse: [ Smalltalk addFeature: self name ].
         self features do: [ :each | Smalltalk addFeature: each ].
     ] ensure: [
@@ -897,7 +999,7 @@ parse: file tag: openingTag
                tag = 'prereq' ifTrue: [ self prerequisites add: cdata ] 
ifFalse: [
                tag = 'provides' ifTrue: [ self features add: cdata ] ifFalse: [
                tag = 'module' ifTrue: [ self modules add: cdata ] ifFalse: [
-               tag = 'directory' ifTrue: [ self directory: cdata ] ifFalse: [
+               tag = 'directory' ifTrue: [ self relativeDirectory: cdata ] 
ifFalse: [
                tag = 'name' ifTrue: [ self name: cdata ] ifFalse: [
                tag = 'namespace' ifTrue: [ self namespace: cdata ] ifFalse: [
                tag = 'library' ifTrue: [ self libraries add: cdata ] ifFalse: [
@@ -930,6 +1032,16 @@ parse: file tag: openingTag
     ]
 ! !
 
+!Kernel.DisabledPackage methodsFor: 'accessing'!
+
+printOn: aStream indent: indent
+    self printOn: aStream tag: 'disabled-package' indent: indent
+!
+
+isDisabled
+    ^true
+! !
+
 
 !PackageLoader class methodsFor: 'accessing'!
 


--- orig/packages.xml.in
+++ mod/packages.xml.in
@@ -55,8 +55,8 @@
   <filein>BloxText.st</filein>
   <filein>BloxExtend.st</filein>
   <filein>Blox.st</filein>
-  <filein>../browser/test.st</filein>
-  <directory>blox-gtk</directory>
+  <filein>../../browser/test.st</filein>
+  <directory>blox/gtk</directory>
 
   <file>Blox.st</file>
   <file>BloxBasic.st</file>
@@ -76,9 +76,9 @@
   <filein>BloxCanvas.st</filein>
   <filein>BloxExtend.st</filein>
   <filein>Blox.st</filein>
-  <filein>../browser/test.st</filein>
+  <filein>../../browser/test.st</filein>
   <module>blox-tk</module>
-  <directory>blox-tk</directory>
+  <directory>blox/tk</directory>
 
   <file>Blox.st</file>
   <file>BloxBasic.st</file>
@@ -642,7 +642,6 @@
   <file>LazyCollection.st</file>
   <file>Man.st</file>
   <file>Tetris.st</file>
-  <file>Generator.st</file>
   <file>Gen2.st</file>
   <file>Lisp.st</file>
   <file>Queens.st</file>
@@ -791,7 +790,6 @@
   <file>Regex.st</file>
   <file>StreamOps.st</file>
 
-  <file>../vfs/</file>
   <file>../vfs/README</file>
   <file>../vfs/deb</file>
   <file>../vfs/lslR</file>
@@ -812,6 +810,7 @@
 
   <file>Test.st</file>
   <file>Load.st</file>
+  <file>Package.st</file>
   <file>Getopt.st</file>
 </disabled-package>
 



* added files

--- /dev/null
+++ mod/scripts/Package.st
@@ -0,0 +1,248 @@
+"======================================================================
+|
+|   Smalltalk package installer
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+
+Kernel.PackageDirectory subclass: PackageFile [
+    refreshStarList []
+
+    refreshPackageList [
+        | file |
+       file := FileStream open: fileName mode: FileStream read.
+       [ self parse: file baseDirectories: baseDirectories ]
+           ensure: [ file close ].
+    ]
+]
+
+Kernel.PackageDirectories subclass: PackageFiles [
+    | srcdir |
+
+    addAllFiles: aCollection [
+       aCollection do: [ :each | self addFile: each ]
+    ]
+
+    addFile: fileName [
+       | packageFile |
+       packageFile := PackageFile
+           on: fileName
+           baseDirectories: (self baseDirsFor: fileName).
+
+       packageFile refresh.
+       self add: packageFile.
+    ]
+
+    baseDirsFor: fileName [
+       ^self srcdir isNil
+           ifTrue: [ { (File name: fileName) path } ]
+           ifFalse: [ { (File name: fileName) path. srcdir } ]
+    ]
+
+    srcdir [
+       ^srcdir
+    ]
+
+    srcdir: aString [
+       srcdir := aString
+    ]
+]
+
+File extend [
+    emitRemove [
+       ('rm -f %1' bindWith: self) displayNl
+    ]
+
+    emitSymlink: dest [
+       self isDirectory ifTrue: [ ^(Directory name: dest) emitMkdir ].
+
+       ('cp -pf %1 %2'
+               bindWith: self
+               with: (File name: dest)) displayNl
+    ]
+
+    emitInstall: dest [
+       | mode |
+       mode := self isExecutable ifTrue: [ 8r755 ] ifFalse: [ 8r644 ].
+       ('$INSTALL -m %1 %2 %3'
+               bindWith: (mode printString: 8)
+               with: self
+               with: (File name: dest)) displayNl
+    ]
+]
+
+Directory extend [
+    emitMkdir [
+       ('$mkdir_p %1' bindWith: self) displayNl
+    ]
+]
+
+| installDir mode listFiles destdir files packageFiles helpString |
+
+mode := #install.
+listFiles := OrderedCollection new.
+installDir := Directory image.
+destdir := ''.
+packageFiles := OrderedCollection new.
+packages := PackageFiles new.
+
+helpString := 
+'Usage:
+    gst-package [OPTION]... FILES...
+
+    -n, --dry-run               print commands rather than running them
+       --test                  run unit tests after merging
+       --no-load               don''t load the Smalltalk files in the image
+        --uninstall             remove the packages mentioned in the FILES
+        --dist                  create symbolic links of non-built files
+        --list-files PKG        just output the list of files in the package
+        --list-packages         just output the list of packages in the files
+       --srcdir DIR            look for non-built files in directory DIR
+       --distdir DIR           for --dist, place files in directory DIR
+       --destdir DIR           prefix the destination directory with DIR
+        --target-directory DIR  install the files in DIR (unused for --dist)
+
+       --help                  display this message and exit
+       --version               print version information and exit
+
+Except in uninstall and list files mode, gst-package requires write
+access to the GNU Smalltalk image directory, and merges the XML package
+files on the command line with that file.
+
+The default target directory is $install_dir.'.
+
+[
+    Smalltalk
+        "--no-load, --image-file, --dry-run are processed by gst-package."
+        arguments: '-h|--help --no-load --uninstall --dist
+            -t|--target-directory: --list-files: --list-packages
+            --srcdir: --distdir|--destdir: -n|--dry-run -I|--image-file:'
+
+        do: [ :opt :arg |
+            opt = 'help' ifTrue: [
+                helpString displayOn: stderr.
+                ObjectMemory quit: 0 ].
+
+            opt = 'uninstall' ifTrue: [ mode := #uninstall ].
+            opt = 'dist' ifTrue: [ mode := #dist ].
+            opt = 'target-directory' ifTrue: [ installDir := arg ].
+            opt = 'list-files' ifTrue: [ listFiles add: arg ].
+            opt = 'list-packages' ifTrue: [ mode := #list ].
+            opt = 'srcdir' ifTrue: [ packages srcdir: arg ].
+            opt = 'destdir' ifTrue: [ destdir := arg ].
+
+            opt isNil ifTrue: [ packageFiles add: arg ] ].
+
+    "Validate the installation and source directory."
+    mode = #dist
+        ifTrue: [
+           destdir isEmpty ifTrue: [
+               self error: 'using --dist without specifying --distdir' ].
+           installDir := '' ]
+        ifFalse: [
+           ((Directory name: installDir) name ~= installDir
+               and: [ destdir notEmpty ]) ifTrue: [
+                   self error: '--destdir used with relative target directory' 
] ].
+
+    packages addAllFiles: packageFiles.
+
+    "Process --uninstall, --list-packages, --list-files now, then exit."
+    mode = #uninstall ifTrue: [
+        packages do: [ :each || baseDir |
+           baseDir := Directory append: each relativeDirectory to: installDir.
+           each allFiles do: [ :file || destName |
+               destName := destdir, (Directory append: file to: baseDir).
+               (File name: destName) emitRemove ] ].
+
+        ObjectMemory quit ].
+
+    mode = #list ifTrue: [
+        packages do: [ :each | each name displayNl ].
+        ObjectMemory quit ].
+
+    listFiles isEmpty ifFalse: [
+        listFiles do: [ :each || package |
+           package := packages at: each.
+           package allFiles do: [ :file |
+               (package findPathFor: file) displayNl ] ].
+        ObjectMemory quit ].
+
+
+    "Create the installation directory.  Then, if we are installing, add
+     packages.xml to the list and merge the supplied packages files with it.
+     This is temporary, as installation will create .star packages later on."
+
+    installDir := destdir, installDir.
+    (Directory name: installDir) emitMkdir.
+
+    "This is also temporary.  To merge the packages.xml file, we need to
+     really create the file.  This screws up --dry-run but, again, it's
+     temporary."
+    ((Directory name: installDir) name subStrings: $/)
+       inject: (Directory name: '/')
+       into: [ :old :each || dir |
+           dir := old directoryAt: each.
+           dir exists ifFalse: [ dir := Directory create: dir name ].
+           dir ].
+
+    mode = #dist ifFalse: [
+        | destFile mergeResult |
+        destFile := File name: installDir, '/packages.xml'.
+       mergeResult := packages copy.
+        destFile exists ifTrue: [
+           "In this case, we can pass problematic packages through."
+           [ mergeResult addFile: destFile name ]
+               on: Kernel.PackageNotAvailable
+               do: [ :ex | ex resume ] ].
+
+        destFile withWriteStreamDo: [ :s | mergeResult printOn: s ] ].
+
+    packages do: [ :each || dirs files baseDir |
+       files := mode = #dist
+           ifTrue: [ each files ]
+           ifFalse: [ each allFiles ].
+
+        dirs := files collect: [ :file |
+           Directory append: (File pathFor: file) to: each relativeDirectory ].
+
+        dirs asSet asSortedCollection do: [ :dir |
+           destName := Directory append: dir to: installDir.
+           (Directory name: destName) emitMkdir ].
+
+       baseDir := Directory append: each relativeDirectory to: installDir.
+        files do: [ :file || srcFile destName |
+           srcFile := File name: (each findPathFor: file).
+           destName := Directory append: file to: baseDir.
+
+            mode = #dist
+               ifTrue: [ srcFile emitSymlink: destName ]
+               ifFalse: [ srcFile emitInstall: destName ] ] ]
+]
+    on: Error
+    do: [ :ex |
+       ('gst-package: ', ex messageText) displayOn: stderr.
+       "ex pass." ObjectMemory quit: 1 ].


reply via email to

[Prev in Thread] Current Thread [Next in Thread]