/*  Part of XPCE --- The SWI-Prolog GUI toolkit

    Author:        Jan Wielemaker and Anjo Anjewierden
    E-mail:        jan@swi.psy.uva.nl
    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    Copyright (c)  1985-2002, University of Amsterdam
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

#include <h/kernel.h>
#include <h/unix.h>

#ifdef HAVE_UNISTD_H
#include <sys/types.h>
#include <unistd.h>
#endif

#if HAVE_DIRENT_H
# include <dirent.h>
# define NAMLEN(dirent) strlen((dirent)->d_name)
#else
# define dirent direct
# define NAMLEN(dirent) (dirent)->d_namlen
# if HAVE_SYS_ACCESS_H
#  include <sys/access.h>
# endif
# if HAVE_SYS_NDIR_H
#  include <sys/ndir.h>
# endif
# if HAVE_SYS_DIR_H
#  include <sys/dir.h>
# endif
# if HAVE_NDIR_H
#  include <ndir.h>
# endif
#endif

#include <sys/stat.h>
#include <errno.h>

#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
#ifndef PATH_MAX
#define PATH_MAX 1024
#endif

static Chain DirectoryStack;
static Name  ExpandProblem;

static char *	canonicalisePath(char *);
static Name	getWorkingDirectoryPce(Pce pce);

#define MODIFIED_NOT_SET ((time_t) ~0L)

static status
initialiseDirectory(Directory d, Name name)
{ char path[PATH_MAX];
  Name expanded;
  const char *ufn;

  if ( !(expanded = expandFileName(name)) )
    fail;

  ufn = nameToUTF8(expanded);
  if ( absolutePath(ufn, path, sizeof(path)) < 0 )
    return errorPce(d, NAME_representation, NAME_nameTooLong);

  assign(d, path, UTF8ToName(path));
  assign(d, name, UTF8ToName(baseName(ufn)));
  d->modified = MODIFIED_NOT_SET;

  succeed;
}


static Directory
getConvertDirectory(Class class, Name name)
{ answer(answerObject(ClassDirectory, name, EAV));
}


static status
storeDirectory(Directory d, FileObj file)
{ return storeSlotsObject(d, file);
}


static status
loadDirectory(Directory d, IOSTREAM *fd, ClassDef def)
{ TRY(loadSlotsObject(d, fd, def));

  d->modified = MODIFIED_NOT_SET;
  succeed;
}


static status
existsDirectory(Directory d)
{
#ifdef O_XOS
  return _xos_exists(nameToFN(d->path), _XOS_DIR);
#else
  STAT_TYPE buf;

  if ( STAT_FUNC(nameToFN(d->path), &buf) == -1 ||
       (buf.st_mode & S_IFMT) != S_IFDIR )
    fail;

  succeed;
#endif
}


static status
makeDirectory(Directory d)
{ if ( !existsDirectory(d) )
  { if ( mkdir(nameToFN(d->path), 0777) != 0 )
      return errorPce(d, NAME_mkdir, getOsErrorPce(PCE));
  }

  succeed;
}


static status
removeDirectory(Directory d)
{ if ( rmdir(nameToFN(d->path)) != 0 )
  { if ( existsDirectory(d) )
      return errorPce(d, NAME_rmdir, getOsErrorPce(PCE));
  }

  succeed;
}


status
cdDirectory(Directory d)
{ if ( chdir(nameToFN(d->path)) != 0 )
    return errorPce(d, NAME_chdir, d->path, getOsErrorPce(PCE));

  succeed;
}


static status
pushDirectory(Directory d)
{ Name cwd;

  assert(DirectoryStack);
  TRY(cwd = getWorkingDirectoryPce(PCE));
  if ( cdDirectory(d) )
    return prependChain(DirectoryStack, cwd);

  fail;
}


static status
popDirectory(Directory d)
{ Name path;

  if ( emptyChain(DirectoryStack) )
    return errorPce(d, NAME_stackEmpty);

  path = getHeadChain(DirectoryStack);
  deleteHeadChain(DirectoryStack);

  if ( chdir(nameToFN(path)) )
    return errorPce(d, NAME_chdir, path, getOsErrorPce(PCE));

  succeed;
}


static status
scanDirectory(Directory d, Chain files, Chain dirs, Regex pattern, BoolObj all)
{ DIR *dirp;
  struct dirent *dp;

  if ( notDefault(pattern) )
  { if ( getFeatureClass(ClassFile, NAME_caseSensitive) == OFF )
      ignoreCaseRegex(pattern, ON);
  }

  if ( files != dirs )
  { TRY(pushDirectory(d));
    if ( !(dirp = opendir(".")) )
    { errorPce(d, NAME_readDirectory, getOsErrorPce(PCE));
      popDirectory(d);
      fail;
    }

    for (dp=readdir(dirp); dp!=NULL; dp=readdir(dirp))
    { char *name = dp->d_name;
#ifndef O_XOS
      STAT_TYPE buf;

      if ( STAT_FUNC(name, &buf) != 0 )
	continue;
#endif

      if ( notNil(files) &&
#ifdef O_XOS
	   _xos_exists(name, _XOS_FILE) == TRUE
#else
	   (buf.st_mode & S_IFMT) == S_IFREG
#endif
	 )
      { if ( notDefault(pattern) )
	{ CharArray ca = CtoScratchCharArray(name);
					/* TBD: UNICODE */
	  if ( !searchRegex(pattern, ca, DEFAULT, DEFAULT) )
	  { doneScratchCharArray(ca);
	    continue;
	  }
	  doneScratchCharArray(ca);
	}

	if ( all != ON && name[0] == '.' )
	  continue;

	appendChain(files, FNToName(name));
      } else if ( notNil(dirs) &&
#ifdef O_XOS
		  _xos_exists(name, _XOS_DIR) == TRUE
#else
		  (buf.st_mode & S_IFMT) == S_IFDIR
#endif
		)
      { if ( all != ON && name[0] == '.' )
	  continue;

	appendChain(dirs, FNToName(name));
      }
    }
    closedir(dirp);
    popDirectory(d);

    if ( notNil(dirs) )
      sortNamesChain(dirs, OFF);
    if ( notNil(files) )
      sortNamesChain(files, OFF);
  } else if ( notNil(files) )
  { if ( !(dirp = opendir(nameToFN(d->path))) )
      return errorPce(d, NAME_readDirectory, getOsErrorPce(PCE));
    for (dp=readdir(dirp); dp!=NULL; dp=readdir(dirp))
    { char *name = dp->d_name;

      if ( notDefault(pattern) )
      { CharArray ca = CtoScratchCharArray(name);
					/* TBD: UNICODE */
	if ( !searchRegex(pattern, ca, DEFAULT, DEFAULT) )
	{ doneScratchCharArray(ca);
	  continue;
	}
	doneScratchCharArray(ca);
      } else if ( all != ON && name[0] == '.' )
	continue;

      appendChain(files, FNToName(name));
    }
    closedir(dirp);

    sortNamesChain(files, OFF);
  }

  succeed;
}


static Chain
getDirectoriesDirectory(Directory d, Regex pattern, BoolObj all)
{ Chain dirs = answerObject(ClassChain, EAV);

  TRY(scanDirectory(d, NIL, dirs, pattern, all));

  answer(dirs);
}


static Chain
getFilesDirectory(Directory d, Regex pattern, BoolObj all)
{ Chain files = answerObject(ClassChain, EAV);

  TRY(scanDirectory(d, files, NIL, pattern, all));

  answer(files);
}



static Directory
getParentDirectory(Directory d)
{ char parent[PATH_MAX];
  const char *here = nameToFN(d->path);

  if ( IsDirSep(here[0]) && here[1] == EOS ) /* the root */
    fail;
#ifdef O_XOS
					/* DOS root: <Drive>:[\/] */
  if ( isalpha(here[0]) && here[1] == ':' &&
       (here[2] == EOS || (IsDirSep(here[2]) && here[3] == EOS)) )
    fail;
#endif

  if ( dirName(here, parent, sizeof(parent)) )
    answer(answerObject(ClassDirectory, FNToName(parent), EAV));

  fail;
}


static Chain
getRootsDirectory(Directory dir)
{ Chain ch = answerObject(ClassChain, EAV);
#ifdef __WINDOWS__
  char buf[PATH_MAX];
  extern int get_logical_drive_strings(int, char *);

  if ( get_logical_drive_strings(sizeof(buf)-1, buf) )
  { char *s = buf;

    while(*s)
    { char buf2[PATH_MAX];
      char *cnfn;

      if ( (cnfn=_xos_canonical_filename(s, buf2, sizeof(buf2), 0)) )
	appendChain(ch, FNToName(cnfn));
      s += strlen(s)+1;
    }
  }
#else
  appendChain(ch, CtoName("/"));
#endif

  answer(ch);
}


static Name
getBaseNameDirectory(Directory d)
{ answer(d->name);
}


static Date
getTimeDirectory(Directory d, Name which)
{ Name name = d->path;

#if O_XOS
  double t;
  int id = (which == NAME_modified ? XOS_TIME_MODIFIED : XOS_TIME_ACCESS);

  if ( _xos_get_file_time(nameToFN(name), id, &t) == 0 )
    answer(CtoDate((time_t)t));
#else
  STAT_TYPE buf;

  if ( isDefault(which) )
    which = NAME_modified;

  if ( STAT_FUNC(nameToFN(name), &buf) == 0 )
  { if ( which == NAME_modified )
      answer(CtoDate(buf.st_mtime));
    else
      answer(CtoDate(buf.st_atime));
  }
#endif

  errorPce(d, NAME_cannotStat, getOsErrorPce(PCE));
  fail;
}


static Name
getFileNameDirectory(Directory d, Name name)
{ const char *fn = nameToUTF8(name);

  if ( isAbsolutePath(fn) )
    answer(name);
  else
  { const char *dfn = nameToUTF8(d->path);
    size_t dfnl = strlen(dfn);
    size_t maxl = strlen(fn) + dfnl + 2;
    LocalArray(char, buf, maxl);

    memcpy(buf, dfn, dfnl);
    if ( dfnl > 0 && buf[dfnl-1] != '/' )
      buf[dfnl++] = '/';
    strcpy(&buf[dfnl], fn);

    answer(UTF8ToName(buf));
  }
}


static FileObj
getFileDirectory(Directory d, Name name)
{ return answerObject(ClassFile, getFileNameDirectory(d, name), EAV);
}


static Directory
getDirectoryDirectory(Directory d, Name name)
{ return answerObject(ClassDirectory, getFileNameDirectory(d, name), EAV);
}


static status
sameDirectory(Directory d1, Directory d2)
{ return sameOsPath(strName(d1->path), strName(d2->path));
}


static status
accessDirectory(Directory d, Name mode)
{ int m;

  if ( mode == NAME_read )
    m = R_OK;
  else /*if ( mode == NAME_write )*/
    m = W_OK;

  if ( access(nameToFN(d->path), m) == 0 )
    succeed;

  fail;
}


static status
changedDirectory(Directory d)
{ time_t t;

#ifdef O_XOS
  double time;

  if ( _xos_get_file_time(nameToFN(d->path), XOS_TIME_MODIFIED, &time) == 0 )
    t = (time_t)time;
  else
    succeed;
#else
  STAT_TYPE buf;

  if ( STAT_FUNC(nameToFN(d->path), &buf) < 0 )
    succeed;			/* we signal non-extistence as changed */
  t = buf.st_mtime;
#endif

  if ( d->modified == MODIFIED_NOT_SET )
  { d->modified = t;
    fail;
  }
  if ( t > d->modified )
  { d->modified = t;
    succeed;
  }

  fail;
}


static Name
getPrintNameDirectory(Directory dir)
{ answer(isName(dir->path) ? dir->path : dir->name);
}


		 /*******************************
		 *	 CLASS DECLARATION	*
		 *******************************/

/* Type declarations */

static char *T_scan[] =
        { "files=chain*", "directories=chain*", "pattern=[regex]", "hidden_too=[bool]" };
static char *T_patternADregexD_hidden_tooADboolD[] =
        { "pattern=[regex]", "hidden_too=[bool]" };

/* Instance Variables */

static vardecl var_directory[] =
{ IV(NAME_name, "name", IV_GET,
     NAME_name, "Name of the directory"),
  IV(NAME_path, "name", IV_GET,
     NAME_name, "Full path name"),
  IV(NAME_modified, "alien:long", IV_NONE,
     NAME_time, "Time stamp for ->changed")
};

/* Send Methods */

static senddecl send_directory[] =
{ SM(NAME_initialise, 1, "path=name", initialiseDirectory,
     DEFAULT, "Create from name"),
  SM(NAME_scan, 4, T_scan, scanDirectory,
     NAME_contents, "Get member files and directories"),
  SM(NAME_make, 0, NULL, makeDirectory,
     NAME_edit, "Create the OS counterpart"),
  SM(NAME_remove, 0, NULL, removeDirectory,
     NAME_edit, "Delete the OS counterpart"),
  SM(NAME_access, 1, "{read,write}", accessDirectory,
     NAME_test, "Test if directory has access {read, write}"),
  SM(NAME_exists, 0, NULL, existsDirectory,
     NAME_test, "Test if directory exists"),
  SM(NAME_same, 1, "directory=directory", sameDirectory,
     NAME_test, "Test if two paths refer to the same physical directory"),
  SM(NAME_modified, 0, NULL, changedDirectory,
     NAME_time, "Succeed if directory has changed since last test"),
  SM(NAME_cd, 0, NULL, cdDirectory,
     NAME_workingDirectory, "Change to this directory"),
  SM(NAME_pop, 0, NULL, popDirectory,
     NAME_workingDirectory, "->cd back to old directory"),
  SM(NAME_push, 0, NULL, pushDirectory,
     NAME_workingDirectory, "->cd until ->pop")
};

/* Get Methods */

static getdecl get_directory[] =
{ GM(NAME_printName, 0, "text=char_array", NULL, getPrintNameDirectory,
     DEFAULT, "Equivalent to <-path"),
  GM(NAME_directories, 2, "names=chain", T_patternADregexD_hidden_tooADboolD, getDirectoriesDirectory,
     NAME_contents, "New chain with names of member directories"),
  GM(NAME_directory, 1, "directory", "name", getDirectoryDirectory,
     NAME_contents, "New directory object with name in directory"),
  GM(NAME_fileName, 1, "name", "name", getFileNameDirectory,
     NAME_contents, "Create path relative to directory"),
  GM(NAME_file, 1, "file", "name", getFileDirectory,
     NAME_contents, "New file object with name in directory"),
  GM(NAME_files, 2, "names=chain", T_patternADregexD_hidden_tooADboolD, getFilesDirectory,
     NAME_contents, "New chain with names of member files"),
  GM(NAME_convert, 1, "directory", "name", getConvertDirectory,
     NAME_conversion, "Convert directory name"),
  GM(NAME_parent, 0, "directory", NULL, getParentDirectory,
     NAME_hierarchy, "New directory for parent directory"),
  GM(NAME_baseName, 0, "name", NULL, getBaseNameDirectory,
     NAME_name, "Same as <-name, cf. `file <-base_name'"),
  GM(NAME_roots, 0, "chain", NULL, getRootsDirectory,
     NAME_name, "Unix: chain(/), Win32: GetLogicalDriveNames()"),
  GM(NAME_time, 1, "date=date", "which_time=[{modified,access}]",
     getTimeDirectory,
     NAME_time, "New date holding modification/access time")
};

/* Resources */

#define rc_directory NULL
/*
static classvardecl rc_directory[] =
{
};
*/

/* Class Declaration */

static Name directory_termnames[] = { NAME_name };

ClassDecl(directory_decls,
          var_directory, send_directory, get_directory, rc_directory,
          1, directory_termnames);

status
makeClassDirectory(Class class)
{ declareClass(class, &directory_decls);
  setLoadStoreFunctionClass(class, loadDirectory, storeDirectory);

  DirectoryStack = globalObject(NAME_directoryStack, ClassChain, EAV);
  DEBUG(NAME_directory, Cprintf("DirectoryStack = %s\n", pp(DirectoryStack)));

  succeed;
}


		/********************************
		*           PRIMITIVES		*
		********************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Copied from SWI-Prolog pl-os.c. No poblem, as  SWI has copyright to both
systems.  If you spot a bug, please synchronise.

This routine works `in-place', using an   8-bit representation. It works
fine  on  encoded  8-bit  representations  as   long  as  the  important
characters . and / are unique. This is  true for UTF-8, but not for some
state-shifting multibyte encodings.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static char *
canonicalisePath(char *path)
{ char *out = path, *in = path;
  char *osave[100];
  int  osavep = 0;

  while( IsDirSep(in[0]) && in[1] == '.' && in[2] == '.' && IsDirSep(in[3]) )
    in += 3;
  while( in[0] == '.' && in[1] == '/' )
    in += 2;
  if ( IsDirSep(in[0]) )
    *out++ = '/';
#ifdef O_HASSHARES
  if ( in[1] == '/' )
  { in++;
    *out++ = '/';
  }
#endif
  osave[osavep++] = out;

  while(*in)
  { if ( IsDirSep(in[0]) )
    {
    again:
      if ( *in )
      { while( IsDirSep(in[1]) )		/* delete multiple / */
	  in++;
	if ( in[1] == '.' )
	{ if ( IsDirSep(in[2]) )		/* delete /./ */
	  { in += 2;
	    goto again;
	  }
	  if ( in[2] == EOS )		/* delete trailing /. */
	  { *out = EOS;
	    return path;
	  }
	  if ( in[2] == '.' &&		/* delete /foo/../ */
	       (IsDirSep(in[3]) || in[3] == EOS) && osavep > 0 )
	  { out = osave[--osavep];
	    in += 3;
	    goto again;
	  }
	}
      }
      if ( *in )
	in++;
      if ( out > path && !IsDirSep(out[-1]) )
	*out++ = '/';
      osave[osavep++] = out;
    } else
      *out++ = *in++;
  }
  *out++ = *in++;

  return path;
}


char *
dirName(const char *f, char *dir, size_t dirlen)
{ if ( f )
  { const char *base, *p;

    for(base = p = f; *p; p++)
    { if (*p == '/' && p[1] != EOS )
	base = p;
    }
    if ( base == f )
    { if ( *f == '/' )
	strcpy(dir, "/");
      else
	strcpy(dir, ".");
    } else
    { strncpy(dir, f, base-f);
      dir[base-f] = EOS;
    }

#ifdef O_XOS
    if ( isalpha(dir[0]) && dir[1] == ':' && dir[2] == EOS )
    { dir[2] = '/';
      dir[3] = EOS;
    }
#endif

    return dir;
  }

  return NULL;
}


char *
baseName(const char *f)
{ if ( f )
  { const char *base;
    static char buf[PATH_MAX];
    int len;

    for(base = f; *f; f++)
    { if ( IsDirSep(*f) && !IsDirSep(f[1]) && f[1] != EOS )
	base = f+1;
    }

    len = f - base;
    strcpy(buf, base);
    while ( len > 0 && buf[len-1] == '/' )
      len--;
    buf[len] = EOS;

    return buf;
  }

  return NULL;
}


static char   CWDdir[PATH_MAX];

static Name
getWorkingDirectoryPce(Pce pce)
{
#ifdef __unix__
  static dev_t device;
  static ino_t inode;
  struct stat buf;

  if ( stat(".", &buf) != 0 )
  { errorPce(CtoName("."), NAME_cannotStat);
    return NULL;
  }

  if ( CWDdir[0] == EOS || buf.st_ino != inode || buf.st_dev != device )
  {
#endif

#if HAVE_GETCWD
    if ( !getcwd(CWDdir, sizeof(CWDdir)) )
    { errorPce(CtoName("."), NAME_ioError, getOsErrorPce(PCE));
      return NULL;
    }
#else
    if ( getwd(CWDdir) == 0 )
    { errorPce(CtoName("."), NAME_ioError, getOsErrorPce(PCE));
      return NULL;
    }
#endif

#ifdef __unix__
    inode = buf.st_ino;
    device = buf.st_dev;
  }
#endif

  return FNToName(CWDdir);
}



int
isAbsolutePath(const char *p)		/* UTF-8 */
{
#ifdef O_XOS
  return _xos_is_absolute_filename(p);
#else
  return IsDirSep(p[0]) || p[0] == '~';
#endif
}

#define isRelativePath(p) ( p[0] == '.' )


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
absolutePath(const char *file, char *path, size_t buflen)
	Convert a filename in UTF-8 to an absolute and canonical path in
	UTF-8 notation.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int
absolutePath(const char *file, char *path, size_t buflen)
{ if ( !file )
    return -1;				/* propagate error */

  if ( !isAbsolutePath(file) )
  { Name cwd;
    const char *ucwd;
    char *s;
    size_t ul;

    if ( !(cwd = getWorkingDirectoryPce(PCE)) )
      return -1;
    ucwd = charArrayToUTF8((CharArray)cwd);

    if ( (ul=strlen(ucwd)) + strlen(file) + 2 >= buflen )
    { errno = ENAMETOOLONG;
      return -1;
    }
    memcpy(path, ucwd, ul);
    s = path + ul;
    *s++ = '/';
    strcpy(s, file);
  } else if ( strlen(file)+1 > buflen )
  { errno = ENAMETOOLONG;
    return -1;
  } else
    strcpy(path, file);

  canonicalisePath(path);

  return (int)strlen(path);
}


		/********************************
		*       ~ AND $ EXPANSION	*
		********************************/

#define USERNAME_MAX 20

static size_t
takeWord(const wchar_t *s)
{ size_t n = 0;

  while( *s && (iswalnum(*s) || *s == '_') )
  { n++, s++;
  }

  return n;
}


static inline wchar_t *
GETENV(const wchar_t *var, size_t len)
{ Name val;

  val = getEnvironmentVariablePce(PCE, WCToName(var, len));

  return val ? charArrayToWC((CharArray)val, NULL) : NULL;
}


int
expandFileNameW(const wchar_t *pattern, wchar_t *bin, size_t binlen)
{ wchar_t *expanded = bin;
  size_t size = 0;
  wint_t c;

  binlen--;				/* space for EOS */

  if ( *pattern == '~' )
  {
#ifdef HAVE_GETPWNAM
    static Name fred;
    static Name fredLogin;
#endif
    wchar_t *value;
    const wchar_t *s = ++pattern;	/* after ~ */
    size_t l;

    if ( (l = takeWord(s)) > USERNAME_MAX )
    { ExpandProblem = CtoName("User name too long");
      return -1;
    }
    if ( s[l] && !IsDirSep(s[l]) )	/* ~shhs[^/] */
      goto nouser;
    pattern = &s[l];

    if ( l == 0 )			/* ~/bla */
    { static Name myhome;

      if ( !myhome )
      {
#ifdef O_XOS
	myhome = UTF8ToName(_xos_home());
#else /*O_XOS*/
	myhome = getEnvironmentVariablePce(PCE, CtoName("HOME"));
#endif
	if ( !myhome)
	  myhome = CtoName("/");
      }

      value = charArrayToWC((CharArray)myhome, NULL);
    } else				/* ~fred */
#ifdef HAVE_GETPWNAM
    { struct passwd *pwent;
      Name user;

      user = WCToName(s, l);

      if ( fred != user )
      { if ( (pwent = getpwnam(charArrayToMB((CharArray)user))) == (struct passwd *) NULL )
	{ ExpandProblem = CtoName("Unknown user");
	  return -1;
	}
	fred      = user;
	fredLogin = MBToName(pwent->pw_dir);
      }
      value = charArrayToWC((CharArray)fredLogin, NULL);
    }
#else
    { ExpandProblem = CtoName("Unknown user");
      return -1;
    }
#endif

    size += (int)(l = wcslen(value));
    if ( size >= binlen )
    { ExpandProblem = CtoName("Name too long");
      return -1;
    }
    wcscpy(expanded, value);
    expanded += l;

					/* avoid ~/ --> // */
    if ( IsDirSep(expanded[-1]) && IsDirSep(pattern[0]) )
      pattern++;
  }

nouser:
  for( ;; )
  { switch( c = *pattern++ )
    { case EOS:
	break;
      case '$':
	{ size_t varlen = takeWord(pattern);

	  if ( varlen > 0 )
	  { wchar_t *value = GETENV(pattern, varlen);
	    int l;

	    if ( !value )
	    { ExpandProblem = CtoName("Unknown variable");
	      return -1;
	    }
	    size += (l = (int)wcslen(value));
	    if ( size >= binlen )
	    { errno = ENAMETOOLONG;
	      return -1;
	    }
	    wcscpy(expanded, value);
	    expanded += l;

	    pattern += varlen;
	    continue;
	  }

	  /*FALLTHROUGH*/
	}
      default:
	if ( ++size >= binlen )
	{ errno = ENAMETOOLONG;
	  return -1;
	}
	*expanded++ = c;

	continue;
    }
    break;
  }

  *expanded = EOS;

  /*DEBUG(NAME_path, Cprintf("Expanded %s to %s at %p\n",
			     pattern, bin, bin));*/

  return expanded-bin;
}
