958 lines
21 KiB
C
958 lines
21 KiB
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)
|
|
{ errno_t e;
|
|
|
|
if ( (e=_chsize_s(fileno, length)) == 0 )
|
|
return 0;
|
|
|
|
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, int *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 ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) )
|
|
{ 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);
|
|
}
|
|
}
|
|
|
|
/*******************************
|
|
* PUBLISH PREDICATES *
|
|
*******************************/
|
|
|
|
BeginPredDefs(win)
|
|
PRED_DEF("win_shell", 2, win_shell2, 0)
|
|
PRED_DEF("win_shell", 3, win_shell3, 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__*/
|
|
|