yap-6.3/os/pl-nt.c

/*  $Id$

    Part of SWI-Prolog

    Author:        Jan Wielemaker
    E-mail:        jan@swi.psy.uva.nl
    WWW:           http://www.swi-prolog.org
    Copyright (C): 1985-2002, University of Amsterdam

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library 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
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*/

#ifdef __MINGW32__
#define __WINDOWS__ 1
#endif

#ifdef __WINDOWS__
#define _WIN32_WINNT 0x0400
#if (_MSC_VER >= 1300) || defined(__MINGW32__)
#include <winsock2.h>			/* Needed on VC8 */
#include <windows.h>
#else
#include <windows.h>			/* Needed for MSVC 5&6 */
#include <winsock2.h>
#endif

#include "pl-incl.h"
#include "pl-utf8.h"
//#include <crtdbg.h>
#include <process.h>
#include "pl-ctype.h"
#include <stdio.h>
#include <stdarg.h>
#include "SWI-Stream.h"
#include <process.h>
#include <winbase.h>


		 /*******************************
		 *	       CONSOLE		*
		 *******************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
There is no way to tell which subsystem   an app belongs too, except for
peeking in its executable-header. This is a bit too much ...
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int
hasConsole(void)
{ HANDLE h;

  if ( GD->os.gui_app == FALSE )	/* has been set explicitly */
    succeed;

					/* I found a console */
  if ( (h = GetStdHandle(STD_OUTPUT_HANDLE)) != INVALID_HANDLE_VALUE )
  { DWORD mode;

    if ( GetConsoleMode(h, &mode) )
      succeed;
  }

					/* assume we are GUI */
  fail;
}


int
PL_wait_for_console_input(void *handle)
{ BOOL rc;
  HANDLE hConsole = handle;

  for(;;)
  { rc = MsgWaitForMultipleObjects(1,
				   &hConsole,
				   FALSE,	/* wait for either event */
				   INFINITE,
				   QS_ALLINPUT);

    if ( rc == WAIT_OBJECT_0+1 )
    { MSG msg;

      while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
      { TranslateMessage(&msg);
	DispatchMessage(&msg);
      }
    } else if ( rc == WAIT_OBJECT_0 )
    { return TRUE;
    } else
    { Sdprintf("MsgWaitForMultipleObjects(): 0x%x\n", rc);
    }
  }
}


		 /*******************************
		 *	    MESSAGE BOX		*
		 *******************************/

void
PlMessage(const char *fm, ...)
{ va_list(args);

  va_start(args, fm);

  if ( hasConsole() )
  { Sfprintf(Serror, "SWI-Prolog: ");
    Svfprintf(Serror, fm, args);
    Sfprintf(Serror, "\n");
  } else
  { char buf[1024];

    vsprintf(buf, fm, args);
    MessageBox(NULL, buf, "SWI-Prolog", MB_OK|MB_TASKMODAL);
  }

  va_end(args);
}



		 /*******************************
		 *	WinAPI ERROR CODES	*
		 *******************************/

char *
WinError()
{ int id = GetLastError();
  char *msg;
  static WORD lang;
  static int lang_initialised = 0;

  if ( !lang_initialised )
    lang = MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_UK);

again:
  if ( FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
		     FORMAT_MESSAGE_IGNORE_INSERTS|
		     FORMAT_MESSAGE_FROM_SYSTEM,
		     NULL,			/* source */
		     id,			/* identifier */
		     lang,
		     (LPTSTR) &msg,
		     0,				/* size */
		     NULL) )			/* arguments */
  { atom_t a = PL_new_atom(msg);

    LocalFree(msg);
    lang_initialised = 1;

    return stringAtom(a);
  } else
  { if ( lang_initialised == 0 )
    { lang = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
      lang_initialised = 1;
      goto again;
    }

    return "Unknown Windows error";
  }
}


		 /*******************************
		 *	  SLEEP/1 SUPPORT	*
		 *******************************/

int
Pause(double t)
{ HANDLE h;

  if ( (h = CreateWaitableTimer(NULL, TRUE, NULL)) )
  { LARGE_INTEGER ft;

    ft.QuadPart = -(LONGLONG)(t * 10000000.0); /* 100 nanosecs per tick */

    SetWaitableTimer(h, &ft, 0, NULL, NULL, FALSE);
    for(;;)
    { int rc = MsgWaitForMultipleObjects(1,
					 &h,
					 FALSE,
					 INFINITE,
					 QS_ALLINPUT);
      if ( rc == WAIT_OBJECT_0+1 )
      { MSG msg;

	while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
	{ TranslateMessage(&msg);
	  DispatchMessage(&msg);
	}

	if ( PL_handle_signals() < 0 )
	{ CloseHandle(h);
	  return FALSE;
	}
      } else
	break;
    }
    CloseHandle(h);

    return TRUE;
  } else				/* Pre NT implementation */
  { DWORD msecs = (DWORD)(t * 1000.0);

    while( msecs >= 100 )
    { Sleep(100);
      if ( PL_handle_signals() < 0 )
	return FALSE;
      msecs -= 100;
    }
    if ( msecs > 0 )
      Sleep(msecs);

    return TRUE;
  }
}


		 /*******************************
		 *	  SET FILE SIZE		*
		 *******************************/

int
ftruncate(int fileno, int64_t length)
{ int e;

#if HAVE__CHSIZE_S
  /* not always available in mingw */
  if ( (e=_chsize_s(fileno, length)) == 0 )
    return 0;
#else
  if ( (e=_chsize(fileno, (long)length)) == 0 )
    return 0;
#endif

  errno = e;
  return -1;
}


		 /*******************************
		 *	 QUERY CPU TIME		*
		 *******************************/

#define nano * 0.0000001
#define ntick 1.0			/* manual says 100.0 ??? */

double
CpuTime(cputime_kind which)
{ double t;
  HANDLE proc = GetCurrentProcess();
  FILETIME created, exited, kerneltime, usertime;

  if ( GetProcessTimes(proc, &created, &exited, &kerneltime, &usertime) )
  { FILETIME *p;

    switch ( which )
    { case CPU_USER:
	p = &usertime;
	break;
      case CPU_SYSTEM:
	p = &kerneltime;
        break;
    }
    t = (double)p->dwHighDateTime * (4294967296.0 * ntick nano);
    t += (double)p->dwLowDateTime  * (ntick nano);
  } else				/* '95, Windows 3.1/win32s */
  { extern intptr_t clock_wait_ticks;

    t = (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
  }

  return t;
}


static int
CpuCount()
{ SYSTEM_INFO si;

  GetSystemInfo(&si);

  return si.dwNumberOfProcessors;
}


void
setOSPrologFlags()
{ PL_set_prolog_flag("cpu_count", PL_INTEGER, CpuCount());
}


char *
findExecutable(const char *module, char *exe)
{ int n;
  wchar_t wbuf[MAXPATHLEN];
  HMODULE hmod;

  if ( module )
  { if ( !(hmod = GetModuleHandle(module)) )
    { hmod = GetModuleHandle("libpl.dll");
      DEBUG(0,
	    Sdprintf("Warning: could not find module from \"%s\"\n"
		     "Warning: Trying %s to find home\n",
		     module,
		     hmod ? "\"LIBPL.DLL\"" : "executable"));
    }
  } else
    hmod = NULL;

  if ( (n = GetModuleFileNameW(hmod, wbuf, MAXPATHLEN)) > 0 )
  { wbuf[n] = EOS;
    return _xos_long_file_name_toA(wbuf, exe, MAXPATHLEN);
  } else if ( module )
  { char buf[MAXPATHLEN];
    PrologPath(module, buf, sizeof(buf));

    strcpy(exe, buf);
  } else
    *exe = EOS;

  return exe;
}

		 /*******************************
		 *     SUPPORT FOR SHELL/2	*
		 *******************************/

typedef struct
{ const char *name;
  int         id;
} showtype;

static int
get_showCmd(term_t show, UINT *cmd)
{ char *s;
  showtype *st;
  static showtype types[] =
  { { "hide", 		 SW_HIDE },
    { "maximize", 	 SW_MAXIMIZE },
    { "minimize", 	 SW_MINIMIZE },
    { "restore", 	 SW_RESTORE },
    { "show", 		 SW_SHOW },
    { "showdefault", 	 SW_SHOWDEFAULT },
    { "showmaximized",   SW_SHOWMAXIMIZED },
    { "showminimized",   SW_SHOWMINIMIZED },
    { "showminnoactive", SW_SHOWMINNOACTIVE },
    { "showna",          SW_SHOWNA },
    { "shownoactive",    SW_SHOWNOACTIVATE },
    { "shownormal",      SW_SHOWNORMAL },
					/* compatibility */
    { "normal", 	 SW_SHOWNORMAL },
    { "iconic", 	 SW_MINIMIZE },
    { NULL, 0 },
  };

  if ( show == 0 )
  { *cmd = SW_SHOWNORMAL;
    succeed;
  }

  if ( !PL_get_chars(show, &s, CVT_ATOM|CVT_EXCEPTION) )
    fail;
  for(st=types; st->name; st++)
  { if ( streq(st->name, s) )
    { *cmd = st->id;
      succeed;
    }
  }

  return PL_error(NULL, 0, NULL, ERR_DOMAIN,
		  PL_new_atom("win_show"), show);
}



static int
win_exec(size_t len, const wchar_t *cmd, UINT show)
{ GET_LD
  STARTUPINFOW startup;
  PROCESS_INFORMATION info;
  int rval;
  wchar_t *wcmd;

  memset(&startup, 0, sizeof(startup));
  startup.cb = sizeof(startup);
  startup.wShowWindow = show;

					/* ensure 0-terminated */
  wcmd = PL_malloc((len+1)*sizeof(wchar_t));
  memcpy(wcmd, cmd, len*sizeof(wchar_t));
  wcmd[len] = 0;

  rval = CreateProcessW(NULL,		/* app */
			wcmd,
			NULL, NULL,	/* security */
			FALSE,		/* inherit handles */
			0,		/* flags */
			NULL,		/* environment */
			NULL,		/* Directory */
			&startup,
			&info);		/* process info */
  PL_free(wcmd);

  if ( rval )
  { CloseHandle(info.hProcess);
    CloseHandle(info.hThread);

    succeed;
  } else
  { term_t tmp = PL_new_term_ref();

    PL_unify_wchars(tmp, PL_ATOM, len, cmd);
    return PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp);
  }
}


static void
utf8towcs(wchar_t *o, const char *src)
{ for( ; *src; )
  { int wc;

    src = utf8_get_char(src, &wc);
    *o++ = wc;
  }
  *o = 0;
}


int
System(char *command)			/* command is a UTF-8 string */
{ STARTUPINFOW sinfo;
  PROCESS_INFORMATION pinfo;
  int shell_rval;
  size_t len;
  wchar_t *wcmd;

  memset(&sinfo, 0, sizeof(sinfo));
  sinfo.cb = sizeof(sinfo);

  len = utf8_strlen(command, strlen(command));
  wcmd = PL_malloc((len+1)*sizeof(wchar_t));
  utf8towcs(wcmd, command);

  if ( CreateProcessW(NULL,			/* module */
		      wcmd,			/* command line */
		      NULL,			/* Security stuff */
		      NULL,			/* Thread security stuff */
		      FALSE,			/* Inherit handles */
		      CREATE_NO_WINDOW,		/* flags */
		      NULL,			/* environment */
		      NULL,			/* CWD */
		      &sinfo,			/* startup info */
		      &pinfo) )			/* process into */
  { BOOL rval;
    DWORD code;

    CloseHandle(pinfo.hThread);			/* don't need this */
    PL_free(wcmd);

    do
    { MSG msg;

      if ( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
      { TranslateMessage(&msg);
	DispatchMessage(&msg);
      } else
	Sleep(50);

      rval = GetExitCodeProcess(pinfo.hProcess, &code);
    } while(rval == TRUE && code == STILL_ACTIVE);

    shell_rval = (rval == TRUE ? code : -1);
    CloseHandle(pinfo.hProcess);
  } else
  { PL_free(wcmd);
    return shell_rval = -1;
  }

  return shell_rval;
}


word
pl_win_exec(term_t cmd, term_t how)
{ wchar_t *s;
  size_t len;
  UINT h;

  if ( PL_get_wchars(cmd, &len, &s, CVT_ALL|CVT_EXCEPTION) &&
       get_showCmd(how, &h) )
  { return win_exec(len, s, h);
  } else
    fail;
}

typedef struct
{ int   eno;
  const char *message;
} shell_error;

static const shell_error se_errors[] =
{ { 0 ,                     "Out of memory or resources" },
  { ERROR_FILE_NOT_FOUND,   "File not found" },
  { ERROR_PATH_NOT_FOUND,   "path not found" },
  { ERROR_BAD_FORMAT,	    "Invalid .EXE" },
  { SE_ERR_ACCESSDENIED,    "Access denied" },
  { SE_ERR_ASSOCINCOMPLETE, "Incomplete association" },
  { SE_ERR_DDEBUSY,	    "DDE server busy" },
  { SE_ERR_DDEFAIL,         "DDE transaction failed" },
  { SE_ERR_DDETIMEOUT,	    "DDE request timed out" },
  { SE_ERR_DLLNOTFOUND,	    "DLL not found" },
  { SE_ERR_FNF,		    "File not found (FNF)" },
  { SE_ERR_NOASSOC, 	    "No association" },
  { SE_ERR_OOM,		    "Not enough memory" },
  { SE_ERR_PNF,		    "Path not found (PNF)" },
  { SE_ERR_SHARE,	    "Sharing violation" },
  { 0,			    NULL }
};


static int
win_shell(term_t op, term_t file, term_t how)
{ size_t lo, lf;
  wchar_t *o, *f;
  UINT h;
  HINSTANCE instance;

  if ( !PL_get_wchars(op,   &lo, &o, CVT_ALL|CVT_EXCEPTION|BUF_RING) ||
       !PL_get_wchars(file, &lf, &f, CVT_ALL|CVT_EXCEPTION|BUF_RING) ||
       !get_showCmd(how, &h) )
    fail;

  instance = ShellExecuteW(NULL, o, f, NULL, NULL, h);

  if ( (intptr_t)instance <= 32 )
  { const shell_error *se;

    for(se = se_errors; se->message; se++)
    { if ( se->eno == (int)instance )
	return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file);
    }
    PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file);
  }

  succeed;
}


static
PRED_IMPL("win_shell", 2, win_shell2, 0)
{ return win_shell(A1, A2, 0);
}


static
PRED_IMPL("win_shell", 3, win_shell3, 0)
{ return win_shell(A1, A2, A3);
}


foreign_t
pl_win_module_file(term_t module, term_t file)
{ char buf[MAXPATHLEN];
  char *m;
  char *f;

  if ( !PL_get_chars(module, &m, CVT_ALL|CVT_EXCEPTION) )
    fail;
  if ( (f = findExecutable(m, buf)) )
    return PL_unify_atom_chars(file, f);

  fail;
}

		 /*******************************
		 *	  WINDOWS MESSAGES	*
		 *******************************/

LRESULT
PL_win_message_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)
{
#ifdef O_PLMT
  if ( hwnd == NULL &&
       message == WM_SIGNALLED &&
       wParam == 0 &&			/* or another constant? */
       lParam == 0 )
  { if ( PL_handle_signals() < 0 )
      return PL_MSG_EXCEPTION_RAISED;

    return PL_MSG_HANDLED;
  }
#endif

  return PL_MSG_IGNORED;
}


		 /*******************************
		 *	DLOPEN AND FRIENDS	*
		 *******************************/

#ifdef EMULATE_DLOPEN

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
These functions emulate the bits from the ELF shared object interface we
need. They are used  by  pl-load.c,   which  defines  the  actual Prolog
interface.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static char *dlmsg;

void *
dlopen(const char *file, int flags)	/* file is in UTF-8 */
{ HINSTANCE h;
  size_t len = utf8_strlen(file, strlen(file));
  wchar_t *wfile = alloca((len+1)*sizeof(wchar_t));

  if ( !wfile )
  { dlmsg = "No memory";
    return NULL;
  }

  utf8towcs(wfile, file);

  if ( (h = LoadLibraryW(wfile)) )
  { dlmsg = "No Error";
    return (void *)h;
  }

  dlmsg = WinError();
  return NULL;
}


const char *
dlerror()
{ return dlmsg;
}


void *
dlsym(void *handle, char *symbol)
{ void *addr = GetProcAddress(handle, symbol);

  if ( addr )
  { dlmsg = "No Error";
    return addr;
  }

  dlmsg = WinError();
  return NULL;
}


int
dlclose(void *handle)
{ FreeLibrary(handle);

  return 0;
}

#endif /*EMULATE_DLOPEN*/


		 /*******************************
		 *	      FOLDERS		*
		 *******************************/

#include <Shlobj.h>

typedef struct folderid
{ int csidl;
  const char *name;
} folderid;

static const folderid folderids[] =
{ { CSIDL_COMMON_ALTSTARTUP, "common_altstartup" },
  { CSIDL_ALTSTARTUP, "altstartup" },
  { CSIDL_APPDATA, "appdata" },
  { CSIDL_CONTROLS, "controls" },
  { CSIDL_COOKIES, "cookies" },
  { CSIDL_DESKTOP, "desktop" },
  { CSIDL_COMMON_DESKTOPDIRECTORY, "common_desktopdirectory" },
  { CSIDL_DESKTOPDIRECTORY, "desktopdirectory" },
  { CSIDL_COMMON_FAVORITES, "common_favorites" },
  { CSIDL_FAVORITES, "favorites" },
  { CSIDL_FONTS, "fonts" },
  { CSIDL_HISTORY, "history" },
  { CSIDL_INTERNET_CACHE, "internet_cache" },
  { CSIDL_INTERNET, "internet" },
  { CSIDL_DRIVES, "drives" },
  { CSIDL_PERSONAL, "personal" },
  { CSIDL_NETWORK, "network" },
  { CSIDL_NETHOOD, "nethood" },
  { CSIDL_PERSONAL, "personal" },
  { CSIDL_PRINTERS, "printers" },
  { CSIDL_PRINTHOOD, "printhood" },
  { CSIDL_COMMON_PROGRAMS, "common_programs" },
  { CSIDL_PROGRAMS, "programs" },
  { CSIDL_RECENT, "recent" },
  { CSIDL_BITBUCKET, "bitbucket" },
  { CSIDL_SENDTO, "sendto" },
  { CSIDL_COMMON_STARTMENU, "common_startmenu" },
  { CSIDL_STARTMENU, "startmenu" },
  { CSIDL_COMMON_STARTUP, "common_startup" },
  { CSIDL_STARTUP, "startup" },
  { CSIDL_TEMPLATES, "templates" },
  { 0, NULL }
};


static int
unify_csidl_path(term_t t, int csidl)
{ wchar_t buf[MAX_PATH];

  if ( SHGetFolderPathW(0, csidl, NULL, FALSE, buf) )
  { wchar_t *p;

    for(p=buf; *p; p++)
    { if ( *p == '\\' )
	*p = '/';
    }

    return PL_unify_wchars(t, PL_ATOM, -1, buf);
  } else
    return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "SHGetSpecialFolderPath");
}


static
PRED_IMPL("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
{ GET_LD
  int n;

  switch( CTX_CNTRL )
  { case FRG_FIRST_CALL:
      if ( PL_is_variable(A1) )
      { n = 0;
	goto generate;
      } else
      { char *s;

	if ( PL_get_chars(A1, &s, CVT_ATOM|CVT_EXCEPTION) )
	{ const folderid *fid;

	  for(fid = folderids; fid->name; fid++)
	  { if ( streq(s, fid->name) )
	      return unify_csidl_path(A2, fid->csidl);
	  }

	  { atom_t dom = PL_new_atom("win_folder");

	    PL_error(NULL, 0, NULL, ERR_DOMAIN, dom, A1);
	    PL_unregister_atom(dom);
	    return FALSE;
	  }
	} else
	  return FALSE;
      }
    case FRG_REDO:
    { fid_t fid;

      n = (int)CTX_INT+1;

      generate:
	fid = PL_open_foreign_frame();
	for(; folderids[n].name; n++)
	{ if ( unify_csidl_path(A2, folderids[n].csidl) &&
	       PL_unify_atom_chars(A1, folderids[n].name) )
	  { PL_close_foreign_frame(fid);
	    ForeignRedoInt(n);
	  }
	  PL_rewind_foreign_frame(fid);
	}
	PL_close_foreign_frame(fid);
	return FALSE;
    }
    default:
      succeed;
  }
}



		 /*******************************
		 *	      REGISTRY		*
		 *******************************/

#define wstreq(s,q) (wcscmp((s), (q)) == 0)

static HKEY
reg_open_key(const wchar_t *which, int create)
{ HKEY key = HKEY_CURRENT_USER;
  DWORD disp;
  LONG rval;

  while(*which)
  { wchar_t buf[256];
    wchar_t *s;
    HKEY tmp;

    for(s=buf; *which && !(*which == '/' || *which == '\\'); )
      *s++ = *which++;
    *s = '\0';
    if ( *which )
      which++;

    if ( wstreq(buf, L"HKEY_CLASSES_ROOT") )
    { key = HKEY_CLASSES_ROOT;
      continue;
    } else if ( wstreq(buf, L"HKEY_CURRENT_USER") )
    { key = HKEY_CURRENT_USER;
      continue;
    } else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") )
    { key = HKEY_LOCAL_MACHINE;
      continue;
    } else if ( wstreq(buf, L"HKEY_USERS") )
    { key = HKEY_USERS;
      continue;
    }

    DEBUG(2, Sdprintf("Trying %s\n", buf));
    if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS )
    { RegCloseKey(key);
      key = tmp;
      continue;
    }

    if ( !create )
      return NULL;

    rval = RegCreateKeyExW(key, buf, 0, L"", 0,
			  KEY_ALL_ACCESS, NULL, &tmp, &disp);
    RegCloseKey(key);
    if ( rval == ERROR_SUCCESS )
      key = tmp;
    else
      return NULL;
  }

  return key;
}

#define MAXREGSTRLEN 1024

static
PRED_IMPL("win_registry_get_value", 3, win_registry_get_value, 0)
{ GET_LD
  DWORD type;
  BYTE  data[MAXREGSTRLEN];
  DWORD len = sizeof(data);
  size_t klen, namlen;
  wchar_t *k, *name;
  HKEY key;

  term_t Key = A1;
  term_t Name = A2;
  term_t Value = A3;

  if ( !PL_get_wchars(Key, &klen, &k, CVT_ATOM|CVT_EXCEPTION) ||
       !PL_get_wchars(Name, &namlen, &name, CVT_ATOM|CVT_ATOM) )
    return FALSE;
  if ( !(key=reg_open_key(k, FALSE)) )
    return PL_error(NULL, 0, NULL, ERR_EXISTENCE, PL_new_atom("key"), Key);

  DEBUG(9, Sdprintf("key = %p, name = %s\n", key, name));
  if ( RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS )
  { RegCloseKey(key);

    switch(type)
    { case REG_SZ:
	return PL_unify_wchars(Value, PL_ATOM,
			       len/sizeof(wchar_t)-1, (wchar_t*)data);
      case REG_DWORD:
	return PL_unify_integer(Value, *((DWORD *)data));
      default:
	warning("get_registry_value/2: Unknown registery-type: %d", type);
        fail;
    }
  }

  return FALSE;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Get the local, global,  trail  and   argument-stack  defaults  from  the
registry.  They  can  be  on  the   HKEY_CURRENT_USER  as  well  as  the
HKEY_LOCAL_MACHINE  registries  to  allow   for    both   user-only  and
system-wide settings.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static struct regdef
{ const char *name;
  int        *address;
} const regdefs[] =
{ { "localSize",    &GD->defaults.local },
  { "globalSize",   &GD->defaults.global },
  { "trailSize",    &GD->defaults.trail },
  { NULL,           NULL }
};


static void
setStacksFromKey(HKEY key)
{ DWORD type;
  BYTE  data[128];
  DWORD len = sizeof(data);
  const struct regdef *rd;

  for(rd = regdefs; rd->name; rd++)
  { if ( RegQueryValueEx(key, rd->name, NULL, &type, data, &len) ==
							ERROR_SUCCESS &&
	 type == REG_DWORD )
    { DWORD v = *((DWORD *)data);

      *rd->address = (int)v;
    }
  }
}


void
getDefaultsFromRegistry()
{ HKEY key;

  if ( (key = reg_open_key(L"HKEY_LOCAL_MACHINE/Software/SWI/Prolog", FALSE)) )
  { setStacksFromKey(key);
    RegCloseKey(key);
  }
  if ( (key = reg_open_key(L"HKEY_CURRENT_USER/Software/SWI/Prolog", FALSE)) )
  { setStacksFromKey(key);
    RegCloseKey(key);
  }
}

static
PRED_IMPL("win_open_file_name", 3, win_open_file_name, 0)
{ GET_LD
    OPENFILENAMEW ofn;
    wchar_t szFileName[MAX_PATH];
    void *x;
    HWND hwnd;
    wchar_t *yap_cwd;

    if(!PL_get_pointer(A1, &x))
      return FALSE;
    if(!PL_get_wchars(A2, NULL, &yap_cwd, CVT_ATOM|CVT_EXCEPTION))
      return FALSE;
    hwnd = (HWND)x;
    ZeroMemory(&ofn, sizeof(ofn));

    ofn.lStructSize = sizeof(ofn); // SEE NOTE BELOW
    ofn.hwndOwner = hwnd;
    ofn.lpstrFilter = L"Prolog Files (*.pl;*.yap)\0*.pl;*.yap\0All Files (*.*)\0*.*\0";
    ofn.lpstrFile = szFileName;
    ofn.lpstrInitialDir = yap_cwd;
    ofn.nMaxFile = MAX_PATH;
    ofn.Flags = OFN_EXPLORER | OFN_FILEMUSTEXIST 
      //| OFN_HIDEREADONLY
      //|OFN_ALLOWMULTISELECT
      ;
    ofn.lpstrDefExt = "pl";

    if(GetOpenFileNameW(&ofn))
    {
        // Do something usefull with the filename stored in szFileName 
	return PL_unify_wchars(A3, PL_ATOM,
			       MAX_PATH-1, szFileName);
    }
    return TRUE;
}


		 /*******************************
		 *      PUBLISH PREDICATES	*
		 *******************************/

BeginPredDefs(win)
  PRED_DEF("win_shell", 2, win_shell2, 0)
  PRED_DEF("win_shell", 3, win_shell3, 0)
  PRED_DEF("win_open_file_name", 3, win_open_file_name, 0)
  PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0)
  PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
EndPredDefs

#endif /*__WINDOWS__*/