langlist.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langlist.c 1260 2006-04-13 06:13:10Z sethdill $    */
00003 
00004 /******************************************************************************
00005 
00006     UserLand Frontier(tm) -- High performance Web content management,
00007     object database, system-level and Internet scripting environment,
00008     including source code editing and debugging.
00009 
00010     Copyright (C) 1992-2004 UserLand Software, Inc.
00011 
00012     This program is free software; you can redistribute it and/or modify
00013     it under the terms of the GNU General Public License as published by
00014     the Free Software Foundation; either version 2 of the License, or
00015     (at your option) any later version.
00016 
00017     This program is distributed in the hope that it will be useful,
00018     but WITHOUT ANY WARRANTY; without even the implied warranty of
00019     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00020     GNU General Public License for more details.
00021 
00022     You should have received a copy of the GNU General Public License
00023     along with this program; if not, write to the Free Software
00024     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00025 
00026 ******************************************************************************/
00027 
00028 #include "frontier.h"
00029 #include "standard.h"
00030 
00031 #include "memory.h"
00032 #include "strings.h"
00033 #include "error.h"
00034 #include "lang.h"
00035 #include "langinternal.h"
00036 #include "langipc.h"
00037 #include "langsystem7.h"
00038 #include "oplist.h"
00039 #include "op.h"
00040 
00041 
00042 boolean langgetlistsize (const tyvaluerecord *vlist, long *size) {
00043 
00044     *size = opcountlistitems ((*vlist).data.listvalue);
00045 
00046     return (true);
00047     } /*langgetlistsize*/
00048 
00049 
00050 boolean getnthlistval (hdllistrecord hlist, long n, ptrstring pkey, tyvaluerecord *val) {
00051     
00052     Handle hdata;
00053     
00054     if (!opgetlisthandle (hlist, n, pkey, &hdata))
00055         return (false);
00056     
00057     if (!langunpackvalue (hdata, val))
00058         return (false);
00059     
00060     pushvalueontmpstack (val);
00061     
00062     return (true);
00063     } /*getnthlistval*/
00064 
00065 
00066 boolean setnthlistval (hdllistrecord hlist, long n, ptrstring pkey, tyvaluerecord *val) {
00067     
00068     Handle hdata;
00069     
00070     if (!langpackvalue (*val, &hdata, HNoNode))
00071         return (false);
00072     
00073     if (n == 0) // AE list compatibility thing
00074         return (oppushhandle (hlist, pkey, hdata));
00075     else
00076         return (opsetlisthandle (hlist, n, pkey, hdata));
00077     } /*setnthlistval*/
00078 
00079 
00080 boolean langpushlistval (hdllistrecord hlist, ptrstring pkey, tyvaluerecord *val) {
00081     
00082     Handle hdata;
00083     
00084     if (!langpackvalue (*val, &hdata, HNoNode))
00085         return (false);
00086     
00087     return (oppushhandle (hlist, pkey, hdata));
00088     } /*langpushlistval*/
00089 
00090 
00091 boolean langpushlisttext (hdllistrecord hlist, Handle hstring) {
00092     
00093     Handle hdata;
00094     tyvaluerecord val;
00095     boolean fl;
00096     
00097     initvalue (&val, stringvaluetype);
00098     
00099     val.data.stringvalue = hstring;
00100     
00101     fl = langpackvalue (val, &hdata, HNoNode);
00102     
00103     disposehandle (hstring);
00104     
00105     if (fl)
00106         fl = oppushhandle (hlist, nil, hdata);
00107     
00108     return (fl);
00109     } /*langpushlisttext*/
00110 
00111 
00112 boolean langpushliststring (hdllistrecord hlist, bigstring bs) {
00113     
00114     Handle htext;
00115     
00116     if (!newtexthandle (bs, &htext))
00117         return (false);
00118     
00119     return (langpushlisttext (hlist, htext));
00120     } /*langpushliststring*/
00121 
00122 
00123 boolean langpushlistaddress (hdllistrecord hlist, hdlhashtable ht, bigstring bs) {
00124     
00125     Handle hdata;
00126     tyvaluerecord val;
00127     boolean fl;
00128     
00129     if (!setexemptaddressvalue (ht, bs, &val))
00130         return (false);
00131     
00132     fl = langpackvalue (val, &hdata, HNoNode);
00133     
00134     disposevaluerecord (val, true);
00135     
00136     if (fl)
00137         fl = oppushhandle (hlist, nil, hdata);
00138     
00139     return (fl);
00140     } /*langpushlistaddress*/
00141 
00142 
00143 boolean langpushlistlong (hdllistrecord hlist, long num) {
00144     Handle hdata;
00145     tyvaluerecord val;
00146     boolean fl;
00147 
00148     setlongvalue (num, &val);
00149 
00150     fl = langpackvalue (val, &hdata, HNoNode);
00151         
00152     if (fl)
00153         fl = oppushhandle (hlist, nil, hdata);
00154     
00155     return (fl);
00156     } /*langpushlistlong*/
00157 
00158 
00159 static boolean evaluatefield (hdltreenode htree, bigstring key, boolean flformal, tyvaluerecord *itemval) {
00160     
00161     /*
00162     3/23/93 dmb: htree is a x:y field specification. return the field key, 
00163     and the field data as a descriptor record whose dataHandle is not on the 
00164     temp stack.
00165 
00166     02/05/02 dmb: added flformal param and handling
00167     */
00168     
00169     register hdltreenode h = htree;
00170     tyvaluerecord keyval;
00171     
00172     assert ((**h).nodetype == fieldop);
00173     
00174     if (flformal) {
00175 
00176         if (!langgetidentifier ((**h).param1, key))
00177             return (false);
00178         }
00179     else {
00180 
00181         if (!evaluatetree ((**h).param1, &keyval))
00182             return (false);
00183         
00184         if (!coercetostring (&keyval))
00185             return (false);
00186     
00187         pullstringvalue (&keyval, key);
00188 
00189         disposevaluerecord (keyval, false);
00190         }
00191     
00192     if (!evaluatetree ((**h).param2, itemval))
00193         return (false);
00194     
00195     return (true);
00196     } /*evaluatefield*/
00197 
00198 
00199 boolean makelistvalue (hdltreenode htree, tyvaluerecord *vreturned) {
00200     
00201     /*
00202     4/1/93 dmb: don't cleartmpstack here -- we might be creating a value in 
00203     an expression. just take care of what we create.
00204     */
00205     
00206     register hdltreenode h;
00207     hdllistrecord hlist;
00208     tyvaluerecord itemval;
00209     
00210     if (!opnewlist (&hlist, false))
00211         return (false);
00212     
00213     for (h = htree; h != nil; h = (**h).link) { /*process each expression in the list*/
00214         
00215         if (!evaluatetree (h, &itemval))
00216             goto error;
00217         
00218         if (!langpushlistval (hlist, nil, &itemval))
00219             goto error;
00220         }
00221     
00222     return (setheapvalue ((Handle) hlist, listvaluetype, vreturned));
00223     
00224     error: {
00225         
00226         opdisposelist (hlist);
00227         
00228         return (false);
00229         }
00230     } /*makelistvalue*/
00231 
00232 
00233 boolean makerecordvalue (hdltreenode htree, boolean flformal, tyvaluerecord *vreturned) {
00234     
00235     /*
00236     4/1/93 dmb: don't cleartmpstack here -- we might be creating a value in 
00237     an expression. just take care of what we create.
00238 
00239     02/05/02 dmb: added flformal param and handling
00240     */
00241     
00242     register hdltreenode h;
00243     hdllistrecord hlist;
00244     bigstring key;
00245     tyvaluerecord itemval;
00246     
00247     if (!opnewlist (&hlist, true))
00248         return (false);
00249     
00250     for (h = htree; h != nil; h = (**h).link) { /*process each expression in the list*/
00251         
00252         if (!evaluatefield (h, key, flformal, &itemval))
00253             goto error;
00254         
00255         if (!langpushlistval (hlist, key, &itemval))
00256             goto error;
00257         }
00258     
00259     return (setheapvalue ((Handle) hlist, recordvaluetype, vreturned));
00260     
00261     error: {
00262         
00263         opdisposelist (hlist);
00264         
00265         return (false);
00266         }
00267     } /*makerecordvalue*/
00268 
00269 
00270 boolean langgetlistitem (const tyvaluerecord *vlist, long ix, ptrstring pkey, tyvaluerecord *vitem) {
00271     
00272     if (getnthlistval ((*vlist).data.listvalue, ix, pkey, vitem))
00273         return (true);
00274     
00275     if (!fllangerror) {
00276         
00277         tyvaluerecord vindex;
00278         
00279         setlongvalue (ix, &vindex);
00280         
00281         langarrayreferror (0, pkey, vlist, &vindex);
00282         }
00283     
00284     return (false);
00285     } /*langgetlistitem*/
00286 
00287 
00288 static boolean listtostring (hdllistrecord hlist, tyvaluerecord *val) {
00289     
00290     /*
00291     12/22/92 dmb: starter version: 255-char limit
00292     
00293     4/2/93 dmb: next version: 255-char limit for individual items only.
00294     
00295     2006-02-20 aradke: rewrite using handlestreams for efficiency.
00296         also in preparation for revoming the 255-char limit for list items.
00297     */
00298     
00299     long i, n;
00300     bigstring key;
00301     tyvaluerecord itemval;
00302     bigstring bs;
00303     handlestream s;
00304     boolean flisrecord = opgetisrecord (hlist);
00305     
00306     n = opcountlistitems (hlist);
00307     
00308     openhandlestream (nil, &s);
00309     
00310     if (!writehandlestreamchar (&s, '{'))   /* creates handle, need to dispose later */
00311         return (false);
00312     
00313     for (i = 1; i <= n; ++i) {
00314         
00315         if (!getnthlistval (hlist, i, key, &itemval))
00316             goto error;
00317         
00318         if (flisrecord) {
00319                 
00320             if (!writehandlestreamchar (&s, chdoublequote))
00321                 goto error;
00322             
00323             langdeparsestring (key, chdoublequote); /*add needed escape sequences*/
00324             
00325             if (!writehandlestreamstring (&s, key))
00326                 goto error;
00327                 
00328             if (!writehandlestreamchar (&s, chdoublequote))
00329                 goto error;
00330                 
00331             if (!writehandlestreamchar (&s, ':'))
00332                 goto error;
00333             }
00334         
00335         if (!getobjectmodeldisplaystring (&itemval, bs)) /*max 253 characters*/
00336             goto error;
00337         
00338         disposevaluerecord (itemval, true); /*don't clog temp stack*/
00339         
00340         if (!writehandlestreamstring (&s, bs))
00341             goto error;
00342         
00343         if (i < n)
00344             if (!writehandlestreamstring (&s, BIGSTRING ("\x02, ")))
00345                 goto error;
00346         }
00347     
00348     if (!writehandlestreamchar (&s, '}'))
00349         goto error;
00350     
00351     return (setheapvalue (closehandlestream (&s), stringvaluetype, val));
00352     
00353     error:
00354     
00355     disposehandlestream (&s);
00356     
00357     return (false);
00358     } /*listtostring*/
00359 
00360 
00361 static boolean makeintegerlist (tyvaluerecord *v, tyvaluetype listtype, void *pints, short ctints, hdllistrecord *intlist) {
00362     
00363     /*
00364     2.1b2 dmb: create a list containing the short integers in the pints array 
00365     
00366     2.1b8 dmb: for now, disallow coercion to record. later, we might have 
00367     an array of keys for each type.
00368     */
00369     
00370     register short *lpi = (short *) pints;
00371     boolean flrecord = listtype == recordvaluetype;
00372     tyvaluerecord itemval;
00373     
00374     if (flrecord) {
00375         
00376         langcoerceerror (v, listtype);
00377         
00378         return (false);
00379         }
00380     
00381     if (!opnewlist (intlist, flrecord))
00382         return (false);
00383     
00384     while (--ctints >= 0) { /*process each int in the array*/
00385         
00386         setintvalue (*lpi++, &itemval);
00387 
00388         if (!langpushlistval (*intlist, nil, &itemval))
00389             goto error;
00390         }
00391     
00392     return (true);
00393     
00394     error:
00395         
00396         opdisposelist (*intlist);
00397         
00398         return (false);
00399     } /*makeintegerlist*/
00400 
00401 
00402 static boolean pullintegerlist (hdllistrecord intlist, short ctints, void *pints) {
00403     
00404     /*
00405     2.1b2 dmb: pull out the array of short integers from the list
00406     */
00407     
00408     register short *lpi = (short *) pints;
00409     tyvaluerecord val;
00410     long ctitems;
00411     long n;
00412     
00413     ctitems = opcountlistitems (intlist);
00414     
00415     if (ctitems < ctints) {
00416         
00417         langlongparamerror (listcoerceerror, ctints);
00418         
00419         return (false);
00420         }
00421     
00422     for (n = 1; n <= ctints; ++n) { /*grab each int in the list*/
00423         
00424         if (!getnthlistval (intlist, n, nil, &val))
00425             return (false);
00426 
00427         if (!coercevalue (&val, intvaluetype))
00428             return (false);
00429 
00430         *lpi++ = val.data.intvalue;
00431         }
00432     
00433     return (true);
00434     } /*pullintegerlist*/
00435 
00436 
00437 static Point swappoint (Point pt) {
00438     
00439     short temp = pt.h;
00440     
00441     pt.h = pt.v;
00442     
00443     pt.v = temp;
00444     
00445     return (pt);
00446     } /*swappoint*/
00447 
00448 
00449 static boolean nofunctioncallsvisit (hdltreenode hnode, void *refcon) {
00450 #pragma unused (refcon)
00451 
00452     return ((**hnode).nodetype != functionop);
00453     } /*nofunctioncallsvisit*/
00454 
00455 
00456 static boolean codecontainsfunctioncalls (hdltreenode hnode) {
00457     
00458     /*
00459     5.1.3 dmb: return true if the code tree doesn't contain any function calls.
00460     */
00461     
00462     return (!langvisitcodetree (hnode, &nofunctioncallsvisit, nil));
00463     } /*codecontainsfunctioncalls*/
00464             
00465 
00466 static boolean stringtolist (tyvaluerecord *val, tyvaluetype type) {
00467     
00468     /*
00469     4.1b2 dmb: if a string is actually a list expression, that's what 
00470     this coercion should yield.
00471 
00472     5.0b17 dmb: don't dispose of val unless evaluatetree succeeds
00473     */
00474     
00475     Handle htext;
00476     hdltreenode hmodule;
00477     boolean fl = false;
00478     unsigned short savelines;
00479     unsigned short savechars;
00480     
00481     if (gethandlesize ((*val).data.stringvalue) == 0) { /*empty string -> null list*/
00482         
00483         disposevaluerecord (*val, true);
00484         
00485         if (type == listvaluetype)
00486             return (makelistvalue (nil, val));
00487         else
00488             return (makerecordvalue (nil, false, val));
00489         }
00490     
00491     if (!copyhandle ((*val).data.stringvalue, &htext))
00492         return (false);
00493     
00494     savelines = ctscanlines;
00495     
00496     savechars = ctscanchars;
00497     
00498     disablelangerror ();
00499     
00500     fl = langcompiletext (htext, false, &hmodule); /*always disposes htext*/
00501     
00502     enablelangerror ();
00503     
00504     if (fl) {
00505         
00506         register hdltreenode h = (**hmodule).param1;
00507         register tytreetype op = (**h).nodetype;
00508         tyvaluerecord vlist;
00509         
00510         if (type == listvaluetype)
00511             fl = op == listop;
00512         else
00513             fl = op == recordop;
00514         
00515         if (fl)
00516             fl = !codecontainsfunctioncalls (h); // 5.1.3 dmb: security!
00517         
00518         if (fl) {
00519             
00520             disablelangerror (); /*we'll generate own error w/correct position*/
00521             
00522             fl = evaluatetree (h, &vlist);
00523             
00524             enablelangerror ();
00525 
00526             if (fl) {
00527                 
00528                 disposevaluerecord (*val, true);
00529                 
00530                 *val = vlist;
00531                 }
00532             }
00533         
00534         langdisposetree (hmodule);
00535         }
00536     
00537     ctscanlines = savelines;
00538     
00539     ctscanchars = savechars;
00540     
00541     return (fl);
00542     } /*stringtolist*/
00543 
00544 
00545 boolean coercetolist (tyvaluerecord *val, tyvaluetype type) {
00546     
00547     /*
00548     4/14/93 dmb: support list <-> record coercion when empty, but don't allow 
00549     it otherwise
00550     
00551     2.1b8 dmb: coercing a list to a record creates a true record
00552     
00553     4.1b2 dmb: use stringtolist for string values
00554     */
00555     
00556     register tyvaluerecord *v = val;
00557     register tyvaluetype vtype = (*v).valuetype;
00558     hdllistrecord hlist = nil;
00559     long size;
00560     
00561     if (vtype == type)
00562         return (true);
00563     
00564     switch (vtype) {
00565         
00566         case novaluetype:
00567             if (flinhibitnilcoercion)
00568                 return (false);
00569             
00570             if (type == listvaluetype)
00571                 return (makelistvalue (nil, v));
00572             else
00573                 return (makerecordvalue (nil, false, v));
00574         
00575         case externalvaluetype:
00576             langbadexternaloperror (badexternaloperationerror, *v);
00577             
00578             return (false);
00579         
00580         case listvaluetype:
00581         case recordvaluetype:
00582             if (!langgetlistsize (v, &size))
00583                 return (false);
00584             
00585             if (size > 0) {
00586                 
00587                 langcoerceerror (v, type);
00588                 
00589                 return (false);
00590                 }
00591             
00592             if (!opnewlist (&hlist, type == recordvaluetype))
00593                 return (false);
00594             
00595             break;
00596         
00597         case pointvaluetype: {
00598             Point pt = swappoint ((*v).data.pointvalue);
00599             
00600             if (!makeintegerlist (v, type, &pt, 2, &hlist))
00601                 return (false);
00602             
00603             break;
00604             }
00605         
00606         case rgbvaluetype: {
00607             RGBColor rgb = **(*v).data.rgbvalue;
00608             
00609             if (!makeintegerlist (v, type, &rgb, 3, &hlist))
00610                 return (false);
00611             
00612             break;
00613             }
00614         
00615         case rectvaluetype: {
00616             Rect r = **(*v).data.rectvalue;
00617             
00618             if (!makeintegerlist (v, type, &r, 4, &hlist))
00619                 return (false);
00620             
00621             break;
00622             }
00623         
00624     #ifdef MACVERSION
00625         case objspecvaluetype:
00626         case binaryvaluetype: {
00627             AEDesc vdesc, listdesc;
00628             OSErr err;
00629             boolean fl;
00630             
00631             if (!coercetobinary (v))
00632                 return (false);
00633             
00634             binarytodesc ((*v).data.binaryvalue, &vdesc); // still in temp stack
00635             
00636             err = AECoerceDesc (&vdesc, langgettypeid (type), &listdesc);
00637             
00638             if (err != noErr) {
00639                 
00640                 if (err == errAECoercionFail) {
00641                     
00642                     coercevalue (v, vtype); /*back to it's original type for the error message*/
00643                     
00644                     langcoerceerror (v, type);
00645                     }
00646                 else
00647                     oserror (err);
00648                 
00649                 return (false);
00650                 }
00651             
00652             fl = langipcconvertaelist (&listdesc, v);
00653             
00654             AEDisposeDesc (&listdesc);
00655             
00656             return (fl);
00657             }
00658     #endif
00659         
00660         case stringvaluetype:
00661             
00662             if (stringtolist (v, type))
00663                 return (true);
00664             
00665             /*else fall through...*/
00666         
00667         default:
00668             /*
00669             create a list containing the item. note that this does not 
00670             emulate version 4.x's AE functionality, where the value 
00671             might be coerceable to a list directly.
00672             */
00673 
00674             if (!opnewlist (&hlist, type == recordvaluetype))
00675                 return (false);
00676             
00677             if (!langpushlistval (hlist, nil, v)) {
00678                 
00679                 opdisposelist (hlist);
00680                 
00681                 langcoerceerror (v, type);
00682                 
00683                 return (false);
00684                 }
00685             
00686             break;
00687         }
00688     
00689     disposevaluerecord (*v, true);
00690     
00691     return (setheapvalue ((Handle) hlist, type, v));
00692     } /*coercetolist*/
00693 
00694 
00695 static boolean coercelistcontents (tyvaluerecord *val, tyvaluetype totype, hdllistrecord hlist, long ctitems) {
00696 #pragma unused(val)
00697 
00698     /*
00699     4.0b7 dmb:  when list->totype coercion otherwise fails, we try to coerce each item 
00700     in the list to totype. if we success, we'll return true even though the value we 
00701     return will still be a list, not a totype value. since this used to be a failure 
00702     case, it can't break working scripts. but it means that glue scripts can coerce to
00703     objspec, alias, or whatever and still allow a list of those items be pass through.
00704     */
00705     
00706     short ix;
00707     
00708     for (ix = 1; ix <= ctitems; ++ix) {
00709 
00710         tyvaluerecord itemval;
00711         
00712         if (!getnthlistval (hlist, ix, nil, &itemval))
00713             return (false);
00714         
00715         if (!coercevalue (&itemval, totype))
00716             return (false);
00717         
00718         if (!setnthlistval (hlist, ix, nil, &itemval))
00719             return (false);
00720 
00721         disposevaluerecord (itemval, false);
00722 
00723         }
00724     
00725     return (true);
00726     } /*coercelistcontents*/
00727 
00728 
00729 boolean coercelistvalue (tyvaluerecord *val, tyvaluetype totype) {
00730     
00731     /*
00732     2.1b6 dmb: coercing a list to a boolean indicates whether or not the 
00733     list is empty, except when the list contains a single, boolean item.
00734     
00735     2.1b8 dmb: for a single-item list, try to coerce item to desired type, 
00736     instead of requiring the the type already match
00737     */
00738     
00739     register tyvaluerecord *v = val;
00740     hdllistrecord hlist;
00741     long ctitems;
00742     tyvaluerecord itemval;
00743     
00744     if (totype == (*v).valuetype)
00745         return (true);
00746     
00747     hlist = (*v).data.listvalue;
00748     
00749     switch (totype) {
00750         
00751         case listvaluetype:
00752             opsetisrecord (hlist, false);
00753 
00754             return (true);
00755         
00756         case stringvaluetype:
00757             if (!listtostring (hlist, &itemval))
00758                 return (false);
00759             
00760             disposevaluerecord (*v, true);
00761             
00762             *v = itemval;
00763             
00764             break;
00765         
00766         case binaryvaluetype:
00767             return (coercetobinary (v));
00768         
00769         case pointvaluetype: {
00770             Point pt;
00771             
00772             if (!pullintegerlist (hlist, 2, &pt))
00773                 return (false);
00774             
00775             if (!setpointvalue (swappoint (pt), v))
00776                 return (false);
00777             
00778             break;
00779             }
00780         
00781         case rgbvaluetype: {
00782             RGBColor rgb = **(*v).data.rgbvalue;
00783             
00784             if (!pullintegerlist (hlist, 3, &rgb))
00785                 return (false);
00786             
00787             if (!newheapvalue (&rgb, sizeof (rgb), rgbvaluetype, v))
00788                 return (false);
00789             
00790             break;
00791             }
00792         
00793         case rectvaluetype: {
00794             Rect r = **(*v).data.rectvalue;
00795             
00796             if (!pullintegerlist (hlist, 4, &r))
00797                 return (false);
00798             
00799             if (!newheapvalue (&r, sizeof (r), rectvaluetype, v))
00800                 return (false);
00801             
00802             break;
00803             }
00804         
00805         default:
00806             ctitems = opcountlistitems (hlist);
00807             
00808             if (ctitems == 1) {
00809                 
00810                 if (!getnthlistval (hlist, 1, nil, &itemval))
00811                     return (false);
00812                 
00813                 if (!coercevalue (&itemval, totype))
00814                     return (false);
00815                 
00816                 disposevaluerecord (*v, true);
00817                 
00818                 *v = itemval;
00819                 
00820                 return (true);
00821                 }
00822             
00823             if (totype == booleanvaluetype) {
00824                 
00825                 if (!setbooleanvalue (ctitems > 0, v))
00826                     return (false);
00827                 
00828                 break;
00829                 }
00830             
00831             /*
00832             langcoerceerror (v, totype);
00833             
00834             return (false);
00835             */
00836             return (coercelistcontents (v, totype, hlist, ctitems));    // 4.0b7 dmb
00837         }
00838     
00839     return (true);
00840     } /*coercelistvalue*/
00841 
00842 
00843 static boolean equalsublists (hdllistrecord list1, hdllistrecord list2, long ixcompare, long ctcompare, boolean flbykey) {
00844     
00845     /*
00846     compare the sublist of list1 starting at ixcompare with list2.  if flbykey, 
00847     order doesn't matter and ixcompare is ignored.  ctcompare is expected to be 
00848     the size of list2
00849     
00850     5.0a24 dmb: with oplanglists, we can use EQvalue. which can recurse to here.
00851     */
00852     
00853     register long ix;
00854     register long n = ctcompare;
00855     tyvaluerecord item1;
00856     tyvaluerecord item2;
00857     tyvaluerecord vequal;
00858     bigstring key1;
00859     bigstring key2;
00860     boolean fl = true;
00861     
00862     for (ix = 1; ix <= n; ++ix) {
00863         
00864         if (!getnthlistval (list2, ix, key1, &item2))
00865             return (false);
00866         
00867         if (flbykey) {
00868             
00869             fl = getnthlistval (list1, -1, key1, &item1);
00870             }
00871         else {
00872             if (!getnthlistval (list1, ix + ixcompare, key2, &item1))
00873                 fl = false;
00874             else
00875                 fl = equalstrings (key1, key2);
00876             }
00877         
00878         disablelangerror ();
00879         
00880         fl = fl && EQvalue (item1, item2, &vequal) && vequal.data.flvalue;
00881         
00882         enablelangerror ();
00883         
00884         if (!fl)
00885             break;
00886         }
00887     
00888     return (fl);
00889     } /*equalsublists*/
00890 
00891 
00892 boolean listaddvalue (tyvaluerecord *v1, tyvaluerecord *v2, tyvaluerecord *vreturned) {
00893     
00894     /*
00895     add the two list values. both lists should be of the same type, since langvalue 
00896     does the necessary coercion first. But if one is an AEList and the other an AERecord,
00897     the AE Manager will generate errors if appropriate.
00898     
00899     when adding records, only add fields from the 2nd record that don't already exist
00900     in the first
00901     
00902     2.1b8 dmb: initialize errcode to noErr, or random error results if adding 
00903     two records where the 1st item in record 2 is already in record 1
00904     
00905     5.0.2b10 dmb: since we throw away v1 and v2, we can boost performance
00906     by adding directly to v1 and making that the return value.
00907     
00908     10.0a1 hra: we were always looping through v2, so adding a long list to a small
00909     list was significantly slower (2x or more) than adding the small list to the long
00910     list. Now we always loop through the shortest of the 2 lists.
00911     */
00912     
00913     hdllistrecord list2;
00914     hdllistrecord list3;
00915     long i, n, m;
00916     Handle hitem, hignore;
00917     bigstring key;
00918     
00919     m = opcountlistitems ((*v1).data.listvalue);
00920     n = opcountlistitems ((*v2).data.listvalue);
00921     
00922     if ( (m > n) || opgetisrecord ((*v2).data.listvalue) ) {
00923         /* Either the first list is longer than the second:
00924            append to the first, or we are adding records so we want to
00925            de-dupe the entries always in the same way
00926         */
00927         list2 = (*v2).data.listvalue;
00928         *vreturned = *v1;
00929         initvalue (v1, novaluetype);
00930 
00931         list3 = (*vreturned).data.listvalue;
00932 
00933         for (i = 1; i <= n; ++i) { /*copy values over from second list*/
00934         
00935             if (!opgetlisthandle (list2, i, key, &hitem))
00936                 return (false);
00937             
00938             if (!copyhandle (hitem, &hitem))
00939                 return (false);
00940 
00941             if (opgetisrecord (list3)) { /* discard duplicate keys */
00942                 
00943                 if (opgetlisthandle (list3, -1, key, &hignore))
00944                     disposehandle (hitem); /* discard the duplicate. don't push it over */
00945                 else
00946                     oppushhandle (list3, key, hitem);
00947                 }
00948             else
00949                 oppushhandle (list3, key, hitem);
00950             } /*for*/
00951 
00952     } else { /* the second list is longer than the first: prepend to the second */
00953         list2 = (*v1).data.listvalue;
00954         *vreturned = *v2;
00955         initvalue (v2, novaluetype);
00956         
00957         list3 = (*vreturned).data.listvalue;
00958         
00959         for (i = m; i >= 1; --i) { /*copy values over from first list, in reverse*/
00960         
00961             if (!opgetlisthandle (list2, i, key, &hitem))
00962                 return (false);
00963             
00964             if (!copyhandle (hitem, &hitem))
00965                 return (false);
00966 
00967             opunshifthandle (list3, key, hitem);
00968             } /*for*/
00969     }       
00970     
00971     return (true);
00972     } /*listaddvalue*/
00973 
00974 
00975 boolean listsubtractvalue (tyvaluerecord *v1, tyvaluerecord *v2, tyvaluerecord *vreturned) {
00976     
00977     /*
00978     add the two list values. both lists should be of the same type, since langvalue 
00979     does the necessary coercion first. But if one is an AEList and the other an AERecord,
00980     the AE Manager will generate errors if appropriate.
00981     
00982     when adding records, only add fields from the 2nd record that don't already exist
00983     in the first
00984     */
00985     
00986     hdllistrecord list1 = (*v1).data.listvalue;
00987     hdllistrecord list2 = (*v2).data.listvalue;
00988     hdllistrecord list3;
00989     long ix1, ix2, n1, n2;
00990     Handle item1, item2;
00991     bigstring key;
00992     
00993     //if (!copyvaluerecord (*v1, vreturned))
00994     //  return (false);
00995     
00996     *vreturned = *v1;
00997     
00998     initvalue (v1, novaluetype);
00999 
01000     list3 = (*vreturned).data.listvalue;
01001 
01002     n1 = opcountlistitems (list1);
01003     
01004     n2 = opcountlistitems (list2);
01005     
01006     if (opgetisrecord (list3)) {
01007         
01008         for (ix1 = 1; ix1 <= n2; ++ix1) { /*delete values that appear in second record*/
01009             
01010             if (!opgetlisthandle (list2, ix1, key, &item1))
01011                 goto error;
01012             
01013             if (opgetlisthandle (list3, -1, key, &item2)) {
01014                 
01015                 if (equalhandles (item1, item2))
01016                     opdeletelistitem (list3, -1, key);
01017                 }
01018             }
01019         }
01020     else {
01021         
01022         ix2 = n1 - n2;
01023         
01024         for (ix1 = 0; ix1 <= ix2; ++ix1) {
01025             
01026             if (equalsublists (list1, list2, ix1, n2, false)) {
01027                 
01028                 while (--n2 >= 0)
01029                     if (!opdeletelistitem (list3, ix1 + 1, nil))
01030                         goto error;
01031                 
01032                 break;
01033                 }
01034             }
01035         }
01036     
01037     return (true);
01038     
01039     error:
01040     
01041     return (false);
01042     } /*listsubtractvalue*/
01043 
01044 
01045 static boolean comparelists (hdllistrecord list1, hdllistrecord list2, tytreetype comparisonop) {
01046     
01047     /*
01048     compare the two lists, returning true if the comparison holds, false 
01049     if it doesn't or an error occurs
01050     */
01051     
01052     long n1, n2;
01053     register long ix1, ix2;
01054     boolean flbykey;
01055     
01056     n1 = opcountlistitems (list1);
01057 
01058     n2 = opcountlistitems (list2);
01059     
01060     ix1 = 0;
01061     
01062     ix2 = n1 - n2;
01063     
01064     if (ix2 < 0) /*v1 can't beginwith, endwith, contain or be equal to v2*/
01065         goto exit;
01066     
01067     flbykey = opgetisrecord (list1);
01068     
01069     switch (comparisonop) {
01070         
01071         case beginswithop:
01072             ix2 = 0;
01073             
01074             flbykey = false;
01075             
01076             break;
01077         
01078         case endswithop:
01079             ix1 = ix2;
01080             
01081             flbykey = false;
01082             
01083             break;
01084         
01085         case EQop:
01086             if (ix2 != 0) /*n2 != n1*/
01087                 goto exit;
01088             
01089             break;
01090         
01091         case containsop:
01092             if (flbykey)
01093                 ix2 = 0;
01094             
01095             break;
01096         
01097         default:
01098             break;
01099         }
01100 
01101     
01102     for (; ix1 <= ix2; ++ix1) {
01103         
01104         if (equalsublists (list1, list2, ix1, n2, flbykey))
01105             return (true);
01106         }
01107     
01108     exit:
01109     
01110     return (false);
01111     } /*comparelists*/
01112 
01113 
01114 boolean listcomparevalue (tyvaluerecord *v1, tyvaluerecord *v2, tytreetype comparisonop, tyvaluerecord *vreturned) {
01115     
01116     boolean fl;
01117     
01118     fl = comparelists ((*v1).data.listvalue, (*v2).data.listvalue, comparisonop);
01119     
01120     if (fllangerror)
01121         return (false);
01122     
01123     return (setbooleanvalue (fl, vreturned));
01124     } /*listcomparevalue*/
01125 
01126 
01127 boolean coercetolistposition (tyvaluerecord *val) {
01128     
01129     /*
01130     get a list position parameter -- either an index (number) or 
01131     a keyword (string4)
01132 
01133     5.0a19 dmb: for Frontier5, string4 -> string index
01134     */
01135     
01136     tyvaluerecord *v = val;
01137     boolean fl;
01138     
01139     switch ((*v).valuetype) {
01140         
01141         case longvaluetype:
01142         case stringvaluetype:
01143             return (true);
01144         
01145         case ostypevaluetype:
01146             return (coercetostring (v));
01147 
01148         default:
01149             disablelangerror ();
01150             
01151             fl = coercetolong (v) || coercetostring (v);
01152             
01153             enablelangerror ();
01154             
01155             if (fl)
01156                 return (true);
01157         }
01158     
01159     langerror (badipclistposerror);
01160     
01161     return (false);
01162     } /*coercetolistposition*/
01163 
01164 
01165 boolean listarrayvalue (tyvaluerecord *vlist, bigstring bsname, register tyvaluerecord *vindex, tyvaluerecord *vreturned) {
01166     
01167     /*
01168     bsname is provided for error reporting only
01169     */
01170     
01171     hdllistrecord hlist = (*vlist).data.listvalue;
01172     bigstring key;
01173     boolean fl;
01174     
01175     if (!coercetolistposition (vindex))
01176         return (false);
01177     
01178     if ((*vindex).valuetype == longvaluetype)
01179         fl = getnthlistval (hlist, (*vindex).data.longvalue, nil, vreturned);
01180     else {
01181         
01182         pullstringvalue (vindex, key);
01183         
01184         fl = getnthlistval (hlist, -1, key, vreturned);
01185         }
01186 
01187     if (!fl && !fllangerror)
01188         langarrayreferror (0, bsname, vlist, vindex);
01189     
01190     return (fl);
01191     } /*listarrayvalue*/
01192 
01193 
01194 boolean listassignvalue (tyvaluerecord *vlist, bigstring bsname, register tyvaluerecord *vindex, tyvaluerecord *vassign) {
01195     
01196     /*
01197     bsname is provided for error reporting only
01198     */
01199     
01200     hdllistrecord hlist = (*vlist).data.listvalue;
01201     bigstring key;
01202     boolean fl;
01203     
01204     if (!coercetolistposition (vindex))
01205         return (false);
01206     
01207     if ((*vindex).valuetype == longvaluetype)
01208         fl = setnthlistval (hlist, (*vindex).data.longvalue, nil, vassign);
01209     else{
01210         
01211         pullstringvalue (vindex, key);
01212         
01213         fl = setnthlistval (hlist, -1, key, vassign);
01214         }
01215 
01216     if (!fl && !fllangerror)
01217         langarrayreferror (0, bsname, vlist, vindex);
01218 
01219     return (fl);
01220     } /*listassignvalue*/
01221 
01222 
01223 boolean listdeletevalue (tyvaluerecord *vlist, bigstring bsname, register tyvaluerecord *vindex) {
01224     
01225     /*
01226     bsname is provided for error reporting only
01227     */
01228     
01229     hdllistrecord hlist = (*vlist).data.listvalue;
01230     bigstring key;
01231     boolean fl;
01232     
01233     if (!coercetolistposition (vindex))
01234         return (false);
01235     
01236     if ((*vindex).valuetype == longvaluetype)
01237         fl = opdeletelistitem (hlist, (*vindex).data.longvalue, nil);
01238     else{
01239         
01240         pullstringvalue (vindex, key);
01241         
01242         fl = opdeletelistitem (hlist, -1, key);
01243         }
01244 
01245     if (!fl && !fllangerror)
01246         langarrayreferror (0, bsname, vlist, vindex);
01247 
01248     return (fl);
01249     } /*listdeletevalue*/
01250 
01251 
01252 typedef struct tylangvisitlistinfo {
01253     ptrvoid refcon;
01254     langvisitlistvaluescallback visit;
01255     } tylangvisitlistinfo;
01256 
01257 
01258 static boolean langvisitlistvaluesvisit (Handle hdata, ptrstring bskey, ptrvoid refcon) {
01259 #pragma unused (bskey)
01260 
01261     /*
01262     2004-11-04 aradke: helper for langvisitlistvalues, called from opvisitlist.
01263     */
01264 
01265     tylangvisitlistinfo *info = (tylangvisitlistinfo *) refcon;
01266     tyvaluerecord val;
01267     boolean fl;
01268     
01269     if (!langunpackvalue (hdata, &val))
01270         return (false);
01271         
01272     fl = (*info).visit (&val, (*info).refcon);
01273     
01274     disposevaluerecord (val, true);
01275 
01276     return (fl);
01277     } /*langvisitlistvaluesvisit*/
01278 
01279 
01280 boolean langvisitlistvalues (tyvaluerecord *vlist, langvisitlistvaluescallback visit, ptrvoid refcon) {
01281     
01282     /*
01283     2004-11-04 aradke: rewritten to use opvisitlist, called from langregexp.c.
01284     */
01285     
01286     hdllistrecord hlist = (hdllistrecord) (*vlist).data.binaryvalue;
01287     tylangvisitlistinfo info;
01288     
01289     info.refcon = refcon;
01290     info.visit = visit;
01291     
01292     return (opvisitlist (hlist, &langvisitlistvaluesvisit, &info));
01293     } /*langvisitlistvalues*/
01294 
01295 
01296 
01297 
01298 

Generated on Wed May 31 18:19:52 2006 for frontierkernel 10.1.10a by  doxygen 1.4.6