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) 1999-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 #include <h/kernel.h>
36 #include <h/graphics.h>
37 #include <h/lang.h>
38 #include <h/unix.h>
39 #include <h/text.h>
40
41 static status contextClassVariable(ClassVariable cv, Class context);
42 static StringObj getDefault(Class class, Name name, int accept_default);
43 static status appendClassVariableClass(Class class, ClassVariable cv);
44
45 static Constant NotObtained;
46
47 static status
initialiseClassVariable(ClassVariable cv,Class context,Name name,Any def,Type type,StringObj summary)48 initialiseClassVariable(ClassVariable cv,
49 Class context, Name name, Any def,
50 Type type, StringObj summary)
51 { initialiseProgramObject(cv);
52
53 assign(cv, name, name);
54 assign(cv, type, type);
55 assign(cv, cv_default, def);
56 assign(cv, value, NotObtained);
57 assign(cv, summary, summary);
58
59 contextClassVariable(cv, context);
60
61 return appendClassVariableClass(context, cv);
62 }
63
64
65 static status
contextClassVariable(ClassVariable cv,Class context)66 contextClassVariable(ClassVariable cv, Class context)
67 { if ( cv->context != context )
68 { Variable var = getInstanceVariableClass(context, cv->name);
69
70 assign(cv, context, context);
71 assign(cv, value, NotObtained);
72
73 if ( isDefault(cv->type) )
74 assign(cv, type, var ? var->type : TypeAny);
75 }
76
77 succeed;
78 }
79
80 static StringObj
getSummaryClassVariable(ClassVariable cv)81 getSummaryClassVariable(ClassVariable cv)
82 { Class class = cv->class;
83 Variable var;
84
85 if ( instanceOfObject(cv->summary, ClassString) )
86 answer(cv->summary);
87
88 if ( isDefault(cv->summary) &&
89 (var = getInstanceVariableClass(class, cv->name)) )
90 { if ( notNil(var->summary) )
91 answer(var->summary); /* TBD: getSummaryVariable() */
92 }
93 /* TBD: look for inheritence */
94 fail;
95 }
96
97 /*******************************
98 * STRING --> VALUE *
99 *******************************/
100
101 static status
convertFunctionRequiresName(Type t)102 convertFunctionRequiresName(Type t)
103 { if ( t->kind == NAME_class )
104 { Class cl = t->context;
105 GetMethod m = getGetMethodClass(cl, NAME_convert);
106
107 if ( m && m->types->size == ONE )
108 { Type at = m->types->elements[0];
109
110 if ( at == TypeName || at->kind == NAME_nameOf )
111 succeed;
112 }
113 }
114
115 fail;
116 }
117
118
119 static struct TAGop
120 { char *name;
121 int priority;
122 Name kind;
123 } operators[] =
124 { { "?", 150, NAME_yfx},
125 { ":=", 990, NAME_xfx},
126 { "@=", 990, NAME_xfx},
127 { "*", 400, NAME_yfx},
128 { "/", 400, NAME_yfx},
129 { "<", 700, NAME_xfx},
130 { "=", 700, NAME_xfx},
131 { "=<", 700, NAME_xfx},
132 { ">=", 700, NAME_xfx},
133 { "==", 700, NAME_xfx},
134 { ">", 700, NAME_xfx},
135 { "-", 500, NAME_yfx},
136 { "-", 500, NAME_fx},
137 { "\\==", 700, NAME_xfx},
138 { "+", 500, NAME_yfx},
139 { "+", 500, NAME_fx},
140 { NULL, 0, NULL }
141 };
142
143
144 static Parser
TheObjectParser()145 TheObjectParser()
146 { static Parser p;
147
148 if ( !p )
149 { SyntaxTable st = newObject(ClassSyntaxTable, EAV);
150 Tokeniser t = newObject(ClassTokeniser, st, EAV);
151 struct TAGop *o = operators;
152
153 p = globalObject(NAME_objectParser, ClassParser, t, EAV);
154
155 send(p, NAME_active, CtoName("@"),
156 newObject(ClassObtain, PCE, NAME_objectFromReference,
157 newObject(ClassObtain, RECEIVER, NAME_token, EAV),
158 EAV),
159 EAV);
160 send(p, NAME_active, CtoName("["),
161 newObject(ClassObtain, RECEIVER, NAME_list,
162 CtoName("]"), CtoName(","), NAME_chain, EAV),
163 EAV);
164 send(p, NAME_sendMethod,
165 newObject(ClassSendMethod,
166 NAME_syntaxError,
167 newObject(ClassVector, NAME_charArray, EAV),
168 newObject(ClassOr, EAV),
169 CtoString("Just fail on syntax-error"),
170 EAV),
171 EAV);
172
173 for( ; o->name; o++)
174 send(p, NAME_operator,
175 newObject(ClassOperator,
176 CtoName(o->name), toInt(o->priority), o->kind, EAV), EAV);
177 }
178
179 return p;
180 }
181
182
183 static Any
getConvertStringClassVariable(ClassVariable cv,CharArray value)184 getConvertStringClassVariable(ClassVariable cv, CharArray value)
185 { Any val;
186
187 if ( cv->type->fullname == NAME_geometry )
188 return checkType(value, cv->type, cv->context);
189
190 if ( (val = qadGetv(TheObjectParser(), NAME_parse, 1, (Any *)&value)) )
191 answer(checkType(val, cv->type, cv->context));
192
193 if ( syntax.uppercase && specialisedType(cv->type, TypeName) )
194 { val = CtoKeyword(strName(value));
195 answer(checkType(val, cv->type, cv->context));
196 }
197
198 if ( specialisedType(cv->type, TypeCharArray) ||
199 value->data.s_size == 0 ) /* empty atom */
200 answer(checkType(value, cv->type, cv->context));
201
202 if ( syntax.uppercase &&
203 (specialisedType(cv->type, TypeName) ||
204 convertFunctionRequiresName(cv->type)) )
205 value = (CharArray) CtoKeyword(strName(value));
206
207 if ( (val = checkType(value, cv->type, cv->context)) )
208 { if ( !includesType(cv->type, nameToType(NAME_font)) )
209 errorPce(cv, NAME_oldDefaultFormat, value);
210
211 answer(val);
212 }
213
214 fail;
215 }
216
217
218 static ClassVariable
getSubClassVariable(ClassVariable cv,Class class)219 getSubClassVariable(ClassVariable cv, Class class)
220 { if ( cv->context == class )
221 { answer(cv);
222 } else
223 { Any val;
224 Name name = class->name;
225
226 if ( (val = getDefault(class, name, FALSE)) )
227 { ClassVariable clone = get(cv, NAME_clone, EAV);
228
229 assert(clone);
230 contextClassVariable(clone, class);
231 doneObject(val); /* What to do with this? */
232
233 answer(clone);
234 } else
235 { answer(cv);
236 }
237 }
238 }
239
240
241 static CharArray
getStringValueClassVariable(ClassVariable cv)242 getStringValueClassVariable(ClassVariable cv)
243 { Any val;
244 Class class = cv->context;
245
246 if ( (val = getDefault(class, cv->name, TRUE)) )
247 answer(val);
248
249 fail;
250 }
251
252
253 Any
getValueClassVariable(ClassVariable cv)254 getValueClassVariable(ClassVariable cv)
255 { if ( cv->value == NotObtained )
256 { CharArray str;
257 Any rval = FAIL;
258
259 if ( (str = getStringValueClassVariable(cv)) )
260 { if ( !(rval=qadGetv(cv, NAME_convertString, 1, (Any *)&str)) )
261 errorPce(cv, NAME_cannotConvertDefault, str);
262 }
263
264 if ( !rval )
265 { if ( onDFlag(cv, DCV_TEXTUAL) )
266 rval = qadGetv(cv, NAME_convertString, 1, (Any *)&cv->cv_default);
267 else
268 rval = checkType(cv->cv_default, cv->type, cv->context);
269
270 if ( !rval )
271 { errorPce(cv, NAME_cannotConvertProgramDefault, cv->cv_default);
272 fail;
273 }
274 }
275
276 assign(cv, value, rval);
277 if ( str )
278 doneObject(str);
279 }
280
281 answer(cv->value);
282 }
283
284
285 static status
valueClassVariable(ClassVariable cv,Any value)286 valueClassVariable(ClassVariable cv, Any value)
287 { Any val;
288
289 if ( (val = checkType(value, cv->type, cv->context)) )
290 { assign(cv, value, val);
291
292 succeed;
293 }
294
295 return errorTypeMismatch(cv,
296 getMethodFromFunction((Any)valueClassVariable), 1,
297 cv->type,
298 value);
299 }
300
301
302 /********************************
303 * CLASS CATCHALL *
304 ********************************/
305
306 static void
fixInstanceProtoClass(Class class)307 fixInstanceProtoClass(Class class)
308 { if ( class->realised == ON )
309 { unallocInstanceProtoClass(class);
310
311 if ( notNil(class->sub_classes) )
312 { Cell cell;
313
314 for_cell(cell, class->sub_classes)
315 fixInstanceProtoClass(cell->value);
316 }
317 }
318 }
319
320
321 static status
appendClassVariableClass(Class class,ClassVariable cv)322 appendClassVariableClass(Class class, ClassVariable cv)
323 { Cell cell;
324
325 fixInstanceProtoClass(class);
326 realiseClass(class);
327
328 for_cell(cell, class->class_variables)
329 { ClassVariable r2 = cell->value;
330
331 if ( r2->name == cv->name )
332 { cellValueChain(class->class_variables, PointerToInt(cell), cv);
333 succeed;
334 }
335 }
336
337 return appendChain(class->class_variables, cv);
338 }
339
340
341 ClassVariable
getClassVariableClass(Class class,Name name)342 getClassVariableClass(Class class, Name name)
343 { ClassVariable cv;
344 Cell cell;
345
346 realiseClass(class);
347
348 if ( isNil(class->class_variable_table) )
349 assign(class, class_variable_table, newObject(ClassHashTable, EAV));
350 else if ( (cv=getMemberHashTable(class->class_variable_table, name)) )
351 answer(cv);
352
353 for_cell(cell, class->class_variables)
354 { cv = cell->value;
355
356 if ( cv->name == name )
357 { appendHashTable(class->class_variable_table, name, cv);
358 answer(cv);
359 }
360 }
361
362 if ( notNil(class->super_class) )
363 { ClassVariable super = getClassVariableClass(class->super_class, name);
364
365 if ( super )
366 { cv = getSubClassVariable(super, class);
367 appendHashTable(class->class_variable_table, name, cv);
368 answer(cv);
369 }
370 }
371
372 fail;
373 }
374
375
376 status
classVariableValueClass(Class cl,Name name,Any val)377 classVariableValueClass(Class cl, Name name, Any val)
378 { ClassVariable cv;
379
380 if ( (cv = getClassVariableClass(cl, name)) )
381 return valueClassVariable(cv, val);
382
383 fail;
384 }
385
386
387 Any
getClassVariableValueClass(Class cl,Name name)388 getClassVariableValueClass(Class cl, Name name)
389 { ClassVariable cv;
390
391 if ( (cv = getClassVariableClass(cl, name)) )
392 answer(getValueClassVariable(cv));
393
394 fail;
395 }
396
397
398 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
399 NOTE: default value is *NOT* copied, so the caller must pass a string
400 that will not be deleted: either a character constant or a value saved
401 using save_string.
402 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
403
404 status
attach_class_variable(Class cl,Name name,const char * type,const char * def,const char * doc)405 attach_class_variable(Class cl,
406 Name name, const char *type,
407 const char *def,
408 const char *doc)
409 { ClassVariable cv;
410 StringObj s = (doc && strlen(doc) > 0 ? CtoString(doc) : DEFAULT);
411 Name tp = (type ? CtoName(type) : DEFAULT);
412
413 /* TBD: Default value! */
414 if ( (cv = newObject(ClassClassVariable,
415 cl, name, DEFAULT, tp, s, EAV)) )
416 { assign(cv, cv_default, staticCtoString(def));
417 setDFlag(cv, DCV_TEXTUAL); /* value is textual */
418
419 succeed;
420 }
421
422 fail;
423 }
424
425
426 status
refine_class_variable(Class cl,const char * name_s,const char * def)427 refine_class_variable(Class cl, const char *name_s, const char *def)
428 { Class super;
429 Name name = CtoName(name_s);
430
431 for( super = cl->super_class; notNil(super); super = super->super_class)
432 { Cell cell;
433
434 for_cell(cell, super->class_variables)
435 { ClassVariable cv = cell->value;
436
437 if ( cv->name == name ) /* found it! */
438 { ClassVariable cv2;
439
440 if ( (cv2 = newObject(ClassClassVariable,
441 cl, name, DEFAULT, cv->type, cv->summary, EAV)) )
442 { assign(cv2, cv_default, staticCtoString(def));
443 setDFlag(cv2, DCV_TEXTUAL); /* value is textual */
444
445 succeed;
446 }
447 assert(0);
448 }
449 }
450 }
451
452 sysPce("Could not find super-class-variable to refine %s.%s\n",
453 pp(cl->name), name_s);
454 fail; /* NOTREACHED */
455 }
456
457
458 /********************************
459 * MANUAL SUPPORT *
460 ********************************/
461
462
463 static Name
getManIdClassVariable(ClassVariable cv)464 getManIdClassVariable(ClassVariable cv)
465 { wchar_t buf[LINESIZE];
466 wchar_t *nm, *o;
467 Name ctx = ((Class)cv->context)->name;
468 size_t len;
469 Name rc;
470
471 len = 4 + ctx->data.s_size + cv->name->data.s_size;
472 if ( len < LINESIZE )
473 nm = buf;
474 else
475 nm = pceMalloc(sizeof(wchar_t)*len);
476
477 o = nm;
478 *o++ = 'R';
479 *o++ = '.';
480 wcscpy(o, nameToWC(ctx, &len)); o += len;
481 *o++ = '.';
482 wcscpy(o, nameToWC(cv->name, &len)); o += len;
483
484 rc = WCToName(nm, o-nm);
485 if ( nm != buf )
486 pceFree(nm);
487
488 answer(rc);
489 }
490
491
492 static Name
getManIndicatorClassVariable(ClassVariable cv)493 getManIndicatorClassVariable(ClassVariable cv)
494 { answer(CtoName("R")); /* TBD: may be a class-variable :-) */
495 }
496
497
498 static StringObj
getManSummaryClassVariable(ClassVariable cv)499 getManSummaryClassVariable(ClassVariable cv)
500 { TextBuffer tb;
501 StringObj str;
502 StringObj tmp;
503
504 tb = newObject(ClassTextBuffer, EAV);
505 tb->undo_buffer_size = ZERO;
506 CAppendTextBuffer(tb, "R\t");
507
508 appendTextBuffer(tb, (CharArray)((Class)cv->context)->name, ONE);
509 CAppendTextBuffer(tb, ".");
510 appendTextBuffer(tb, (CharArray)cv->name, ONE);
511 CAppendTextBuffer(tb, ": ");
512 appendTextBuffer(tb, (CharArray)getCapitaliseName(cv->type->fullname), ONE);
513
514 if ( (tmp = getSummaryClassVariable(cv)) )
515 { CAppendTextBuffer(tb, "\t");
516 appendTextBuffer(tb, (CharArray)tmp, ONE);
517 }
518 if ( send(cv, NAME_hasHelp, EAV) )
519 CAppendTextBuffer(tb, " (+)");
520
521 str = getContentsTextBuffer(tb, ZERO, DEFAULT);
522 doneObject(tb);
523
524 answer(str);
525 }
526
527
528 static Name
getPrintNameClassVariable(ClassVariable cv)529 getPrintNameClassVariable(ClassVariable cv)
530 { wchar_t buf[LINESIZE];
531 wchar_t *nm, *o;
532 Name ctx = ((Class)cv->context)->name;
533 size_t len;
534 Name rc;
535
536 len = 2 + ctx->data.s_size + cv->name->data.s_size;
537 if ( len < LINESIZE )
538 nm = buf;
539 else
540 nm = pceMalloc(sizeof(wchar_t)*len);
541
542 o = nm;
543 wcscpy(o, nameToWC(ctx, &len)); o += len;
544 *o++ = '.';
545 wcscpy(o, nameToWC(cv->name, &len)); o += len;
546
547 rc = WCToName(nm, o-nm);
548 if ( nm != buf )
549 pceFree(nm);
550
551 answer(rc);
552 }
553
554
555 static Name
getGroupClassVariable(ClassVariable cv)556 getGroupClassVariable(ClassVariable cv)
557 { Variable var;
558
559 if ( (var = getInstanceVariableClass(cv->context, cv->name)) )
560 answer(getGroupVariable(var));
561
562 fail;
563 }
564
565 /*******************************
566 * BEHAVIOUR *
567 *******************************/
568
569 static Any
getGetClassVariable(ClassVariable var,Any rec)570 getGetClassVariable(ClassVariable var, Any rec)
571 { answer(getValueClassVariable(var));
572 }
573
574 /*******************************
575 * CLASS DECLARATION *
576 *******************************/
577
578 /* Type declarations */
579
580 static char *T_initialise[] =
581 { "class=class", "name=name", "default=any",
582 "type=[type]", "summary=[string]*" };
583
584 /* Instance Variables */
585
586 static vardecl var_class_variable[] =
587 { IV(NAME_type, "type", IV_GET,
588 NAME_type, "Type of the class-variable"),
589 IV(NAME_value, "any", IV_NONE,
590 NAME_cache, "Current value"),
591 IV(NAME_default, "any", IV_GET,
592 NAME_default, "Program default value"),
593 IV(NAME_summary, "[string]*", IV_GET,
594 NAME_manual, "Summary documentation")
595 };
596
597 /* Send Methods */
598
599 static senddecl send_class_variable[] =
600 { SM(NAME_initialise, 5, T_initialise, initialiseClassVariable,
601 DEFAULT, "Create and associate to class"),
602 SM(NAME_value, 1, "any", valueClassVariable,
603 NAME_value, "Set value of the class variable")
604 };
605
606 /* Get Methods */
607
608 static getdecl get_class_variable[] =
609 { GM(NAME_group, 0, "name", NULL, getGroupClassVariable,
610 NAME_manual, "Same as related variable"),
611 GM(NAME_manId, 0, "name", NULL, getManIdClassVariable,
612 NAME_manual, "Card Id for class variable"),
613 GM(NAME_manIndicator, 0, "name", NULL, getManIndicatorClassVariable,
614 NAME_manual, "Manual type indicator (`R')"),
615 GM(NAME_manSummary, 0, "string", NULL, getManSummaryClassVariable,
616 NAME_manual, "New string with documentation summary"),
617 GM(NAME_printName, 0, "name", NULL, getPrintNameClassVariable,
618 NAME_textual, "class.name"),
619 GM(NAME_convertString, 1, "any|function", "textual=char_array",
620 getConvertStringClassVariable,
621 NAME_value, "Convert textual value into typed value"),
622 GM(NAME_stringValue, 0, "char_array", NULL, getStringValueClassVariable,
623 NAME_value, "Obtain and return value as a char_array"),
624 GM(NAME_value, 0, "any", NULL, getValueClassVariable,
625 NAME_value, "Compute and return the value"),
626 GM(NAME_get, 1, "unchecked", "object", getGetClassVariable,
627 NAME_execute, "Invoke (read) class-variable")
628 };
629
630 /* ClassVariables */
631
632 #define rc_class_variable NULL
633 /*
634 static classvardecl rc_class_variable[] =
635 {
636 };
637 */
638
639 /* Class Declaration */
640
641 static Name cv_termnames[] = { NAME_context, NAME_name, NAME_default,
642 NAME_type, NAME_summary };
643
644 ClassDecl(class_variable_decls,
645 var_class_variable, send_class_variable, get_class_variable, rc_class_variable,
646 5, cv_termnames,
647 "$Rev$");
648
649
650 status
makeClassClassVariable(Class class)651 makeClassClassVariable(Class class)
652 { declareClass(class, &class_variable_decls);
653
654 cloneStyleVariableClass(class, NAME_summary, NAME_reference);
655 cloneStyleVariableClass(class, NAME_value, NAME_reference);
656
657 NotObtained=globalObject(NAME_notObtained, ClassConstant,
658 NAME_notObtained,
659 CtoString("Value of not-obtained class-variable"),
660 EAV);
661
662 succeed;
663 }
664
665 /*******************************
666 * FETCH FROM Defaults file *
667 *******************************/
668
669 static ChainTable ClassVariableTable;
670 static Name name_star; /* '*' */
671
672 #define LBUFSIZE 256 /* initial value buffer */
673 #define MAXFIELDS 10 /* Max # x.y.z... fields */
674
675 static void
add_class_variable(int nfields,Name * fields,StringObj value)676 add_class_variable(int nfields, Name *fields, StringObj value)
677 { if ( nfields > 0 )
678 { Name resname = fields[nfields-1];
679
680 if ( resname != name_star )
681 { Any argv[10];
682 int i, argc;
683
684 for(argc = 0, i=0; i < (nfields-1); i++)
685 argv[argc++] = fields[i];
686 argv[argc++] = value;
687
688 appendChainTable(ClassVariableTable, resname,
689 newObjectv(ClassVector, argc, argv));
690 }
691 }
692 }
693
694
695 static char *
matchword(const char * s,const char * m)696 matchword(const char *s, const char *m)
697 { while(*m && *s == *m)
698 m++, s++;
699
700 if ( !*m && isspace(*s) )
701 return (char *)s;
702
703 return NULL;
704 }
705
706
707 static StringObj
restline(const char * s)708 restline(const char *s)
709 { string str;
710 const char *e;
711
712 e = s+strlen(s);
713 while(e > s && isspace(e[-1]) )
714 e--;
715 str_set_n_ascii(&str, e-s, (char *)s);
716
717 return StringToString(&str);
718 }
719
720
721 static status
loadDefaultClassVariables(SourceSink f)722 loadDefaultClassVariables(SourceSink f)
723 { int lineno = 0;
724 IOSTREAM *fd;
725
726 if ( (fd = Sopen_object(f, "rbr")) )
727 { char line[LINESIZE];
728
729 while( Sfgets(line, sizeof(line), fd) )
730 { char *s = line;
731 char *e;
732 Name fields[MAXFIELDS];
733 int nfields = 0;
734 StringObj value;
735
736 lineno++;
737
738 while(isblank(*s) || *s == '\r')
739 s++;
740 if ( s[0] == '!' || s[0] == '\n' )
741 continue;
742
743 if ( s[0] == '#' ) /* #include file */
744 { s++;
745 while(isblank(*s))
746 s++;
747 if ( (s = matchword(s, "include")) )
748 { while(isblank(*s))
749 s++;
750 if ( s )
751 { StringObj fn = restline(s);
752 Any fincluded = newObject(ClassFile, fn, NAME_utf8, EAV);
753
754 if ( send(fincluded, NAME_exists, EAV) )
755 loadDefaultClassVariables(fincluded);
756
757 doneObject(fincluded);
758 }
759 }
760 continue;
761 }
762
763 for(;;)
764 { if ( iscsym(*s) )
765 { string str;
766
767 for(e=s; iscsym(*e); e++)
768 ;
769 str_set_n_ascii(&str, e-s, s);
770 fields[nfields++] = StringToName(&str);
771 s = e;
772 DEBUG(NAME_default, Cprintf("found %s\n", pp(fields[nfields-1])));
773 continue;
774 }
775
776 if ( *s == '*' )
777 { fields[nfields++] = name_star;
778 DEBUG(NAME_default, Cprintf("found %s\n", pp(fields[nfields-1])));
779 s++;
780 continue;
781 }
782
783 if ( *s == '.' ) /* field separator */
784 { s++;
785 continue;
786 }
787
788 if ( *s == ':' ) /* value separator */
789 { char localbuf[LBUFSIZE];
790 char *buf = localbuf;
791 int bufsize = LBUFSIZE;
792 int size = 0;
793 int l;
794 string str;
795
796 s++; /* skip the ':' */
797
798 for(;;)
799 { for(s++; isblank(*s); s++)
800 ;
801 l = (int)strlen(s);
802 /* delete [\r\n]*$ */
803 while( l > 0 && (s[l-1] == '\n' || s[l-1] == '\r') )
804 s[--l] = EOS;
805 /* make buffer big enough */
806 while ( size + l > bufsize )
807 { bufsize *= 2;
808 if ( buf == localbuf )
809 { buf = pceMalloc(bufsize);
810 strncpy(buf, localbuf, size);
811 } else
812 buf = pceRealloc(buf, bufsize);
813 }
814
815 /* copy the new line to the buf */
816 strncpy(&buf[size], s, l);
817 size += l;
818
819 /* continue if ended in a `\' */
820 if ( s[l-1] == '\\' )
821 { buf[size-1] = ' ';
822 if ( !Sfgets(line, sizeof(line), fd) )
823 { errorPce(PCE, NAME_defaultSyntaxError, f, toInt(lineno));
824 goto out;
825 }
826 s = line;
827
828 continue;
829 }
830
831 break;
832 }
833
834 str_set_n_ascii(&str, size, buf);
835 value = StringToString(&str);
836 DEBUG(NAME_default, Cprintf("Value = %s\n", pp(value)));
837 add_class_variable(nfields, fields, value);
838 if ( buf != localbuf )
839 pceFree(buf);
840 goto next;
841 } else
842 { errorPce(PCE, NAME_defaultSyntaxError, f, toInt(lineno));
843 goto next;
844 }
845 }
846 next:
847 ;
848 }
849 out:
850 ;
851
852 Sclose(fd);
853 succeed;
854 }
855
856 fail;
857 }
858
859
860 status
loadDefaultsPce(Pce pce,SourceSink from)861 loadDefaultsPce(Pce pce, SourceSink from)
862 { if ( !ClassVariableTable )
863 ClassVariableTable = globalObject(NAME_defaultTable, ClassChainTable, EAV);
864
865 if ( isDefault(from) )
866 from = checkType(pce->defaults, nameToType(NAME_file), pce);
867
868 if ( from && send(from, NAME_access, NAME_read, EAV) )
869 { loadDefaultClassVariables(from);
870
871 succeed;
872 }
873
874 fail;
875 }
876
877
878 static int
class_match(Class class,Name name)879 class_match(Class class, Name name)
880 { int ok = 100;
881
882 for( ; notNil(class); class = class->super_class, ok-- )
883 { if ( class->name == name )
884 return ok;
885 }
886
887 return 0; /* no match */
888 }
889
890
891
892 static StringObj
getDefault(Class class,Name name,int accept_default)893 getDefault(Class class, Name name, int accept_default)
894 { Chain ch;
895 static int initialized = FALSE;
896
897 if ( !initialized )
898 { Code code;
899
900 initialized = TRUE;
901
902 name_star = CtoName("*");
903
904 if ( !ClassVariableTable )
905 loadDefaultsPce(PCE, DEFAULT);
906
907 if ( (code = getClassVariableValueObject(PCE, NAME_initialise)) &&
908 instanceOfObject(code, ClassCode) )
909 forwardReceiverCodev(code, PCE, 0, NULL);
910 }
911
912 ch = getMemberHashTable((HashTable)ClassVariableTable, name);
913
914 if ( ch )
915 { Vector best = NIL;
916 int bestok = -1;
917 Cell cell;
918
919 for_cell(cell, ch)
920 { Vector v = cell->value;
921 int size = valInt(v->size);
922 Any *elements = v->elements;
923 int ok = 0;
924
925 if ( size == 2 ) /* class.attribute */
926 { Name cname = elements[0];
927
928 if ( accept_default && cname == name_star )
929 ok = 10;
930 else
931 ok = class_match(class, cname);
932
933 DEBUG(NAME_default, Cprintf("%s using %s: ok = %d (e0=%s)\n",
934 pp(name), pp(v), ok, pp(cname)));
935
936 }
937
938 if ( ok && ok >= bestok )
939 { best = v;
940 bestok = ok;
941 }
942 }
943
944 if ( notNil(best) )
945 return getTailVector(best);
946 }
947
948 fail; /* uses the default */
949 }
950
951