1 /*  Part of XPCE --- The SWI-Prolog GUI toolkit
2 
3     Author:        Jan Wielemaker and Anjo Anjewierden
4     E-mail:        jan@swi.psy.uva.nl
5     WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6     Copyright (c)  1995-2013, University of Amsterdam
7     All rights reserved.
8 
9     Redistribution and use in source and binary forms, with or without
10     modification, are permitted provided that the following conditions
11     are met:
12 
13     1. Redistributions of source code must retain the above copyright
14        notice, this list of conditions and the following disclaimer.
15 
16     2. Redistributions in binary form must reproduce the above copyright
17        notice, this list of conditions and the following disclaimer in
18        the documentation and/or other materials provided with the
19        distribution.
20 
21     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24     FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25     COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26     INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27     BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29     CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31     ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32     POSSIBILITY OF SUCH DAMAGE.
33 */
34 
35 #define UNICODE 1
36 #define _UNICODE 1
37 #include "include.h"
38 #include "mswin.h"
39 #include <h/interface.h>
40 #include <tchar.h>
41 
42 #ifdef UNICODE
43 #define nameToTCHAR(nm) nameToWC((Name)(nm), NULL)
44 #define TCHARToName(s)  WCToName(s, _tcslen(s))
45 #else
46 #define nameToTCHAR(nm) nameToMB((Name)(nm))
47 #define TCHARToName(s)  MBToName(s)
48 #endif
49 
50 
51 		 /*******************************
52 		 *	    DLL STUFF		*
53 		 *******************************/
54 
55 HINSTANCE ThePceHInstance;		/* Global handle */
56 DWORD	  ThePceThread;			/* Dispatching thread */
57 
58 BOOL WINAPI
DllMain(HINSTANCE instance,DWORD reason,LPVOID reserved)59 DllMain(HINSTANCE instance, DWORD reason, LPVOID reserved)
60 { switch(reason)
61   { case DLL_PROCESS_ATTACH:
62       ThePceHInstance = instance;
63       break;
64     case DLL_THREAD_ATTACH:
65       break;
66     case DLL_THREAD_DETACH:
67       break;
68   }
69 
70   return TRUE;
71 }
72 
73 
74 int
pceMTdetach(void)75 pceMTdetach(void)
76 {
77 #if O_DEBUG_EXIT
78   ServiceMode = PCE_EXEC_USER;
79   PCEdebugging = TRUE;
80 
81   Cprintf("pceMTdetach() in user mode\n");
82 #endif
83 
84   DEBUG(NAME_thread,
85 	Cprintf("Detached thread 0x%x\n", GetCurrentThreadId()));
86   destroyThreadWindows(ClassFrame);
87   destroyThreadWindows(ClassWindow);
88 
89   return TRUE;
90 }
91 
92 
93 unsigned					/* interface.h cannot depend */
setPceThread(unsigned id)94 setPceThread(unsigned id)			/* on DWORD due to conflicts */
95 { DWORD old = ThePceThread;
96 
97   assert(sizeof(unsigned) == sizeof(DWORD));
98 
99   ThePceThread = id;
100 
101   return old;
102 }
103 
104 
105 		 /*******************************
106 		 *	      VERSIONS		*
107 		 *******************************/
108 
109 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
110 Get Windows Version/Revision info
111 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
112 
113 int
ws_version(void)114 ws_version(void)
115 { DWORD dwv = GetVersion();
116 
117   return LOBYTE(LOWORD(dwv));
118 }
119 
120 
121 int
ws_revision(void)122 ws_revision(void)
123 { DWORD dwv = GetVersion();
124 
125   return HIBYTE(LOWORD(dwv));
126 }
127 
128 
129 os_platform
ws_platform(void)130 ws_platform(void)
131 { static int done = FALSE;
132   os_platform platform = WINUNKNOWN;
133 
134   if ( !done )
135   { OSVERSIONINFO info;
136 
137     info.dwOSVersionInfoSize = sizeof(info);
138     if ( GetVersionEx(&info) )
139     { switch( info.dwPlatformId )
140       { case VER_PLATFORM_WIN32s:
141 	  platform = WIN32S;
142 	  break;
143 	case VER_PLATFORM_WIN32_WINDOWS:
144 	  switch( info.dwMinorVersion )
145 	  { case 0:
146 	      platform = WIN95;
147 	      break;
148 	    case 10:
149 	      platform = WIN98;
150 	      break;
151 	    case 90:
152 	      platform = WINME;
153 	      break;
154 	    default:
155 	      platform = WINUNKNOWN;
156 	  }
157 	  break;
158 	case VER_PLATFORM_WIN32_NT:
159 	  platform = NT;
160 	  break;
161       }
162     } else
163       platform = WINUNKNOWN;
164   }
165 
166   return platform;
167 }
168 
169 char *
ws_os(void)170 ws_os(void)
171 { switch(ws_platform())
172   { case WINUNKNOWN:
173       return "win32";
174     case WIN32S:
175       return "win32s";
176     case WIN95:
177     case WIN98:
178     case WINME:
179       return "win95";			/* doesn't really make a difference */
180     case NT:
181       return "winnt";
182     default:
183       return "winunknown";
184   }
185 }
186 
187 
188 HWND
HostConsoleHWND()189 HostConsoleHWND()
190 { PceCValue val;
191 
192   if ( hostQuery(HOST_CONSOLE, &val) )
193     return (HWND) val.pointer;
194 
195   return NULL;
196 }
197 
198 
199 status
ws_show_console(Name how)200 ws_show_console(Name how)
201 { HWND hwnd = HostConsoleHWND();
202 
203   if ( hwnd )
204   { if ( how == NAME_open )
205     { if ( IsIconic(hwnd) )
206 	ShowWindow(hwnd, SW_RESTORE);
207       else
208 	ShowWindow(hwnd, SW_SHOW);
209     } else if ( how == NAME_iconic )
210       ShowWindow(hwnd, SW_SHOWMINIMIZED);
211     else if ( how == NAME_hidden )
212       ShowWindow(hwnd, SW_HIDE);
213     else if ( how == NAME_fullScreen )
214       ShowWindow(hwnd, SW_MAXIMIZE);
215 
216     succeed;
217   }
218 
219   fail;
220 }
221 
222 
223 status
ws_console_label(CharArray label)224 ws_console_label(CharArray label)
225 { HWND hwnd = HostConsoleHWND();
226 
227   if ( hwnd )
228     SetWindowText(hwnd, nameToTCHAR((Name)label));
229 
230   succeed;
231 }
232 
233 
234 void
ws_check_intr()235 ws_check_intr()
236 { hostAction(HOST_CHECK_INTERRUPT);
237 }
238 
239 
240 void
ws_msleep(int time)241 ws_msleep(int time)
242 { Sleep((DWORD) time);
243 }
244 
245 
246 int
ws_getpid()247 ws_getpid()
248 { DEBUG(NAME_instance, Cprintf("HINSTANCE is %d\n", PceHInstance));
249 
250   return (int) GetCurrentProcessId();
251 }
252 
253 
254 char *
ws_user()255 ws_user()
256 { TCHAR buf[256];
257   Name nm;
258   DWORD len = sizeof(buf)/sizeof(TCHAR);
259 
260   if ( GetUserName(buf, &len) )
261     return nameToFN(TCHARToName(buf));
262   else if ( (nm = getEnvironmentVariablePce(PCE, CtoName("USER"))) )
263     return nameToFN(nm);
264   else
265     return NULL;
266 }
267 
268 
269 #include <shlobj.h>
270 
271 Name
ws_appdata(const char * sub)272 ws_appdata(const char *sub)
273 { TCHAR buf[MAX_PATH];
274 
275   if ( SHGetSpecialFolderPath(0, buf, CSIDL_APPDATA, TRUE) )
276   { wchar_t *p;
277 
278     for(p=buf; *p; p++)
279     { if ( *p == '\\' )
280 	*p = '/';
281     }
282     if ( sub )
283     { const char *s;
284 
285       *p++ = '/';
286       for(s=sub; *s; )
287 	*p++ = *s++;
288       *p = EOS;
289     }
290 
291     return TCHARToName(buf);
292   }
293 
294   fail;
295 }
296 
297 
298 int
ws_mousebuttons()299 ws_mousebuttons()
300 { return GetSystemMetrics(SM_CMOUSEBUTTONS);
301 }
302 
303 
304 #ifdef O_IMGLIB
305 void
remove_ilerrout(int status)306 remove_ilerrout(int status)
307 { unlink("ilerr.out");
308 }
309 #endif
310 
311 
312 void
ws_initialise(int argc,char ** argv)313 ws_initialise(int argc, char **argv)
314 { if ( ws_mousebuttons() == 2 )
315     ws_emulate_three_buttons(100);
316 }
317 
318 
319 Int
ws_default_scrollbar_width()320 ws_default_scrollbar_width()
321 { int w = GetSystemMetrics(SM_CXHSCROLL);	/* Is this the right one? */
322 
323   return toInt(w);
324 }
325 
326 
327 #define MAXMESSAGE 1024
328 
329 Name
WinStrError(int error,...)330 WinStrError(int error, ...)
331 { va_list args;
332   TCHAR msg[MAXMESSAGE];
333 
334   va_start(args, error);
335   if ( !FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
336 		      NULL,
337 		      error,
338 		      GetUserDefaultLangID(),
339 		      msg,
340 		      sizeof(msg),
341 		      (char **)args) )
342   { wsprintf(msg, _T("Unknown WINAPI error %d"), error);
343   }
344   va_end(args);
345 
346   return TCHARToName(msg);
347 }
348 
349 
350 int
get_logical_drive_strings(int bufsize,char * buf)351 get_logical_drive_strings(int bufsize, char *buf)
352 { return GetLogicalDriveStringsA(bufsize, buf);
353 }
354 
355 		 /*******************************
356 		 *      COMMON DIALOG STUFF	*
357 		 *******************************/
358 
359 #define nameToFN(s) charArrayToFN((CharArray)(s))
360 
361 #include <h/unix.h>
362 #ifndef _MAX_PATH
363 #define _MAX_PATH 1024
364 #endif
365 #ifndef MAXPATHLEN
366 #define MAXPATHLEN _MAX_PATH
367 #endif
368 #define strapp(s, q) \
369 	{ size_t l = _tcslen(q); \
370 	  if ( s+l+2 > filter+sizeof(filter)/sizeof(TCHAR) ) \
371 	  { errorPce(filters, NAME_representation, NAME_nameTooLong); \
372 	    fail; \
373 	  } \
374 	  _tcscpy(s, q); \
375 	  s += l; \
376 	}
377 
378 static int
allLetter(const TCHAR * s)379 allLetter(const TCHAR *s)
380 { for(; *s && _istalpha(*s); s++)
381     ;
382 
383   return *s ? FALSE : TRUE;
384 }
385 
386 
387 #ifndef IsDirSep
388 #define IsDirSep(c) ((c) == '/' || (c) == '\\')
389 #endif
390 
391 static TCHAR *
baseNameW(TCHAR * name)392 baseNameW(TCHAR *name)
393 { TCHAR *base;
394 
395   for(base=name; *name; name++)
396   { if ( IsDirSep(*name) && name[1] )
397       base = name;
398   }
399 
400   return base;
401 }
402 
403 
404 typedef struct
405 { char *name;
406   DWORD flag;
407 } ofn_namedef;
408 
409 static ofn_namedef ofn_namedefs[] =
410 { { "allowmultiselect", OFN_ALLOWMULTISELECT },
411   { "createprompt", OFN_CREATEPROMPT },
412   { "filemustexist", OFN_FILEMUSTEXIST },
413   { "hidereadonly", OFN_HIDEREADONLY },
414   { "nodereferencelinks", OFN_NODEREFERENCELINKS  },
415   { "nonetworkbutton", OFN_NONETWORKBUTTON },
416   { "noreadonlyreturn ", OFN_NOREADONLYRETURN },
417   { "notestfilecreate", OFN_NOTESTFILECREATE },
418   { "overwriteprompt", OFN_OVERWRITEPROMPT },
419   { "pathmustexist", OFN_PATHMUSTEXIST },
420   { "readonly", OFN_READONLY },
421   { "shareaware", OFN_SHAREAWARE },
422   { NULL, 0 }
423 };
424 
425 
426 Name
getWinFileNameDisplay(DisplayObj d,Name mode,Chain filters,CharArray title,CharArray file,Directory dir,Any owner,Chain options)427 getWinFileNameDisplay(DisplayObj d,
428 		      Name mode,	/* open, save */
429 		      Chain filters,	/* tuple(Name, Pattern) */
430 		      CharArray title,
431 		      CharArray file,	/* default file */
432 		      Directory dir,	/* initial dir */
433 		      Any owner,	/* owner window */
434 		      Chain options)	/* Flags */
435 { OPENFILENAME ofn;
436   HWND hwnd;
437   Name rval = 0;
438   EventObj ev = EVENT->value;
439   TCHAR filter[1024], *ef = filter;
440   TCHAR buffer[2048];
441   TCHAR dirbuf[1024];
442   BOOL tmpb;
443 
444   memset(&ofn, 0, sizeof(OPENFILENAME));
445   ofn.lStructSize = sizeof(OPENFILENAME);
446 
447   if ( isInteger(owner) )
448     ofn.hwndOwner = (void *)valInt(owner);
449   else if ( instanceOfObject(owner, ClassFrame) )
450     ofn.hwndOwner = getHwndFrame(owner);
451   else if ( instanceOfObject(ev, ClassEvent) &&
452 	    (hwnd = getHwndWindow(ev->window)) )
453     ofn.hwndOwner = hwnd;
454 
455   if ( isDefault(filters) )
456   { Name nm = get((Any)NAME_allFiles, NAME_labelName, EAV);
457     strapp(ef, nameToTCHAR(nm));
458     *ef++ = L'\0';
459     strapp(ef, _T("*.*"));
460     *ef++ = L'\0';
461   } else
462   { Cell cell;
463 
464     for_cell(cell, filters)
465     { if ( instanceOfObject(cell->value, ClassTuple) )
466       { Tuple t = cell->value;
467 	CharArray s1 = t->first, s2 = t->second;
468 
469 	if ( !instanceOfObject(s1, ClassCharArray) )
470 	{ errorPce(s1, NAME_unexpectedType, TypeCharArray);
471 	  fail;
472 	}
473 	if ( !instanceOfObject(s2, ClassCharArray) )
474 	{ errorPce(s2, NAME_unexpectedType, TypeCharArray);
475 	  fail;
476 	}
477 	strapp(ef, nameToTCHAR((Name)s1));
478 	*ef++ = L'\0';
479 	strapp(ef, nameToTCHAR((Name)s2));
480 	*ef++ = L'\0';
481       } else if ( instanceOfObject(cell->value, ClassCharArray) )
482       { StringObj s = cell->value;
483 
484 	strapp(ef, nameToTCHAR((Name)s));
485 	*ef++ = L'\0';
486 	strapp(ef, nameToTCHAR((Name)s));
487 	*ef++ = L'\0';
488       } else
489       { errorPce(cell->value, NAME_unexpectedType, CtoType("char_array|tuple"));
490 	fail;
491       }
492     }
493   }
494   *ef = L'\0';
495   ofn.lpstrFilter  = filter;
496   ofn.nFilterIndex = 0;
497 
498   if ( isDefault(file) )
499     buffer[0] = L'\0';
500   else
501   { const TCHAR *fn = nameToTCHAR(file);
502 
503     if ( _tcslen(fn) >= sizeof(buffer) )
504     { errorPce(file, NAME_representation, NAME_nameTooLong);
505       fail;
506     }
507     _tcscpy(buffer, fn);
508   }
509 
510   ofn.lpstrFile    = buffer;
511   ofn.nMaxFile     = (sizeof(buffer)/sizeof(TCHAR))-1;
512   if ( notDefault(dir) )
513   { ofn.lpstrInitialDir =
514       _xos_os_filenameW(nameToUTF8(dir->path),
515 			dirbuf, sizeof(dirbuf)/sizeof(TCHAR));
516   }
517   if ( notDefault(title) )
518   ofn.lpstrTitle = nameToTCHAR(title);
519 
520   ofn.Flags = OFN_NOCHANGEDIR;
521 
522   if ( notDefault(options) )
523   { Cell cell;
524 
525     for_cell(cell, options)
526     { if ( isName(cell->value) )
527       { ofn_namedef *dp = ofn_namedefs;
528 
529 	for(; dp->name; dp++)
530 	{ if ( streq(strName(cell->value), dp->name) )
531 	    ofn.Flags |= dp->flag;
532 	}
533       }
534     }
535   }
536 
537   if ( mode == NAME_open )
538   { ofn.Flags |= OFN_FILEMUSTEXIST;
539     tmpb = GetOpenFileName(&ofn);
540   } else
541     tmpb = GetSaveFileName(&ofn);
542 
543   if ( !tmpb )
544   { DWORD w;
545 
546     if ( !(w=CommDlgExtendedError()) )
547       fail;				/* user canceled */
548 
549     Cprintf("Get{Open,Save}FileName() failed: %ld\n", w);
550     fail;
551   }
552 
553   if ( buffer[0] )
554   { TCHAR *base = baseNameW(buffer);
555 
556     if ( !_tcschr(base, '.') && ofn.nFilterIndex > 0 )
557     { TCHAR *pattern = filter;
558       TCHAR *ext;
559       int n;
560 
561       pattern = filter;
562       pattern += _tcslen(pattern)+1;	/* first pattern */
563       for(n=1; n<ofn.nFilterIndex; n++)
564       { pattern += _tcslen(pattern)+1;
565 	pattern += _tcslen(pattern)+1;
566       }
567 
568       if ( (ext = _tcsrchr(pattern, '.')) && allLetter(ext+1) )
569 	_tcscat(buffer, ext);
570     }
571 
572 #ifdef O_XOS				/* should always be true */
573   { char buf[MAXPATHLEN];
574 
575     if ( !_xos_canonical_filenameW(buffer, buf, sizeof(buf), 0) )
576     { errorPce(TCHARToName(buffer), NAME_representation, NAME_nameTooLong);
577       fail;
578     }
579     rval = UTF8ToName(buf);
580   }
581 #else
582     rval = TCHARToName(buffer);
583 #endif
584   }
585 
586   return rval;
587 }
588 
589 
590 #include <objbase.h>
591 
592 static INT CALLBACK
BrowseCallbackProc(HWND hwnd,UINT uMsg,LPARAM lp,LPARAM pData)593 BrowseCallbackProc(HWND hwnd,
594 		   UINT uMsg,
595 		   LPARAM lp,
596 		   LPARAM pData)
597 { TCHAR szDir[MAX_PATH];
598 
599   switch(uMsg)
600   { case BFFM_INITIALIZED:
601     /* WParam is TRUE since you are passing a path.
602        It would be FALSE if you were passing a pidl. */
603       SendMessage(hwnd, BFFM_SETSELECTION, TRUE, pData);
604       break;
605    case BFFM_SELCHANGED:
606    /* Set the status window to the currently selected path. */
607       if (SHGetPathFromIDList((LPITEMIDLIST) lp, szDir))
608       { SendMessage(hwnd,BFFM_SETSTATUSTEXT,0,(LPARAM)szDir);
609       }
610       break;
611    }
612 
613    return 0;
614 }
615 
616 
617 Name
getWinDirectoryDisplay(DisplayObj d,CharArray title,Directory dir,Any owner)618 getWinDirectoryDisplay(DisplayObj d,
619 		       CharArray title,
620 		       Directory dir,	/* initial dir */
621 		       Any owner)	/* owner window */
622 { BROWSEINFO bi;
623   HWND hwnd;
624   EventObj ev = EVENT->value;
625   LPITEMIDLIST pidl;
626   Name result = NULL;
627 
628   memset(&bi, 0, sizeof(bi));
629 
630   if ( isInteger(owner) )
631     bi.hwndOwner = (void *)valInt(owner);
632   else if ( instanceOfObject(owner, ClassFrame) )
633     bi.hwndOwner = getHwndFrame(owner);
634   else if ( instanceOfObject(ev, ClassEvent) &&
635 	    (hwnd = getHwndWindow(ev->window)) )
636     bi.hwndOwner = hwnd;
637 
638   if ( isDefault(title) )
639     bi.lpszTitle = L"Choose folder";
640   else
641     bi.lpszTitle = nameToTCHAR(title);
642   bi.ulFlags = (BIF_RETURNONLYFSDIRS|BIF_USENEWUI);
643   if ( notDefault(dir) )
644   { wchar_t windir[MAXPATHLEN];
645 
646     bi.lParam = (LPARAM)_xos_os_filenameW(nameToFN(dir->path),
647 					  windir,
648 					  sizeof(windir)/sizeof(wchar_t));
649     if ( bi.lParam )
650       bi.lpfn = BrowseCallbackProc;
651   }
652 
653   CoInitialize(NULL);
654 
655   if ( (pidl = SHBrowseForFolder(&bi)) )
656   { TCHAR path[MAX_PATH];
657 
658     if ( SHGetPathFromIDList(pidl, path) )
659     {
660 #ifdef O_XOS				/* should always be true */
661       char buf[MAXPATHLEN];
662 
663       if ( _xos_canonical_filenameW(path, buf, sizeof(buf), 0) )
664 	result = UTF8ToName(buf);
665       else
666 	errorPce(TCHARToName(path), NAME_representation, NAME_nameTooLong);
667 #else
668       result = TCHARToName(path);
669 #endif
670     }
671 
672 #if 1
673     CoTaskMemFree(pidl);
674 #else
675   { IMalloc *im = NULL;
676     if ( SHGetMalloc(&im) == NOERROR )
677     { im->Free(pidl);			/* these are C++ methods! */
678       im->Release();
679     }
680   }
681 #endif
682   }
683 
684   CoUninitialize();
685 
686   return result;
687 }
688 
689