/* $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 /* Needed on VC8 */ #include #else #include /* Needed for MSVC 5&6 */ #include #endif #include "pl-incl.h" #include "pl-utf8.h" #include #include #include "pl-ctype.h" #include #include #include "SWI-Stream.h" #include #include /******************************* * 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 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__*/