File: hrdwrobs.c

package info (click to toggle)
xlispstat 3.52.0-3
  • links: PTS
  • area: main
  • in suites: hamm, slink
  • size: 7,472 kB
  • ctags: 12,480
  • sloc: ansic: 89,534; lisp: 21,690; sh: 1,525; makefile: 520; csh: 1
file content (429 lines) | stat: -rw-r--r-- 14,013 bytes parent folder | download | duplicates (4)
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
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
/* hrdwrobjs - Lisp representation of physical machine objects.        */
/* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
/* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
/* You may give out copies of this software; for conditions see the    */
/* file COPYING included with this distribution.                       */

/*
Physical machine objects, such as windows or menus, allocated in a 
session are represented as xlisp objects. A list of such objects is
kept in the variable *HARDWARE-OBJECTS*. Every such object must 
understand the :ALLOCATE and :DISPOSE messages. When an object is
created it is entered into the list; when it is disposed it must 
remove itself from the list. The object is assumed to have an
instance variable HARDWARE-ADDRESS that will be set to the 
representation described below when the object is allocated and to
NIL otherwise.

Representations for the machine address include information to allow
determination of whether an address is valid or not. This is as
protection from referencing objects from a previous session after a 
restore. The restore function will be modified to deallocate all
objects in the old *HARDWARE-OBJECTS* list before the restore and 
reallocate objects in this list after the restore. The menu bar may
require special handling.
*/

#include "xlisp.h"
#include "xlstat.h"

/* external variables */
extern LVAL s_true;
extern LVAL s_hardware_address, s_hardware_objects, sk_clobber;

/*extern long time_stamp;*/
#define time_stamp 0

#define NONE -1
#define WINDOW 0
#define IVIEWWINDOW 1
#define IVIEW 2
#define SPINNER 3
#define SCATMAT 4
#define HISTOGRAM 5
#define NAMELIST 6

#define MENU 7
#define APPLEMENU 8
#define DIALOG 9
#define EDIT 10
#define DISPLAY 11

static int window_data[] = { WINDOW, NONE };
static int *window = window_data;
static int iview_window_data[] = { WINDOW, IVIEWWINDOW, NONE };
static int *iview_window = iview_window_data;
static int iview_data[] = { WINDOW, IVIEWWINDOW, IVIEW, NONE };
static int *iview = iview_data;
static int menu_data[] = { MENU, NONE };
static int *menu = menu_data;
#ifdef MACINTOSH
static int apple_menu_data[] = { MENU, APPLEMENU, NONE };
static int *apple_menu = apple_menu_data;
#endif /* MACINTOSH */
static int dialog_data[] = { WINDOW, DIALOG, NONE };
static int *dialog = dialog_data;
#ifdef MACINTOSH
static int edit_window_data[] = { WINDOW, EDIT, NONE };
static int *edit_window = edit_window_data;
static int display_window_data[] = { WINDOW, DISPLAY, NONE };
static int *display_window = display_window_data;
#endif /* MACINTOSH */

/**************************************************************************/
/**                                                                      **/
/**                       General Address Functions                      **/
/**                                                                      **/
/**************************************************************************/

/*
Addresses are stored in a list of the form

  (time-stamp address xlisp-object ....)
  
Additional entries give information about the specific type of the object.
*/

LOCAL int valid_hardware_address P2C(LVAL, addr, int *, type)
{
  LVAL val;

  if (! consp(addr)) return(FALSE);
  val = car(addr);
#ifdef DODO
  if (! fixp(val) || (FIXTYPE) time_stamp != getfixnum(val)) return(FALSE);
#endif
  addr = cdr(addr);
  if (! consp(addr) || ! fixp(car(addr))) return(FALSE);
  addr = cdr(addr);
  if (! consp(addr) || ! objectp(car(addr))) return(FALSE);
  addr = cdr(addr);

  for (; *type != NONE; type++, addr = cdr(addr)) {
    if (! consp(addr)) return(FALSE);
    val = car(addr);
    if (! fixp(val) || getfixnum(val) != *type) return(FALSE);
  }
  return(TRUE);
}

LOCAL VOID set_hardware_address P3C(CPTR, ptr, LVAL, object, int *, type)
{
  LVAL t, p, last, result, oblistsym, newoblist;
  
  if (! objectp(object)) xlerror("not an object", object);
  
  oblistsym = s_hardware_objects;
  if (! consp(getvalue(oblistsym))) setvalue(oblistsym, NIL);
  
  xlstkcheck(4);
  xlsave(t);
  xlsave(p);
  xlsave(result);
  xlsave(newoblist);
  
  t = cvfixnum((FIXTYPE) time_stamp);
  p = cvfixnum((FIXTYPE) ptr);
  result = last = consa(object);
  result = cons(p, result);
  result = cons(t, result);
  
  newoblist = cons(result, getvalue(oblistsym));
  setvalue(oblistsym, newoblist);
  set_slot_value(object, s_hardware_address, result);
  
  for (;*type != NONE; type++, last = cdr(last)) {
    t = cvfixnum((FIXTYPE) *type);
    t = consa(t);
    rplacd(last, t);
  }
  xlpopn(4);
}

VOID standard_hardware_clobber P1C(LVAL, object)
{
  LVAL addr, oblist;
  
  if (! objectp(object)) xlerror("not an object", object);
  
  addr = slot_value(object, s_hardware_address);
  
  oblist = getvalue(s_hardware_objects);
  if (! listp(oblist)) xlerror("not a list", oblist);
  
  setvalue(s_hardware_objects, xlcallsubr2(xdelete, addr, oblist));
  set_slot_value(object, s_hardware_address, NIL);
  
  send_callback_message(object, sk_clobber);
}

LVAL get_hardware_object_by_address P1C(CPTR, ptr)
{
  LVAL oblist = getvalue(s_hardware_objects);
  LVAL result, addr;
  
  for (result = NIL; result == NIL && consp(oblist); oblist = cdr(oblist)) {
    addr = car(oblist);
    if (ptr == (CPTR) getfixnum(car(cdr(addr)))) result = car(cdr(cdr(addr)));
  }
  return(result);
}
    
/**************************************************************************/
/**                                                                      **/
/**                       Window Address Functions                       **/
/**                                                                      **/
/**************************************************************************/

int valid_window_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, window));
}

VOID set_window_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, window);
}

CPTR GETWINDOWADDRESS P1C(LVAL, object)
{
  LVAL addr = slot_value(object, s_hardware_address);
  if (addr == NIL) return(NULL);
  if (! valid_window_address(addr))
    xlfail("not a valid window address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}

/**************************************************************************/
/**                                                                      **/
/**                    IView Window Address Functions                    **/
/**                                                                      **/
/**************************************************************************/

int valid_iview_window_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, iview_window));
}

VOID set_iview_window_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, iview_window);
}

CPTR GETIVIEWWINDOWADDRESS P1C(LVAL, object)
{
  LVAL addr = slot_value(object, s_hardware_address);
  if (addr == NIL) return(NULL);
  else if (! valid_iview_window_address(addr))
    xlfail("not a valid graph window address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}

/**************************************************************************/
/**                                                                      **/
/**                        IView Address Functions                       **/
/**                                                                      **/
/**************************************************************************/

int valid_iview_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, iview));
}

VOID set_iview_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, iview);
}

CPTR get_iview_address P1C(LVAL, object)
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_iview_address(addr))
    xlfail("not a valid graph address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}

CPTR GETIVIEWADDRESS P1C(LVAL, object)
{
  LVAL addr = slot_value(object, s_hardware_address);
  if (addr == NIL) return(NULL);
  if (! valid_iview_address(addr))
    xlfail("not a valid graph address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}

/**************************************************************************/
/**                                                                      **/
/**                        Menu Address Functions                        **/
/**                                                                      **/
/**************************************************************************/

int valid_menu_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, menu));
}

VOID set_menu_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, menu);
}

CPTR get_menu_address P1C(LVAL, object)
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_menu_address(addr))
    xlfail("not a valid menu address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}
#ifdef MACINTOSH
/**************************************************************************/
/**                                                                      **/
/**                    Apple Menu Address Functions                      **/
/**                                                                      **/
/**************************************************************************/

int valid_apple_menu_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, apple_menu));
}

VOID set_apple_menu_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, apple_menu);
}

CPTR get_apple_menu_address P1C(LVAL, object)
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_apple_menu_address(addr))
    xlfail("not a valid apple menu address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}
#endif /* MACINTOSH */
#ifdef AMIGA
/**************************************************************************/
/**                                                                      **/
/**                    Amiga Menu Address Functions                      **/
/**                                                                      **/
/**************************************************************************/
/*
int valid_amiga_menu_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, amiga_menu));
}

void set_amiga_menu_address P2C(void *ptr, LVAL, object)
{
  set_hardware_address(ptr, object, amiga_menu);
}

void *get_amiga_menu_address P2C(LVAL, object)
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_amiga_menu_address(addr))
    xlfail("not a valid Amiga menu address - try reallocating the object");
  return((void *)getfixnum(car(cdr(addr))));
}

void set_amiga_menu_window P2C(void *, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, window);
}

void *get_amiga_menu_window(object)
	LVAL object;
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_window_address(addr))
    xlfail("not a valid window address - try reallocating the object");
  return((void *)getfixnum(car(cdr(addr))));
}*/
#endif /* AMIGA */
/**************************************************************************/
/**                                                                      **/
/**                        Dialog Address Functions                      **/
/**                                                                      **/
/**************************************************************************/

int valid_dialog_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, dialog));
}

VOID set_dialog_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, dialog);
}

CPTR GETDIALOGADDRESS P1C(LVAL, object)
{
  LVAL addr = slot_value(object, s_hardware_address);
  if (addr == NIL) return(NULL);
  if (! valid_dialog_address(addr))
    xlfail("not a valid dialog address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}

#ifdef MACINTOSH
/**************************************************************************/
/**                                                                      **/
/**                      Edit Window Address Functions                   **/
/**                                                                      **/
/**************************************************************************/

int valid_edit_window_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, edit_window));
}

VOID set_edit_window_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, edit_window);
}

CPTR get_edit_window_address P1C(LVAL, object)
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_edit_window_address(addr))
    xlfail("not a valid edit window address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}

/**************************************************************************/
/**                                                                      **/
/**                    Display Window Address Functions                  **/
/**                                                                      **/
/**************************************************************************/

int valid_display_window_address P1C(LVAL, addr)
{
  return(valid_hardware_address(addr, display_window));
}

VOID set_display_window_address P2C(CPTR, ptr, LVAL, object)
{
  set_hardware_address(ptr, object, display_window);
}

CPTR get_display_window_address P1C(LVAL, object)
{
  LVAL addr;
  
  addr = slot_value(object, s_hardware_address);
  if (! valid_display_window_address(addr))
    xlfail("not a valid display window address - try reallocating the object");
  return((CPTR) getfixnum(car(cdr(addr))));
}
#endif /* MACINTOSH */