File: pl-ntmain.c

package info (click to toggle)
swi-prolog 3.1.0-2
  • links: PTS
  • area: main
  • in suites: slink
  • size: 8,772 kB
  • ctags: 12,869
  • sloc: ansic: 43,657; perl: 12,577; lisp: 4,359; sh: 1,534; makefile: 798; awk: 14
file content (394 lines) | stat: -rw-r--r-- 9,384 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
/*  $Id: pl-ntmain.c,v 1.8 1997/07/02 15:22:47 jan Exp $

    Copyright (c) 1990 Jan Wielemaker. All rights reserved.
    See ../LICENCE to find out about your rights.
    jan@swi.psy.uva.nl

    Purpose: Provide plwin.exe
*/

#include <windows.h>
#include <stdio.h>
#include "pl-itf.h"
#include "pl-stream.h"
#include <ctype.h>
#include <console.h>
#include <signal.h>

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Main program for running SWI-Prolog from   a window. The window provides
X11-xterm like features: scrollback for a   predefined  number of lines,
cut/paste and the GNU readline library for command-line editing.

Basically, this module combines libpl.dll and console.dll with some glue
to produce the final executable plwin.exe.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */


		 /*******************************
		 *	BIND STREAM STUFF	*
		 *******************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
First step: bind the  console  I/O   to  the  Sinput/Soutput  and Serror
streams.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static int
Srlc_read(void *handle, char *buffer, int size)
{ int fd = (int) handle;
  int ttymode = PL_ttymode(fd);

  if ( ttymode == PL_RAWTTY )
  { int chr = getkey();
      
    if ( chr == 04 || chr == 26 )
      return 0;			/* EOF */

    buffer[0] = chr & 0xff;
    return 1;
  }

  return rlc_read(buffer, size);
}


static int
Srlc_write(void *handle, char *buffer, int size)
{ return rlc_write(buffer, size);
}


static void
rlc_bind_terminal()
{ static IOFUNCTIONS funcs;

  funcs = *Sinput->functions;
  funcs.read     = Srlc_read;
  funcs.write    = Srlc_write;

  Sinput->functions  = &funcs;
  Soutput->functions = &funcs;
  Serror->functions  = &funcs;
}


#ifndef HAVE_LIBREADLINE

static foreign_t
pl_rl_add_history(term_t text)
{ char *s;

  if ( PL_get_chars(text, &s, CVT_ALL) )
  { rlc_add_history(s);

    PL_succeed;
  }

  return PL_warning("rl_add_history/1: instantation fault");
}


static foreign_t
pl_rl_read_init_file(term_t file)
{ PL_succeed;
}


		 /*******************************
		 *	    COMPLETION		*
		 *******************************/

static RlcCompleteFunc file_completer;

static int
prolog_complete(RlcCompleteData data)
{ Line ln = data->line;

  switch(data->call_type)
  { case COMPLETE_INIT:
    { int start = ln->point;
      int c;

      if ( !ln->data )			/* we donot want to complete on all atoms */
	return FALSE;

      while(start > 0 && (isalnum((c=ln->data[start-1])) || c == '_') )
	start--;
      if ( start > 0 )
      { int cs = ln->data[start-1];
	
	if ( strchr("'/\\.~", cs) )
	  return FALSE;			/* treat as a filename */
      }
      if ( islower(ln->data[start]) )	/* Lower, Aplha ...: an atom */
      { int patlen = ln->point - start;
	char *s;

	memcpy(data->buf_handle, &ln->data[start], patlen);
	data->buf_handle[patlen] = '\0';
	
	if ( (s = PL_atom_generator(data->buf_handle, FALSE)) )
	{ strcpy(data->candidate, s);
	  data->replace_from = start;
	  data->function = prolog_complete;
	  return TRUE;
	}
      }

      return FALSE;
    }
    case COMPLETE_ENUMERATE:
    { char *s = PL_atom_generator(data->buf_handle, TRUE);
      if ( s )
      { strcpy(data->candidate, s);
	return TRUE;
      }
      return FALSE;
    }
    case COMPLETE_CLOSE:
      return TRUE;
    default:
      return FALSE;
  }
}


static int
do_complete(RlcCompleteData data)
{ if ( prolog_complete(data) )
    return TRUE;

  if ( file_completer )
    return (*file_completer)(data);
}


#endif /*HAVE_LIBREADLINE*/

		 /*******************************
		 *	   CONSOLE STUFF	*
		 *******************************/

foreign_t
pl_window_title(term_t old, term_t new)
{ char buf[256];
  char *n;

  if ( !PL_get_atom_chars(new, &n) )
    return PL_warning("window_title/2: instantiation fault");

  rlc_title(n, buf, sizeof(buf));

  return PL_unify_atom_chars(old, buf);
}

		 /*******************************
		 *	      SIGNALS		*
		 *******************************/

static DWORD main_thread_id;		/* ThreadId of main thread */
#define WM_SIGNALLED (WM_USER+1)

static WINAPI
pl_wnd_proc(HWND hwnd, UINT message, UINT wParam, LONG lParam)
{ switch(message)
  { case WM_SIGNALLED:
      PL_handle_signals();
      return 0;
  }

  return DefWindowProc(hwnd, message, wParam, lParam);
}


static char *
HiddenFrameClass()
{ static char winclassname[32];
  static WNDCLASS wndClass;
  HINSTANCE instance = rlc_hinstance();

  if ( !winclassname[0] )
  { sprintf(winclassname, "SWI-Prolog-hidden-win%d", instance);

    wndClass.style		= 0;
    wndClass.lpfnWndProc	= (LPVOID) pl_wnd_proc;
    wndClass.cbClsExtra		= 0;
    wndClass.cbWndExtra		= 0;
    wndClass.hInstance		= instance;
    wndClass.hIcon		= NULL;
    wndClass.hCursor		= NULL;
    wndClass.hbrBackground	= GetStockObject(WHITE_BRUSH);
    wndClass.lpszMenuName	= NULL;
    wndClass.lpszClassName	= winclassname;

    RegisterClass(&wndClass);
  }

  return winclassname;
}


static void
destroy_hidden_window(int status, void *data)
{ HWND win = (HWND) data;

  DestroyWindow(win);
}


HWND
PL_hidden_window()
{ static HWND window;

  if ( !window )
  { window = CreateWindow(HiddenFrameClass(),
			  "SWI-Prolog hidden window",
			  0,
			  0, 0, 32, 32,
			  NULL, NULL, rlc_hinstance(), NULL);
    PL_on_halt(destroy_hidden_window, (void *)window);
  }

  return window;
}

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Capturing fatal signals doesn't appear to work   inside  a DLL, hence we
cpature them in the application and tell   Prolog to print the stack and
abort.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static void
fatalSignal(int sig)
{ char *name;

  switch(sig)
  { case SIGABRT:	name = "abort"; break;
    case SIGFPE:	name = "floating point exeception"; break;
    case SIGILL:	name = "illegal instruction"; break;
    case SIGSEGV:	name = "general protection fault"; break;
    default:		name = "(unknown)"; break;
  }

  PL_warning("Trapped signal %d (%s), aborting ...", sig, name);

  PL_action(PL_ACTION_BACKTRACE, (void *)10);
  signal(sig, fatalSignal);
  PL_action(PL_ACTION_ABORT, NULL);
}


static void
initSignals()
{ signal(SIGABRT, fatalSignal);
  signal(SIGFPE,  fatalSignal);
  signal(SIGILL,  fatalSignal);
  signal(SIGSEGV, fatalSignal);
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
If we are in  the  same  thread,   we  can  call  the interrupt-handling
rountine immediately. Otherwise we will   use  Prolog's signal scheduler
and wait for it to be raised.

Maybe we should wait for a little until the signal is handled by Prolog,
and indicate if this is not the case within a few seconds.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static void
interrupt(int sig)
{ if ( GetCurrentThreadId() == main_thread_id )
    PL_interrupt(sig);
  else
  { PL_raise(sig);
    PostMessage(PL_hidden_window(), WM_SIGNALLED, 0, 0);
  }
}


		 /*******************************
		 *	       MAIN		*
		 *******************************/


static void
set_window_title()
{ char title[256];
  long v = PL_query(PL_QUERY_VERSION);
  int major = v / 10000;
  int minor = (v / 100) % 100;
  int patch = v % 100;

  Ssprintf(title, "SWI-Prolog (version %d.%d.%d)", major, minor, patch);
  rlc_title(title, NULL, 0);
}


PL_extension extensions[] =
{
/*{ "name",	arity,  function,	PL_FA_<flags> },*/

  { "window_title", 2,  pl_window_title, 0 },
  { NULL,	    0, 	NULL,		 0 }	/* terminating line */
};


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This function is called back from the   console.dll main loop to provide
the main for the application.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static void
install_readline(int argc, char **argv)
{ 
#ifdef HAVE_LIBREADLINE
  PL_install_readline();
#else /*HAVE_LIBREADLINE*/  
  rlc_init_history(FALSE, 50);
  file_completer = rlc_complete_hook(do_complete);

  PL_register_foreign("rl_add_history",    1, pl_rl_add_history,    0);
  PL_register_foreign("rl_read_init_file", 1, pl_rl_read_init_file, 0);

  PL_set_feature("tty_control", PL_ATOM, "true");
  PL_set_feature("readline",    PL_ATOM, "true");
#endif /*HAVE_LIBREADLINE*/
}


int
win32main(int argc, char **argv)
{ set_window_title();
  rlc_bind_terminal();

  PL_register_extensions(extensions);
  PL_initialise_hook(install_readline);
  if ( !PL_initialise(argc, argv) )
    PL_halt(1);
  
/*PL_async_hook(4000, rlc_check_intr);*/
  PL_hidden_window();			/* create in main thread */
  main_thread_id = GetCurrentThreadId();
  rlc_interrupt_hook(interrupt);
#if !defined(O_DEBUG) && !defined(_DEBUG)
  initSignals();
#endif
  PL_halt(PL_toplevel() ? 0 : 1);

  return 0;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
And this is the  real  application's  main   as  Windows  sees  it.  See
console.c for further details.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int PASCAL
WinMain(HANDLE hInstance, HANDLE hPrevInstance,
	LPSTR lpszCmdLine, int nCmdShow)
{ return rlc_main(hInstance, hPrevInstance, lpszCmdLine, nCmdShow,
		  win32main, LoadIcon(hInstance, "SWI_Icon"));
}