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) 1985-2002, 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
38 #define HASH_DICT_THRESHOLD 50
39
40 static status
initialiseDictv(Dict dict,int argc,Any * argv)41 initialiseDictv(Dict dict, int argc, Any *argv)
42 { int i;
43
44 assign(dict, members, newObject(ClassChain, EAV));
45 assign(dict, browser, NIL);
46 assign(dict, table, NIL);
47
48 for (i = 0; i < argc; i++)
49 appendDict(dict, argv[i]);
50
51 succeed;
52 }
53
54
55 static status
unlinkDict(Dict dict)56 unlinkDict(Dict dict)
57 { if ( notNil(dict->browser) && !isFreeingObj(dict->browser) )
58 send(dict->browser, NAME_dict, NIL, EAV);
59
60 clearDict(dict);
61
62 if ( notNil(dict->table) )
63 { freeObject(dict->table);
64 assign(dict, table, NIL);
65 }
66
67 succeed;
68 }
69
70
71 /*******************************
72 * TABLE *
73 *******************************/
74
75 static HashTable
getTableDict(Dict dict)76 getTableDict(Dict dict)
77 { if ( isNil(dict->table) )
78 { Cell cell;
79
80 assign(dict, table, newObject(ClassHashTable, EAV));
81 for_cell(cell, dict->members)
82 { DictItem di = cell->value;
83 appendHashTable(dict->table, di->key, di);
84 }
85 }
86
87 answer(dict->table);
88 }
89
90
91
92 /********************************
93 * RENUMBER *
94 ********************************/
95
96 static status
renumberDict(Dict dict)97 renumberDict(Dict dict)
98 { int index = 0;
99 Cell cell;
100
101 for_cell(cell, dict->members)
102 { DictItem di = cell->value;
103
104 if ( di->index != toInt(index) )
105 assign(di, index, toInt(index));
106
107 index++;
108 }
109
110 succeed;
111 }
112
113 /********************************
114 * MEMBERSHIP *
115 ********************************/
116
117 DictItem
getMemberDict(Dict dict,Any obj)118 getMemberDict(Dict dict, Any obj)
119 { if ( instanceOfObject(obj, ClassDictItem) )
120 { DictItem di = obj;
121
122 if ( di->dict == dict )
123 answer(di);
124
125 fail;
126 }
127
128 if ( instanceOfObject(obj, ClassCharArray) )
129 obj = toName(obj);
130
131 if ( notNil(dict->table) )
132 answer(getMemberHashTable(dict->table, obj));
133 else if ( valInt(dict->members->size) > HASH_DICT_THRESHOLD )
134 answer(getMemberHashTable(getTableDict(dict), obj));
135 else
136 { Cell cell;
137
138 for_cell(cell, dict->members)
139 { DictItem di = cell->value;
140
141 if ( di->key == obj )
142 answer(di);
143 }
144
145 fail;
146 }
147
148 fail;
149 }
150
151
152 static status
memberDict(Dict dict,Any obj)153 memberDict(Dict dict, Any obj)
154 { if ( getMemberDict(dict, obj) )
155 succeed;
156
157 fail;
158 }
159
160
161 /********************************
162 * APPEND/DELETE *
163 ********************************/
164
165 status
deleteDict(Dict dict,Any obj)166 deleteDict(Dict dict, Any obj)
167 { DictItem di;
168
169 if ( !isFreeingObj(dict) )
170 { TRY( di = getMemberDict(dict, obj) );
171
172 addCodeReference(dict);
173 if ( notNil(dict->browser) && !isFreeingObj(dict->browser) )
174 send(dict->browser, NAME_DeleteItem, di, EAV);
175 if ( notNil(dict->table) )
176 deleteHashTable(dict->table, di->key);
177 assign(di, dict, NIL);
178 deleteChain(dict->members, di);
179 renumberDict(dict);
180 delCodeReference(dict);
181 }
182
183 succeed;
184 }
185
186
187 status
appendDict(Dict dict,DictItem di)188 appendDict(Dict dict, DictItem di)
189 { if ( di->dict == dict )
190 succeed;
191
192 if ( notNil(di->dict) )
193 { addCodeReference(di);
194 deleteDict(di->dict, di);
195 delCodeReference(di);
196 }
197
198 assign(di, dict, dict);
199 assign(di, index, dict->members->size);
200 if ( notNil(dict->table) )
201 appendHashTable(dict->table, di->key, di);
202 appendChain(dict->members, di);
203
204 if ( notNil(dict->browser) )
205 send(dict->browser, NAME_InsertItem, di, EAV);
206
207 succeed;
208 }
209
210
211 static status
membersDict(Dict dict,Chain members)212 membersDict(Dict dict, Chain members)
213 { Cell cell;
214
215 TRY(send(dict, NAME_clear, EAV));
216 for_cell(cell, members)
217 TRY(send(dict, NAME_append, cell->value, EAV));
218
219 succeed;
220 }
221
222
223
224 static status
insertAfterDict(Dict dict,DictItem di,Any after)225 insertAfterDict(Dict dict, DictItem di, Any after)
226 { DictItem a;
227
228 if ( notNil(after) )
229 { TRY(a = getMemberDict(dict, after));
230 } else
231 a = NIL;
232
233 if ( notNil(di->dict) )
234 { addCodeReference(di);
235 deleteDict(di->dict, di);
236 delCodeReference(di);
237 }
238
239 assign(di, dict, dict);
240 if ( notNil(dict->table) )
241 appendHashTable(dict->table, di->key, di);
242 insertAfterChain(dict->members, di, a);
243 renumberDict(dict);
244
245 if ( notNil(dict->browser) )
246 send(dict->browser, NAME_InsertItem, di, EAV);
247
248 succeed;
249 }
250
251
252 DictItem
getFindIndexDict(Dict dict,Int ln)253 getFindIndexDict(Dict dict, Int ln)
254 { DictItem di;
255 Cell cell;
256
257 for_cell(cell, dict->members)
258 { di = cell->value;
259 if ( di->index == ln )
260 answer(di);
261 }
262 fail;
263 }
264
265
266 DictItem
getFindPrefixDict(Dict dict,StringObj str,Int from,BoolObj ign_case)267 getFindPrefixDict(Dict dict, StringObj str, Int from, BoolObj ign_case)
268 { Cell cell;
269
270 if ( isDefault(ign_case) )
271 ign_case = OFF;
272
273 TRY(cell = getNth0CellChain(dict->members, isDefault(from) ? ZERO : from));
274 for( ; notNil(cell); cell = cell->next )
275 { DictItem di = cell->value;
276 CharArray label = getLabelDictItem(di);
277
278 if ( label )
279 { if ( ign_case == OFF )
280 { if ( str_prefix(&label->data, &str->data) )
281 answer(di);
282 } else
283 { if ( str_icase_prefix(&label->data, &str->data) )
284 answer(di);
285 }
286 }
287 }
288
289 fail;
290 }
291
292
293 /********************************
294 * SORTING *
295 ********************************/
296
297 static int sort_ignore_case = FALSE;
298 static int sort_ignore_blanks = FALSE;
299
300 static int
compare_dict_items(const void * d1,const void * d2)301 compare_dict_items(const void *d1, const void *d2)
302 { CharArray c1 = getLabelDictItem(*(DictItem *)d1);
303 CharArray c2 = getLabelDictItem(*(DictItem *)d2);
304
305 if ( c1 && c2 )
306 { PceString s1 = &c1->data;
307 PceString s2 = &c2->data;
308
309 if ( sort_ignore_blanks )
310 { LocalString(t1, s1->s_iswide, s1->s_size);
311 LocalString(t2, s2->s_iswide, s2->s_size);
312
313 str_cpy(t1, s1);
314 str_cpy(t2, s2);
315 str_strip(t1);
316 str_strip(t2);
317
318 if ( sort_ignore_case == TRUE )
319 return str_icase_cmp(t1, t2);
320 else
321 return str_cmp(t1, t2);
322 } else
323 { if ( sort_ignore_case == TRUE )
324 return str_icase_cmp(s1, s2);
325 else
326 return str_cmp(s1, s2);
327 }
328 }
329
330 fail;
331 }
332
333
334 static status
insertDict(Dict dict,DictItem di)335 insertDict(Dict dict, DictItem di)
336 { int codesort = FALSE;
337 Cell cell;
338 DictItem di2;
339 int cmp;
340
341 /* not sorted or empty: just append */
342 if ( isNil(dict->sort_by) || dict->members->size == ZERO )
343 return appendDict(dict, di);
344
345 /* delete from possible old dict */
346 if ( notNil(di->dict) )
347 { addCodeReference(di);
348 deleteDict(di->dict, di);
349 delCodeReference(di);
350 }
351
352 /* find out sorting rules */
353 if ( isDefault(dict->sort_by) )
354 { sort_ignore_case = FALSE;
355 sort_ignore_blanks = FALSE;
356 } else
357 { qsortCompareCode = dict->sort_by;
358 codesort++;
359 }
360
361 /* after the last: use append */
362 di2 = getTailChain(dict->members);
363 cmp = codesort ? qsortCompareObjects(&di, &di2)
364 : compare_dict_items(&di, &di2);
365 if ( cmp >= 0 )
366 return appendDict(dict, di);
367
368 /* associate with the dict */
369 assign(di, dict, dict);
370 if ( notNil(dict->table) )
371 appendHashTable(dict->table, di->key, di);
372
373 /* find its place */
374 for_cell(cell, dict->members)
375 { di2 = cell->value;
376
377 cmp = codesort ? qsortCompareObjects(&di, &di2)
378 : compare_dict_items(&di, &di2);
379 if ( cmp < 0 )
380 { dict->members->current = cell;
381 insertChain(dict->members, di);
382 break;
383 }
384 }
385
386 renumberDict(dict);
387
388 if ( notNil(dict->browser) )
389 send(dict->browser, NAME_InsertItem, di, EAV);
390
391 succeed;
392 }
393
394
395 static status
sortDict(Dict dict,Any code_or_ign_case,BoolObj ign_blanks,BoolObj reverse)396 sortDict(Dict dict, Any code_or_ign_case, BoolObj ign_blanks, BoolObj reverse)
397 { int count, i=0;
398 DictItem *items;
399 Cell cell;
400 Chain old; /* reference count */
401 int codesort = FALSE;
402 int oldrev = qsortReverse;
403 Code sortcode;
404
405 if ( valInt(dict->members->size) <= 1 )
406 succeed;
407
408 if ( instanceOfObject((sortcode=code_or_ign_case), ClassCode) ||
409 (isDefault(code_or_ign_case) &&
410 instanceOfObject((sortcode=dict->sort_by), ClassCode)) )
411 { qsortCompareCode = sortcode;
412 codesort++;
413 } else
414 { if ( isDefault(code_or_ign_case) )
415 code_or_ign_case = getClassVariableValueObject(dict, NAME_sortIgnoreCase);
416 if ( isDefault(ign_blanks) )
417 ign_blanks = getClassVariableValueObject(dict, NAME_sortIgnoreBlanks);
418
419 sort_ignore_case = (code_or_ign_case == ON);
420 sort_ignore_blanks = (ign_blanks == ON);
421 }
422
423 count = valInt(dict->members->size);
424 items = pceMalloc((count*sizeof(DictItem)));
425 for_cell(cell, dict->members)
426 items[i++] = cell->value;
427
428 qsortReverse = (reverse == ON);
429 qsort(items, count, sizeof(DictItem),
430 codesort ? qsortCompareObjects : compare_dict_items);
431 qsortReverse = oldrev;
432
433 /* see whether something changed */
434 for(i=0, cell = dict->members->head; i < count; i++, cell = cell->next)
435 { if ( cell->value != items[i] )
436 break;
437 }
438 if ( i == count ) /* no change */
439 { pceFree(items);
440 succeed;
441 }
442
443 if ( notNil(dict->browser) )
444 send(dict->browser, NAME_Clear, EAV);
445
446 old = dict->members;
447 lockObject(old, ON);
448 assign(dict, members, newObject(ClassChain, EAV));
449
450 if ( notNil(dict->table) )
451 { clearHashTable(dict->table);
452 assign(dict, table, NIL);
453 }
454
455 for (i=0; i<count; i++)
456 { assign(items[i], dict, NIL);
457 appendDict(dict, items[i]);
458 }
459 pceFree(items);
460
461 freeObject(old);
462
463 succeed;
464 }
465
466
467 static status
sortByDict(Dict dict,Code code)468 sortByDict(Dict dict, Code code)
469 { assign(dict, sort_by, code);
470 if ( notNil(code) )
471 return send(dict, NAME_sort, EAV);
472
473 succeed;
474 }
475
476
477 static Chain
getMatchDict(Dict dict,CharArray name)478 getMatchDict(Dict dict, CharArray name)
479 { Cell cell;
480 Chain matching;
481
482 matching = answerObject(ClassChain, EAV);
483
484 for_cell(cell, dict->members)
485 { DictItem di = cell->value;
486 CharArray label = getLabelDictItem(di);
487
488 if ( label && str_sub(&label->data, &name->data) )
489 appendChain(matching, di);
490 }
491
492 answer(matching);
493 }
494
495
496 status
clearDict(Dict dict)497 clearDict(Dict dict)
498 { Cell cell;
499
500 if ( dict->members->size == ZERO )
501 succeed;
502
503 if ( notNil(dict->browser) && !isFreeingObj(dict->browser) )
504 send(dict->browser, NAME_Clear, EAV);
505
506 if ( notNil(dict->table) )
507 { clearHashTable(dict->table);
508 assign(dict, table, NIL);
509 }
510 for_cell(cell, dict->members)
511 { DictItem di = cell->value;
512 assign(di, dict, NIL);
513 }
514 clearChain(dict->members);
515
516 succeed;
517 }
518
519
520 static status
forAllDict(Dict d,Code code,BoolObj safe)521 forAllDict(Dict d, Code code, BoolObj safe)
522 { return forAllChain(d->members, code, safe);
523 }
524
525
526 static status
forSomeDict(Dict d,Code code,BoolObj safe)527 forSomeDict(Dict d, Code code, BoolObj safe)
528 { return forSomeChain(d->members, code, safe);
529 }
530
531
532 static Any
getFindDict(Dict d,Code code)533 getFindDict(Dict d, Code code)
534 { return getFindChain(d->members, code);
535 }
536
537
538 static Chain
getFindAllDict(Dict d,Code code)539 getFindAllDict(Dict d, Code code)
540 { return getFindAllChain(d->members, code);
541 }
542
543
544 static Any
getBrowserDict(Dict d)545 getBrowserDict(Dict d)
546 { if ( notNil(d->browser) )
547 { ListBrowser lb = d->browser;
548
549 if ( instanceOfObject(lb->device, ClassBrowser) )
550 answer(lb->device);
551 else
552 answer(lb);
553 }
554
555 fail;
556 }
557
558 /*******************************
559 * VISUAL *
560 *******************************/
561
562 static Chain
getContainsDict(Dict d)563 getContainsDict(Dict d)
564 { answer(d->members);
565 }
566
567 /*******************************
568 * CLASS DECLARATION *
569 *******************************/
570
571 /* Type declaractions */
572
573 static char *T_sort[] =
574 { "[bool|code|function]", "ignore_blanks=[bool]", "reverse=[bool]" };
575 static char *T_actionAcode_safeADboolD[] =
576 { "action=code", "safe=[bool]" };
577 static char *T_insertAfter[] =
578 { "after=dict_item", "item=any|dict_item*" };
579 static char *T_findPrefix[] =
580 { "for=string", "from=[int]", "no_exact_case=[bool]" };
581
582 /* Instance Variables */
583
584 static vardecl var_dict[] =
585 { IV(NAME_browser, "list_browser*", IV_NONE,
586 NAME_visualisation, "Associated browser (visualisation)"),
587 IV(NAME_members, "chain", IV_GET,
588 NAME_organisation, "Objects in the dictionary"),
589 IV(NAME_table, "hash_table*", IV_NONE,
590 NAME_hashing, "Hashtable for access on key"),
591 SV(NAME_sortBy, "[code]*", IV_GET|IV_STORE, sortByDict,
592 NAME_order, "Sorting rule to apply")
593 };
594
595 /* Send Methods */
596
597 static senddecl send_dict[] =
598 { SM(NAME_initialise, 1, "member=dict_item ...", initialiseDictv,
599 DEFAULT, "Create a dict and append the arguments"),
600 SM(NAME_unlink, 0, NULL, unlinkDict,
601 DEFAULT, "Destroy hash-table and unlink from browser"),
602 SM(NAME_append, 1, "item=dict_item", appendDict,
603 NAME_add, "Append dict_item at the end"),
604 SM(NAME_insert, 1, "item=dict_item", insertDict,
605 NAME_add, "Insert dict_item according to <-sort_by"),
606 SM(NAME_insertAfter, 2, T_insertAfter, insertAfterDict,
607 NAME_add, "Insert item after 2nd (or prepend)"),
608 SM(NAME_clear, 0, NULL, clearDict,
609 NAME_delete, "Delete all members"),
610 SM(NAME_delete, 1, "any|dict_item", deleteDict,
611 NAME_delete, "Delete dict_item or name"),
612 SM(NAME_forAll, 2, T_actionAcode_safeADboolD, forAllDict,
613 NAME_iterate, "Run code on all dict_items, demand acceptance ([safe])"),
614 SM(NAME_forSome, 2, T_actionAcode_safeADboolD, forSomeDict,
615 NAME_iterate, "Run code on all dict_items ([safe])"),
616 SM(NAME_sort, 3, T_sort, sortDict,
617 NAME_order, "Sort contents"),
618 SM(NAME_member, 1, "any|dict_item", memberDict,
619 NAME_set, "Test if dict_item or name is member"),
620 SM(NAME_members, 1, "chain", membersDict,
621 NAME_set, "->clear and ->append elements of chain")
622 };
623
624 /* Get Methods */
625
626 static getdecl get_dict[] =
627 { GM(NAME_containedIn, 0, "list_browser|browser", NULL, getBrowserDict,
628 DEFAULT, "Equivalent to <-browser"),
629 GM(NAME_contains, 0, "chain", NULL, getContainsDict,
630 DEFAULT, "Equivalent to <-members"),
631 GM(NAME_table, 0, "hash_table", NULL, getTableDict,
632 NAME_hashing, "Return hash-table key --> dict_item"),
633 GM(NAME_member, 1, "dict_item", "any|dict_item", getMemberDict,
634 NAME_lookup, "Find dict_item from <-key"),
635 GM(NAME_find, 1, "dict_item", "test=code", getFindDict,
636 NAME_search, "First dict_item accepted by code"),
637 GM(NAME_findAll, 1, "chain", "test=code", getFindAllDict,
638 NAME_search, "New chain with dict_items accepted"),
639 GM(NAME_findPrefix, 3, "dict_item", T_findPrefix, getFindPrefixDict,
640 NAME_search, "First item from index int that matches"),
641 GM(NAME_match, 1, "chain", "char_array", getMatchDict,
642 NAME_search, "New chain with items that match argument"),
643 GM(NAME_browser, 0, "list_browser|browser", NULL, getBrowserDict,
644 NAME_visualisation, "ListBrowser or Browser associated")
645 };
646
647 /* Resources */
648
649 static classvardecl rc_dict[] =
650 { RC(NAME_sortIgnoreBlanks, "bool", "@off",
651 "@on: ignore leading blanks when sorting"),
652 RC(NAME_sortIgnoreCase, "bool", "@off",
653 "@on: ignore case when sorting")
654 };
655
656 /* Class Declaration */
657
658 ClassDecl(dict_decls,
659 var_dict, send_dict, get_dict, rc_dict,
660 0, NULL,
661 "$Rev$");
662
663 status
makeClassDict(Class class)664 makeClassDict(Class class)
665 { declareClass(class, &dict_decls);
666 saveStyleVariableClass(class, NAME_table, NAME_nil);
667
668 succeed;
669 }
670