langsystem7.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langsystem7.c 355 2005-01-11 22:48:55Z andreradke $    */
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 <Aliases.h>
00029 #include <AppleEvents.h>
00030 #include <AEPackObject.h>
00031 #include <AEObjects.h>
00032 #include <AERegistry.h>
00033 #include <Gestalt.h>
00034 #include <standard.h>
00035 #include "memory.h"
00036 #include "strings.h"
00037 #include "ops.h"
00038 #include "error.h"
00039 #include "file.h"
00040 #include "lang.h"
00041 #include "langinternal.h"
00042 #include "langipc.h"
00043 #include "langsystem7.h"
00044 #include "tableinternal.h" /*for hdltablevariable; so we can avoid loading unloaded tables*/
00045 #include "tablestructure.h"
00046 
00047 
00048 #if 0 //def THINK_C
00049 
00050 pascal OSErr FollowFinderAlias (const FSSpec *fromFile, AliasHandle alias, Boolean logon, FSSpec *target, Boolean *wasChanged) = {
00051                                    
00052     /*
00053     resolves an alias taken from a Finder alias file,
00054     updating the alias record (but not the alias resource in the file) if
00055     necessary.
00056     */
00057     
00058     0x700F, 0xA823};  /*MOVEQ #$0F,D0; _AliasDispatch;*/
00059     /*FollowFinderAlias*/
00060 
00061 #endif
00062     
00063     
00064 
00065 static boolean comparelists (AEDesc *, AEDesc *, tytreetype); /*forward*/
00066 
00067 
00068 static boolean langgestaltcheck (OSType selector, short stringnum) {
00069     
00070     long result;
00071     
00072     if (!gestalt (selector, &result) || (result == 0)) {
00073         
00074         langerror (stringnum);
00075         
00076         return (false);
00077         }
00078     
00079     return (true);
00080     } /*langgestaltcheck*/
00081 
00082 
00083 boolean langcanusealiases (void) {
00084     
00085     #ifdef flsystem6
00086     
00087     return (langgestaltcheck (gestaltAliasMgrAttr, cantusealiaseserror));
00088     
00089     #else
00090     
00091     return (true);
00092     
00093     #endif
00094     } /*langcanusealiases*/
00095 
00096 
00097 #ifdef flsystem6
00098 
00099 boolean langcanuseappleevents (void) {
00100     
00101     return (langgestaltcheck (gestaltAppleEventsAttr, cantuseobjspecserror));
00102     } /*langcanuseappleevents*/
00103 
00104 #endif
00105 
00106 
00107 static boolean equaldescriptors (AEDesc *desc1, AEDesc *desc2) {
00108     
00109     register AEDesc *d1 = desc1;
00110     register AEDesc *d2 = desc2;
00111     register DescType t1 = (*d1).descriptorType;
00112     
00113     if (t1 != (*d2).descriptorType)
00114         return (false);
00115     
00116     if ((t1 == typeAERecord) || (t1 == typeAEList)) {
00117         #ifdef oplanglists
00118             tyvaluerecord v1, v2, vequal;
00119             
00120             if (!langipcconvertaelist (d1, &v1) || !langipcconvertaelist (d2, &v2))
00121                 return (false);
00122             
00123             return (EQvalue (v1, v2, &vequal) && vequal.data.flvalue);
00124         #else
00125             return (comparelists (d1, d2, EQop));
00126         #endif
00127         }
00128     else
00129         return (equalhandles ((*d1).dataHandle, (*d2).dataHandle));
00130     } /*equaldescriptors*/
00131 
00132 
00133 //static tyvaluerecord valfind;
00134 
00135 
00136 static boolean findvaluevisit (bigstring bs, hdlhashnode hnode, tyvaluerecord val, ptrvoid valfind) {
00137     
00138     return (val.data.longvalue == (long) valfind);  //.data.longvalue
00139     } /*findvaluevisit*/
00140 
00141 
00142 static boolean langfindvalue (tyvaluerecord val, hdlhashtable *htable, bigstring bsname) {
00143     
00144     /*
00145     search through the stack of symbol tables until you find a value that 
00146     matches val.  return the name of the matching value.
00147     */
00148     
00149     register hdlhashtable h = currenthashtable;
00150     register long refcon;
00151     register short n;
00152     long valfind;
00153     hdlhashnode hnode;
00154     
00155     *htable = nil;
00156     
00157     setemptystring (bsname);
00158     
00159     if (h == nil)
00160         return (false);
00161     
00162     refcon = (**h).lexicalrefcon;
00163     
00164     valfind = val.data.longvalue;
00165     
00166     while (true) { /*chain through each linked hash table*/
00167         
00168         if (h == nil) /*symbol not defined*/
00169             return (false);
00170         
00171         if ((!(**h).fllocaltable) || (refcon == 0) || ((**h).lexicalrefcon == refcon)) {
00172             
00173             if (hashinversesearch (h, &findvaluevisit, (ptrvoid) valfind, bsname)) { /*symbol is defined in htable*/
00174                 
00175                 *htable = h;
00176                 
00177                 return (true);
00178                 }
00179             
00180             for (n = (**h).ctwithvalues; n > 0; --n) { /*scan with values*/
00181                 
00182                 tyvaluerecord valwith;
00183                 hdlhashtable hwith;
00184                 bigstring bswith;
00185                 
00186                 langgetwithvaluename (n, bswith);
00187                 
00188                 if (!hashtablelookup (h, bswith, &valwith, &hnode)) /*missing with value; keep going*/
00189                     continue;
00190                 
00191                 if (!getaddressvalue (valwith, &hwith, bswith)) /*error*/
00192                     return (false);
00193                 
00194                 if (hashinversesearch (hwith, &findvaluevisit, (ptrvoid) valfind, bsname)) { /*found symbol*/
00195                     
00196                     *htable = hwith;
00197                     
00198                     return (true);
00199                     }
00200                 }
00201             }
00202         
00203         h = (**h).prevhashtable;
00204         } /*while*/
00205     } /*langfindvalue*/
00206 
00207 
00208 //static tyvaluerecord vallookfor;
00209 
00210 
00211 static boolean getostypevalnamevisit (bigstring bsname, hdlhashnode hnode, tyvaluerecord val, tyvaluerecord *vallookfor) {
00212     
00213     /*
00214     3.0.2b1 dmb: we now look in all loaded app tables for a match when 
00215     converting an terminology value (a string4 value) its name
00216     */
00217     
00218     register hdltablevariable hv;
00219     register hdlhashtable ht;
00220     register boolean fltempload;
00221     hdlhashtable htable;
00222     hdltablevariable hvariable;
00223     short errorcode;
00224     boolean fl;
00225     
00226     if (!gettablevariable (val, &hvariable, &errorcode))
00227         return (false);
00228     
00229     hv = hvariable;
00230     
00231     fltempload = !(**hv).flinmemory;
00232     
00233     if (fltempload) /*we don't want to search every app table, just those in use*/
00234         return (false);
00235     
00236     /*
00237     if (!tableverbinmemory ((hdlexternalvariable) hv))
00238         return (false);
00239     */
00240     
00241     ht = (hdlhashtable) (**hv).variabledata; 
00242     
00243     if (ht == currenthashtable) /*it's already been searched*/
00244         return (false);
00245     
00246     pushhashtable (ht);
00247     
00248     fl = langfindvalue (*vallookfor, &htable, bsname);
00249     
00250     pophashtable ();
00251     
00252     /*
00253     if (fltempload)
00254         tableverbunload ((hdlexternalvariable) hv);
00255     */
00256     
00257     return (fl);
00258     } /*getostypevalnamevisit*/
00259 
00260 
00261 static boolean getostypedisplaystring (OSType key, bigstring bsdisplay) {
00262     
00263     /*
00264     key is an enum or string4 value that may correspond to a bit of 
00265     object model user terminology. our job is to scan the current context 
00266     for a match, and return the symbolic name if found. otherwise, return 
00267     a string4 in single quotes
00268     
00269     2.1b6 dmb: if result is a quoted literal, add escape sequences
00270     */
00271     
00272     tyvaluerecord val;
00273     hdlhashtable htable;
00274     byte bskey [16];
00275     boolean fl;
00276     
00277     setostypevalue (key, &val);
00278     
00279     if (langfindvalue (val, &htable, bsdisplay))
00280         return (true);
00281     
00282     if (objectmodeltable != nil) {
00283         
00284         pushhashtable (objectmodeltable);
00285         
00286         fl = langfindvalue (val, &htable, bsdisplay);
00287         
00288         pophashtable ();
00289         
00290         if (fl)
00291             return (true);
00292         }
00293     
00294     if (iacgluetable != nil) {
00295         
00296         //vallookfor = val;
00297         
00298         if (hashinversesearch (iacgluetable, &getostypevalnamevisit, &val, bsdisplay))
00299             return (true);
00300         }
00301     
00302     ostypetostring (key, bskey);
00303     
00304     langdeparsestring (bskey, chsinglequote); /*add needed escape sequences*/
00305     
00306     parsedialogstring ("\p'^0'", bskey, nil, nil, nil, bsdisplay);
00307     
00308     return (false);
00309     } /*getostypedisplaystring*/
00310 
00311 
00312 static boolean getlimitedvaluestring (tyvaluerecord *val, short limit, char chquote, bigstring bsvalue) {
00313     
00314     /*
00315     2.1b2 dmb: try using AE coercion for unknown (binary) types
00316     
00317     2.1b3 dmb: if binary ends up needing to be coerced to string, add quotes 
00318     and escape sequences
00319     */
00320     
00321     register tyvaluerecord *v = val;
00322     AEDesc desc, coerceddesc;
00323     OSErr err;
00324     
00325     if ((*v).valuetype == binaryvaluetype) {
00326         
00327         binarytodesc ((*v).data.binaryvalue, &desc); /*binary handle remains in temp stack*/
00328         
00329         err = AECoerceDesc (&desc, typeChar, &coerceddesc);
00330         
00331         if (err == noErr)
00332             chquote = chdoublequote;
00333         else
00334             err = AECoerceDesc (&desc, typeObjectSpecifier, &coerceddesc);
00335         
00336         if (err != noErr) /*no AE coercion to objspec*/
00337             err = AECoerceDesc (&desc, typeAERecord, &coerceddesc);
00338         
00339         if (err != noErr) { /*no AE coercion to record either*/
00340             
00341             chquote = chdoublequote;
00342             
00343             /*
00344             hashgetvaluestring (*v, bsvalue); /*go with hex string%/
00345             
00346             goto limit;
00347             */
00348             }
00349         else {
00350             
00351             disposevaluerecord (*v, true);
00352             
00353             if (!setdescriptorvalue (coerceddesc, v))
00354                 return (false);
00355             }
00356         }
00357     
00358     if (!coercetostring (v))
00359         return (false);
00360     
00361     pullstringvalue (v, bsvalue);
00362     
00363     limit:
00364     
00365     if (chquote != chnul)
00366         langdeparsestring (bsvalue, chquote); /*add needed escape sequences*/
00367     
00368     if (stringlength (bsvalue) > limit) {
00369         
00370         setstringlength (bsvalue, limit - 1);
00371         
00372         pushchar ('', bsvalue);
00373         }
00374     
00375     if (chquote != chnul) {
00376         
00377         insertchar (chquote, bsvalue);
00378         
00379         pushchar (chquote, bsvalue);
00380         }
00381     
00382     return (true);
00383     } /*getlimitedvaluestring*/
00384 
00385 
00386 boolean getobjectmodeldisplaystring (tyvaluerecord *vitem, bigstring bsdisplay) {
00387     
00388     /*
00389     get the value's string representation for inclusion in a list 
00390     or object specifier, adding single or double quotes as necessary, and 
00391     mapping string4 values to identifiers in the current context.
00392     
00393     limit the length of the returned string to 253 characters. if we're returning 
00394     a quoted string and need to add an ellipse, add it inside of the quotes.
00395     
00396     2.1b1 dmb: don't quote objspec values. exported for osacomponent
00397     */
00398     
00399     register tyvaluerecord *v = vitem;
00400     
00401     switch ((*v).valuetype) {
00402         
00403         case novaluetype:
00404             langgetmiscstring (justnilstring, bsdisplay);
00405             
00406             break;
00407         
00408         case ostypevaluetype:
00409         case enumvaluetype:
00410             getostypedisplaystring ((*v).data.ostypevalue, bsdisplay);
00411             
00412             break;
00413         
00414         case charvaluetype: /*these need single quotes*/
00415             if (!getlimitedvaluestring (v, 251, chsinglequote, bsdisplay))
00416                 return (false);
00417             
00418             break;
00419         
00420         case stringvaluetype: /*these need to be quoted*/
00421         case filespecvaluetype:
00422         case aliasvaluetype:
00423         case datevaluetype:
00424         case addressvaluetype:
00425             if (!getlimitedvaluestring (v, 251, chdoublequote, bsdisplay))
00426                 return (false);
00427             
00428             break;
00429         
00430         case pointvaluetype: /*these should look like lists*/
00431         case rectvaluetype:
00432         case rgbvaluetype:
00433             if (!getlimitedvaluestring (v, 251, chnul, bsdisplay))
00434                 return (false);
00435             
00436             insertchar ('{', bsdisplay);
00437             
00438             pushchar ('}', bsdisplay);
00439             
00440             break;
00441         
00442         case objspecvaluetype:
00443             if (!getlimitedvaluestring (v, 253, chnul, bsdisplay))
00444                 return (false);
00445             
00446             if (isemptystring (bsdisplay))
00447                 copystring ("\p\"\"", bsdisplay);
00448             
00449             break;
00450             
00451         default:
00452             if (!getlimitedvaluestring (v, 253, chnul, bsdisplay))
00453                 return (false);
00454             
00455             break;
00456         }
00457     
00458     return (true);
00459     } /*getobjectmodeldisplaystring*/
00460 
00461 
00462 static boolean stringtoalias (tyvaluerecord *val) {
00463     
00464     /*
00465     10/7/91 dmb: make sure we're actually passing a full path to the NewAlias routine
00466     
00467     7/2/92 dmb: don't call getfullfilepath; makes it impossible to create aliases of 
00468     not-yet-existing files, or offline volumes
00469     
00470     7/23/92 dmb: OK, try to getfullfilepath, but with errors disabled
00471     
00472     2.1b2 dmb: try converting to a filespec first to ensure that partial path or 
00473     drive number if processed properly. also, in the filespec case, the alias isn't 
00474     minimal
00475     */
00476     
00477     register Handle htext;
00478     bigstring bspath;
00479     tyfilespec fs;
00480     AliasHandle halias;
00481     boolean flfolder;
00482     OSErr errcode;
00483     
00484     if (!langcanusealiases ())
00485         return (false);
00486     
00487     htext = (*val).data.stringvalue;
00488     
00489     texthandletostring (htext, bspath);
00490     
00491     if (pathtofilespec (bspath, &fs) && fileexists (&fs, &flfolder))
00492         errcode = NewAlias (nil, &fs, &halias);
00493     else
00494         errcode = NewAliasMinimalFromFullPath (stringlength (bspath), bspath + 1, nil, nil, &halias);
00495     
00496     if (oserror (errcode))
00497         return (false);
00498     
00499     if (!setheapvalue ((Handle) halias, aliasvaluetype, val))
00500         return (false);
00501     
00502     releaseheaptmp ((Handle) htext);
00503     
00504     return (true);
00505     } /*stringtoalias*/
00506 
00507 
00508 boolean filespectoalias (const tyfilespec *fs, boolean flminimal, AliasHandle *halias) {
00509     
00510     bigstring bs;
00511     OSErr err;
00512     
00513     if (flminimal)
00514         err = NewAliasMinimal (fs, halias);
00515     else
00516         err = NewAlias (nil, fs, halias);
00517     
00518     if (err == fnfErr) { /*alias manager isn't friendly enough to do anything for us here*/
00519         
00520         if (filespectopath (fs, bs))
00521             err = NewAliasMinimalFromFullPath (stringlength (bs), bs + 1, nil, nil, halias);
00522         }
00523     
00524     if (err == noErr)
00525         return (true);
00526     
00527     if (langerrorenabled ()) {
00528         
00529         setoserrorparam ((ptrstring) (*fs).name);
00530         
00531         oserror (err);
00532         }
00533     
00534     return (false);
00535     } /*filespectoalias*/
00536 
00537 
00538 static boolean filespecvaltoalias (tyvaluerecord *val) {
00539     
00540     register FSSpecHandle hfs;
00541     FSSpec fs;
00542     AliasHandle halias;
00543     
00544     if (!langcanusealiases ())
00545         return (false);
00546     
00547     hfs = (FSSpecHandle) (*val).data.filespecvalue;
00548     
00549     fs = **hfs;
00550     
00551     if (!filespectoalias (&fs, false, &halias))
00552         return (false);
00553     
00554     if (!setheapvalue ((Handle) halias, aliasvaluetype, val))
00555         return (false);
00556     
00557     releaseheaptmp ((Handle) hfs);
00558     
00559     return (true);
00560     } /*filespecvaltoalias*/
00561 
00562 
00563 boolean aliastostring (Handle halias, bigstring bs) {
00564     
00565     /*
00566     10/4/91 dmb: if alias can't be resolved, just say what volume it's on.
00567     
00568     4/12/93 dmb: accept fnfErr result from ResolveAlias
00569     
00570     2.1b9 dmb: use FollowFinderAlias to avoid mounting volumes during 
00571     alias resolution
00572     
00573     4.0b6 4/26/96 dmb: restored FollowFinderAlias code; must use if we get fnfErr.
00574     */
00575     
00576     register AliasHandle h = (AliasHandle) halias;
00577     short flchanged;
00578     FSSpec fs;
00579     bigstring bsinfo;
00580     AliasInfoType ix = asiAliasName;
00581     OSErr err;
00582     
00583     if (!langcanusealiases ())
00584         return (false);
00585     
00586     err = FollowFinderAlias (nil, h, false, &fs, (Boolean *) &flchanged);
00587     
00588     if ((err == noErr) /*|| (err == fnfErr)*/ ) {
00589         
00590         if (flchanged)
00591             UpdateAlias (nil, &fs, h, (Boolean *) &flchanged);
00592         
00593         return (filespectopath (&fs, bs));
00594         }
00595     
00596     langgettypestring (aliasvaluetype, bs);
00597     
00598     /*
00599     if (GetAliasInfo (h, asiVolumeName, bsinfo) == noErr) { //add the volume name
00600         
00601         bigstring bsaliasondisk;
00602         
00603         langgetstringlist (unresolvedaliasstring, bsaliasondisk);
00604         
00605         parsedialogstring (bsaliasondisk, bs, bsinfo, nil, nil, bsaliasondisk);
00606         
00607         copystring (bsaliasondisk, bs);
00608         }
00609     */
00610     
00611     setemptystring (bs);
00612     
00613     // get each path element out of the alias
00614     while (GetAliasInfo (h, ix, bsinfo) == noErr) {
00615         
00616         if (isemptystring (bsinfo)) // reached top of path hierarchy
00617             break;
00618         
00619         if (ix > asiAliasName)
00620             pushchar (':', bsinfo);
00621         
00622         if (!insertstring (bsinfo, bs))
00623             break;
00624         
00625         ++ix;
00626         }
00627     
00628     // add the volume name
00629     GetAliasInfo (h, asiVolumeName, bsinfo);
00630     
00631     pushchar (':', bsinfo);
00632     
00633     insertstring (bsinfo, bs);
00634     
00635     return (true);
00636     } /*aliastostring*/
00637 
00638 
00639 boolean aliastofilespec (AliasHandle halias, FSSpec *fs) {
00640     
00641     /*
00642     2.1a6 dmb: ignore fnfErr
00643     
00644     2.1b2 dmb: on error, try to get as much info from the alias as possible, 
00645     & just return false to caller
00646     
00647     2.1b9 dmb: use FollowFinderAlias to avoid mounting volumes during 
00648     alias resolution
00649     */
00650     
00651     Boolean flchanged;
00652     bigstring bs;
00653     OSErr err;
00654     
00655     if (!langcanusealiases ())
00656         return (false);
00657     
00658     err = FollowFinderAlias (nil, halias, false, fs, &flchanged);
00659     
00660     if ((err == noErr) || (err == fnfErr))
00661         return (true);
00662     
00663     (*fs).parID = 0;
00664     
00665     (*fs).vRefNum = 0;
00666     
00667     if (GetAliasInfo (halias, asiVolumeName, bs) == noErr) /*try to get vol info*/
00668         fileparsevolname (bs, &(*fs).vRefNum, nil);
00669     
00670     if (GetAliasInfo (halias, asiAliasName, (*fs).name) != noErr) /*try to set file name*/
00671         langgetmiscstring (unknownstring, (*fs).name);
00672     
00673     if (langerrorenabled ()) {
00674         
00675         setoserrorparam ((*fs).name);
00676         
00677         oserror (err);
00678         }
00679     
00680     return (false);
00681     } /*aliastofilespec*/
00682 
00683 
00684 boolean coercetoalias (tyvaluerecord *v) {
00685     
00686     /*
00687     10/4/91 dmb: when v is novaluetype, fail silently so the new verb 
00688     will just return false.  a specific error message might be better, but 
00689     I don't expect this to come up much, if at all.
00690     */
00691     
00692     switch ((*v).valuetype) {
00693         
00694         case aliasvaluetype:
00695             return (true);
00696         
00697         case novaluetype: /*easy way is via file spec to make alias of default folder*/
00698             if (flinhibitnilcoercion)
00699                 return (false);
00700             
00701             if (!coercetofilespec (v))
00702                 return (false);
00703             
00704             return (filespecvaltoalias (v));
00705         
00706         case stringvaluetype:
00707             return (stringtoalias (v));
00708         
00709         case binaryvaluetype:
00710             return (coercebinaryval (v, aliasvaluetype, 0L, aliasvaluetype));
00711         
00712         case filespecvaluetype:
00713             return (filespecvaltoalias (v));
00714         
00715         case listvaluetype:
00716         case recordvaluetype:
00717             return (coercelistvalue (v, aliasvaluetype));
00718         
00719         default:
00720             langcoerceerror (v, aliasvaluetype);
00721             
00722             return (false);
00723         } /*switch*/
00724     } /*coercetoalias*/
00725 
00726 
00727 boolean filespecaddvalue (tyvaluerecord *v1, tyvaluerecord *v2, tyvaluerecord *vreturned) {
00728     
00729     /*
00730     add v2 to the filespec v1 by using it as a partial path. if anything bug a valid 
00731     fspec results, return a string value that is simple concatenation
00732     
00733     2.1b3 dmb: if resulting path is to a non-existent folder, don't return a filespec 
00734     
00735     2.1b6 dmb: if resulting specifier exists, but doesn't agree with bsadd as far as 
00736     whether or not it's a folder, return a string.
00737     */
00738     
00739     tyfilespec fs;
00740     bigstring bsadd;
00741     boolean fl, flfolder;
00742     boolean flfolderpath;
00743     OSErr err;
00744     
00745     if (!coercetostring (v2))
00746         return (false);
00747     
00748     fs = **(*v1).data.filespecvalue;
00749     
00750     pullstringvalue (v2, bsadd);
00751     
00752     if (fileexists (&fs, &flfolder)) {
00753         
00754     //  fileisfolder (&fs, &flfolder);
00755         
00756         if (flfolder)
00757             pushchar (':', fs.name);
00758         }
00759     
00760     insertstring (fs.name, bsadd);
00761     
00762     if (stringfindchar (':', bsadd)) /*will be interpreted as full path, so make it partial*/
00763         insertchar (':', bsadd);
00764     
00765     err = FSMakeFSSpec (fs.vRefNum, fs.parID, bsadd, &fs);
00766     
00767     flfolderpath = lastchar (bsadd) == ':';
00768     
00769     switch (err) {
00770         
00771         case noErr: /*valid spec, file exists*/
00772             
00773             fileisfolder (&fs, &flfolder);
00774             
00775             fl = flfolder == flfolderpath; /*make sure endings match*/
00776             
00777             break;
00778         
00779         case fnfErr: /*valid spec, file doesn't exist*/
00780             
00781             fl = !flfolderpath;
00782             
00783             break;
00784         
00785         default:
00786             fl = false;
00787             
00788             break;
00789         }
00790     
00791     if (!fl) { /*couldn't extend filespec*/
00792         
00793         coercetostring (v1);
00794         
00795         return (addvalue (*v1, *v2, vreturned));
00796         }
00797     
00798     return (setfilespecvalue (&fs, vreturned));
00799     } /*filespecaddvalue*/
00800 
00801 
00802 boolean filespecsubtractvalue (tyvaluerecord *v1, tyvaluerecord *v2, tyvaluerecord *vreturned) {
00803     
00804     /*
00805     subtract v2 from the filespec v1's file name, iff v2 is a simple string (no 
00806     colons). otherwise, return a string value that is simple string subtraction
00807     */
00808     
00809     tyfilespec fs;
00810     bigstring bssub;
00811     boolean fl;
00812     Str63 bsname;
00813     OSErr err;
00814     
00815     if (!coercetostring (v2))
00816         return (false);
00817     
00818     fs = **(*v1).data.filespecvalue;
00819     
00820     pullstringvalue (v2, bssub);
00821     
00822     fl = !stringfindchar (':', bssub);
00823     
00824     if (fl) {
00825         
00826         subtractstrings (fs.name, bssub, bsname);
00827         
00828         err = FSMakeFSSpec (fs.vRefNum, fs.parID, bsname, &fs);
00829         
00830         fl = (err == noErr) || (err == fnfErr);
00831         }
00832     
00833     if (!fl) { /*couldn't extend filespec*/
00834     
00835         coercetostring (v1);
00836         
00837         return (subtractvalue (*v1, *v2, vreturned));
00838         }
00839     
00840     return (setfilespecvalue (&fs, vreturned));
00841     } /*filespecsubtractvalue*/
00842 
00843 
00844 static pascal OSErr langsystem7accessobject (
00845                         DescType    classWanted,
00846                         AEDesc      *container,
00847                         DescType    containerClass, 
00848                         DescType    keyform,
00849                         AEDesc      *keydesc,
00850                         AEDesc      *resultToken,
00851                         long        theRefCon) {
00852     
00853     #pragma unused (classWanted,container,containerClass,theRefCon)
00854     
00855     AEDesc tempdesc;
00856     hdlhashtable htable;
00857     bigstring bs;
00858     register OSErr err;
00859     
00860     switch (keyform) {
00861         
00862         case formName:
00863             err = AECoerceDesc (keydesc, typeChar, &tempdesc);
00864             
00865             if (err != noErr)
00866                 return (err);
00867             
00868             texthandletostring ((*keydesc).dataHandle, bs);
00869             
00870             if (!langexpandtodotparams (bs, &htable, bs)) {
00871                 
00872                 AEDisposeDesc (&tempdesc);
00873                 
00874                 return(errAENoSuchObject);
00875                 }
00876             
00877             *resultToken = tempdesc;
00878             
00879             return (noErr);
00880         
00881         /*
00882         case formAbsolutePosition:
00883             err = AECoerceDesc (keydesc, typeLongInteger, &tempdesc);
00884             
00885             if (err != noErr)
00886                 return (err);
00887             
00888             return (errAEEventNotHandled);      // I've got no clue of how to access files by number.
00889         */
00890         
00891         default:                                // I don't handle any other key forms.
00892             return (errAEEventNotHandled);
00893         }
00894     } /*langsystem7accessobject*/
00895 
00896 
00897 static void setupdescriptor (Handle hdata, AEDesc *desc) {
00898     
00899     register AEDesc *d = desc;
00900     
00901     (*d).dataHandle = hdata;
00902     
00903     if ((*d).dataHandle == nil)
00904         (*d).descriptorType = typeNull;
00905     else
00906         (*d).descriptorType = typeObjectSpecifier;
00907     } /*setupdescriptor*/
00908 
00909 
00910 static OSErr langsystem7parseobject (const AEDesc *object, DescType *class, AEDesc *container, DescType *keyform, AEDesc *keydata) {
00911     
00912     AEDesc objdesc;
00913     DescType type;
00914     long size;
00915     register OSErr err;
00916     
00917     err = AECoerceDesc (object, typeAERecord, &objdesc);
00918     
00919     if (err != noErr)
00920         return (err);
00921     
00922     setupdescriptor (nil, container);
00923     
00924     setupdescriptor (nil, keydata);
00925     
00926     err = AEGetKeyPtr (&objdesc, keyAEDesiredClass, typeType, &type, (Ptr) class, sizeof (class), &size);
00927     
00928     if (err != noErr)
00929         goto exit;
00930     
00931     err = AEGetKeyPtr (&objdesc, keyAEKeyForm, typeEnumerated, &type, (Ptr) keyform, sizeof (keyform), &size);
00932     
00933     if (err != noErr)
00934         goto exit;
00935     
00936     err = AEGetKeyDesc (&objdesc, keyAEContainer, typeWildCard, container);
00937     
00938     if (err != noErr)
00939         goto exit;
00940     
00941     err = AEGetKeyDesc (&objdesc, keyAEKeyData, typeWildCard, keydata);
00942     
00943     exit:
00944     
00945     AEDisposeDesc (&objdesc);
00946     
00947     if (err != noErr) {
00948         
00949         AEDisposeDesc (container);
00950         
00951         AEDisposeDesc (keydata);
00952         }
00953     
00954     return (err);
00955     } /*langsystem7parseobject*/
00956 
00957 
00958 static OSErr langsystem7resolve (const AEDesc *object, AEDesc *resultdesc) {
00959     
00960     DescType class;
00961     DescType keyform;
00962     AEDesc keydata;
00963     AEDesc container;
00964     register OSErr err;
00965     
00966     err = langsystem7parseobject (object, &class, &container, &keyform, &keydata);
00967     
00968     if (err != noErr)
00969         return (err);
00970     
00971     if (container.descriptorType != typeNull)
00972         err = errAEEventNotHandled;
00973     else
00974         err = langsystem7accessobject (cCell, &container, cApplication, keyform, &keydata, resultdesc, 0);
00975     
00976     AEDisposeDesc (&container);
00977     
00978     AEDisposeDesc (&keydata);
00979     
00980     return (err);
00981     } /*langsystem7resolve*/
00982 
00983 
00984 boolean objspectoaddress (tyvaluerecord *val) {
00985     
00986     /*
00987     9/23/92 dmb: turn the objspec value into an address value.
00988     
00989     this will only work if the object specification is for a cell 
00990     in the data. currently, that means it must be a formName 
00991     specifier of a cCell element with a null container
00992     */
00993     
00994     register tyvaluerecord *v = val;
00995     AEDesc objdesc;
00996     AEDesc token;
00997     OSErr errcode;
00998     
00999     setupdescriptor ((*v).data.objspecvalue, &objdesc);
01000     
01001     errcode = langsystem7resolve (&objdesc, &token);
01002     
01003     if (errcode != noErr)
01004         return (false);
01005     
01006     disposevaluerecord (*v, true);
01007     
01008     if (!setheapvalue (token.dataHandle, stringvaluetype, v)) /*consumes handle*/
01009         return (false);
01010     
01011     return (stringtoaddress (v));
01012     } /*objspectoaddress*/
01013 
01014 
01015 boolean objspectofilespec (tyvaluerecord *val) {
01016     
01017     /*
01018     2.1b5 dmb: added for AppleScript compatibility
01019     */
01020     
01021     register tyvaluerecord *v = val;
01022     AEDesc objdesc;
01023     DescType class;
01024     DescType containertype;
01025     DescType keyform;
01026     AEDesc keydata;
01027     AEDesc container;
01028     
01029     setupdescriptor ((*v).data.objspecvalue, &objdesc);
01030     
01031     if (oserror (langsystem7parseobject (&objdesc, &class, &container, &keyform, &keydata)))
01032         return (false);
01033     
01034     containertype = container.descriptorType;
01035     
01036     AEDisposeDesc (&container);
01037     
01038     if ((containertype == typeNull) && (class == cFile) && (keyform == formName)) {
01039         
01040         disposevaluerecord (*v, true); /*dispose orig value which is also objdesc*/
01041         
01042         if (!setdescriptorvalue (keydata, v)) /*keydata is on temp stack, or disposed on error*/
01043             return (false);
01044         
01045         if (!coercetostring (v))
01046             return (false);
01047         
01048         return (coercetofilespec (v)); /*a little recursion here, since that's probably our caller*/
01049         }
01050     else {
01051         
01052         AEDisposeDesc (&keydata);
01053         
01054         langcoerceerror (v, filespecvaluetype);
01055         
01056         return (false);
01057         }
01058     } /*objspectofilespec*/
01059 
01060 
01061 boolean filespectoobjspec (tyvaluerecord *val) {
01062     
01063     /*
01064     2.1b5 dmb: added for AppleScript compatibility
01065     */
01066     
01067     register tyvaluerecord *v = val;
01068     AEDesc objdesc;
01069     AEDesc keydata;
01070     tyfilespec fs = **(*v).data.filespecvalue;
01071     bigstring bs;
01072     AEDesc container = {typeNull, nil};
01073     OSErr err;
01074     
01075     filespectopath (&fs, bs);
01076     
01077     err = AECreateDesc (typeChar, (Ptr) bs + 1, stringlength (bs), &keydata);
01078     
01079     if (err == noErr)
01080         err = CreateObjSpecifier (cFile, &container, formName, &keydata, true, &objdesc);
01081     
01082     if (oserror (err))
01083         return (false);
01084     
01085     disposevaluerecord (*v, true);
01086     
01087     return (setheapvalue (objdesc.dataHandle, objspecvaluetype, v));
01088     } /*filespectoobjspec*/
01089 
01090 
01091 static boolean stringtoobjspec (tyvaluerecord *val) {
01092     
01093     /*
01094     2.1b2 dmb: fixed bug where true would be returned for a bad objspec.
01095     
01096     2.1b2 dmb: added special case for empty strings
01097     
01098     2.1b6 dmb: fixed error offset maintenance
01099     */
01100     
01101     Handle htext;
01102     hdltreenode hmodule;
01103     boolean fl = false;
01104     unsigned short savelines;
01105     unsigned short savechars;
01106     
01107     if (gethandlesize ((*val).data.stringvalue) == 0) { /*empty string -> null spec*/
01108         
01109         disposevaluerecord (*val, true);
01110         
01111         (*val).valuetype = objspecvaluetype;
01112         
01113         (*val).data.objspecvalue = nil;
01114         
01115         return (true);
01116         }
01117     
01118     if (!copyhandle ((*val).data.stringvalue, &htext))
01119         return (false);
01120     
01121     savelines = ctscanlines;
01122     
01123     savechars = ctscanchars;
01124     
01125     disablelangerror ();
01126     
01127     fl = langcompiletext (htext, false, &hmodule); /*always disposes htext*/
01128     
01129     enablelangerror ();
01130     
01131     if (fl) {
01132         
01133         register hdltreenode h = (**hmodule).param1; /*copy into register*/
01134         
01135         fl = isobjspectree (h);
01136         
01137         if (fl) {
01138             
01139             disposevaluerecord (*val, true);
01140             
01141             disablelangerror (); /*we'll generate own error w/correct position*/
01142             
01143             fl = evaluateobjspec (h, val);
01144             
01145             enablelangerror ();
01146             }
01147         
01148         langdisposetree (hmodule);
01149         }
01150     
01151     ctscanlines = savelines;
01152     
01153     ctscanchars = savechars;
01154     
01155     if (!fl)
01156         langerror (badobjectspecificationerror);
01157     
01158     return (fl);
01159     } /*stringtoobjspec*/
01160 
01161 
01162 static boolean objtostring (AEDesc *, boolean, DescType, AEDesc *, bigstring); /*forward*/
01163 
01164 
01165 typedef struct tyobjspecitem { /*data within special object specifier structures*/
01166     
01167     AEKeyword key;
01168     
01169     DescType type;
01170     
01171     long size;
01172     
01173     /*data follows*/
01174     } tyobjspecitem;
01175 
01176 
01177 static boolean getobjspeckeydesc (AEDesc *objdata, OSType desiredkey, AEDesc *keydata) {
01178     
01179     register Handle h = (*objdata).dataHandle;
01180     register byte *p;
01181     long ctitems;
01182     tyobjspecitem objspecitem;
01183     OSErr err;
01184     
01185     HLock (h);
01186     
01187     p = (byte *) *(*objdata).dataHandle;
01188     
01189     if (*(OSType *)p == (*objdata).descriptorType) /*data begins with redundant type; skip it*/
01190         p += 4;
01191     
01192     BlockMove (p, &ctitems, 4);
01193     
01194     p += 8;
01195     
01196     while (--ctitems >= 0) {
01197         
01198         BlockMove (p, &objspecitem, sizeof (tyobjspecitem));
01199         
01200         p += sizeof (objspecitem);
01201         
01202         if (objspecitem.key == desiredkey) {
01203             
01204             err = AECreateDesc (objspecitem.type, (Ptr) p, objspecitem.size, keydata);
01205             
01206             goto exit;
01207             }
01208         
01209         p += objspecitem.size;
01210         
01211         if (odd (objspecitem.size))
01212             ++p;
01213         }
01214     
01215     err = errAEDescNotFound;
01216     
01217     exit:
01218     
01219     HUnlock (h);
01220     
01221     return (!oserror (err));
01222     } /*getobjspeckeydesc*/
01223 
01224 
01225 static void operatortostring (OSType op, bigstring bsop) {
01226     
01227     byte *p;
01228     
01229     switch (op) {
01230         
01231         case kAEEquals:
01232             p = "\p==";
01233             
01234             break;
01235         
01236         case kAEGreaterThan:
01237             p = "\p>";
01238             
01239             break;
01240         
01241         case kAELessThan:
01242             p = "\p<";
01243             
01244             break;
01245         
01246         case kAEGreaterThanEquals:
01247             p = "\p>=";
01248             
01249             break;
01250         
01251         case kAELessThanEquals:
01252             p = "\p<=";
01253             
01254             break;
01255         
01256         case kAEBeginsWith:
01257             p = "\pbeginsWith";
01258             
01259             break;
01260         
01261         case kAEEndsWith:
01262             p = "\pendsWith";
01263             
01264             break;
01265         
01266         case kAEContains:
01267             p = "\pcontains";
01268             
01269             break;
01270         
01271         case '<>  ':
01272         case '!=  ':
01273             p = "\p!=";
01274             
01275             break;
01276         
01277         case kAENOT:
01278             p = "\pnot";
01279         
01280             break;
01281         
01282         case kAEAND:
01283             p = "\pand";
01284         
01285             break;
01286         
01287         case kAEOR:
01288             p = "\por";
01289             
01290             break;
01291         }
01292     
01293     copystring (p, bsop);
01294     } /*operatortostring*/
01295 
01296 
01297 static boolean testtostring (AEDesc *testdata, bigstring bstest) {
01298     
01299     bigstring bs1, bs2;
01300     byte bsop [16];
01301     AEDesc desc;
01302     DescType type;
01303     boolean fl = false;
01304     OSType op;
01305     
01306     setemptystring (bstest);
01307     
01308     type = (*testdata).descriptorType;
01309     
01310     switch (type) {
01311         
01312         case typeLogicalDescriptor: {
01313             AEDesc itemdesc;
01314             OSType key;
01315             long n, ctitems;
01316             
01317             if (!getobjspeckeydesc (testdata, keyAELogicalOperator, &desc))
01318                 goto exit;
01319             
01320             op = **(OSType **)desc.dataHandle;
01321             
01322             operatortostring (op, bsop);
01323             
01324             AEDisposeDesc (&desc);
01325             
01326             if (!getobjspeckeydesc (testdata, keyAELogicalTerms, &desc))
01327                 goto exit;
01328             
01329             if (oserror (AECountItems (&desc, &ctitems)))
01330                 goto exit;
01331             
01332             for (n = 1; n <= ctitems; ++n) {
01333                 
01334                 if (oserror (AEGetNthDesc (&desc, n, typeWildCard, &key, &itemdesc)))
01335                     goto exit;
01336                 
01337                 if (!testtostring (&itemdesc, bs1))
01338                     goto exit;
01339                 
01340                 AEDisposeDesc (&itemdesc);
01341                 
01342                 if (n == 1) {
01343                     
01344                     copystring (bs1, bstest);
01345                     
01346                     if (op == kAENOT) { /*special case -- not infix, only 1 comparison*/
01347                         
01348                         short ix = patternmatch ("\p==", bstest); /*'nother special case*/
01349                         
01350                         if (ix > 0)
01351                             bstest [ix] = '!';
01352                         else
01353                             parsedialogstring ("\p^0 (^1)", bsop, bs1, nil, nil, bstest);
01354                         }
01355                     }
01356                 else {
01357                     copystring (bstest, bs2);
01358                     
01359                     parsedialogstring ("\p^0 ^1 ^2", bs2, bsop, bs1, nil, bstest);
01360                     }
01361                 }
01362             
01363             AEDisposeDesc (&desc);
01364             
01365             break;
01366             }
01367         
01368         case typeCompDescriptor:
01369             
01370             if (!getobjspeckeydesc (testdata, keyAECompOperator, &desc))
01371                 goto exit;
01372             
01373             op = **(OSType **)desc.dataHandle;
01374             
01375             operatortostring (op, bsop);
01376             
01377             AEDisposeDesc (&desc);
01378             
01379             if (!getobjspeckeydesc (testdata, keyAEObject1, &desc))
01380                 goto exit;
01381             
01382             if (!objtostring (&desc, true, 0, nil, bs1))
01383                 goto exit;
01384             
01385             if (!getobjspeckeydesc (testdata, keyAEObject2, &desc))
01386                 goto exit;
01387             
01388             if (!objtostring (&desc, true, 0, nil, bs2))
01389                 goto exit;
01390             
01391             parsedialogstring ("\p^0 ^1 ^2", bs1, bsop, bs2, nil, bstest);
01392             
01393             break;
01394         
01395         default:
01396             return (false);
01397         }
01398     
01399     fl = true;
01400     
01401     exit:
01402     
01403     return (fl);
01404     } /*testtostring*/
01405 
01406 
01407 static boolean rangetostring (DescType rangeclass, AEDesc *rangecontainer, AEDesc *rangedata, bigstring bsrange) {
01408     
01409     bigstring bs1, bs2;
01410     AEDesc desc;
01411     boolean fl = false;
01412     
01413     if (!getobjspeckeydesc (rangedata, keyAERangeStart, &desc))
01414         goto exit;
01415     
01416     if (!objtostring (&desc, true, rangeclass, rangecontainer, bs1))
01417         goto exit;
01418     
01419     if (!getobjspeckeydesc (rangedata, keyAERangeStop, &desc))
01420         goto exit;
01421     
01422     if (!objtostring (&desc, true, rangeclass, rangecontainer, bs2))
01423         goto exit;
01424     
01425     parsedialogstring ("\p^0 to ^1", bs1, bs2, nil, nil, bsrange);
01426     
01427     fl = true;
01428     
01429     exit:
01430     
01431     return (fl);
01432     } /*rangetostring*/
01433 
01434 
01435 static boolean getostypeidentifier (OSType id, bigstring bsidentifier) {
01436     
01437     if (getostypedisplaystring (id, bsidentifier)) /*found name for ostype*/
01438         return (true);
01439     
01440     insertchar ('[', bsidentifier); /*must bracket string4 to make it an identifier*/
01441     
01442     pushchar (']', bsidentifier);
01443     
01444     return (false);
01445     } /*getostypeidentifier*/
01446 
01447 
01448 static boolean objtostring (AEDesc *objdesc, boolean fldisposeobj, DescType examinedclass, AEDesc *examinedcontainer, bigstring bsobj) {
01449     
01450     /*
01451     create a string representation of objdesc.
01452     
01453     examinedclass isusually 0, but if we're being called while parsing a range, it's 
01454     the class of the object being examined, in which case we can potentially omit 
01455     redundant class specification of this element
01456     
01457     2.1b1 dmb: supplementing examinedclass, we now take examinedcontainer as well to 
01458     avoid redundancy.
01459     
01460     2.1b4 dmb: check for typeNull before getobjectmodeldisplaystring to avoid 
01461     infinite recursion
01462     */
01463     
01464     DescType class;
01465     DescType keyform;
01466     AEDesc keydata;
01467     AEDesc container;
01468     tyvaluerecord vobj;
01469     tyvaluerecord vkey;
01470     byte bsclass [64];
01471     bigstring bsitem;
01472     boolean fl;
01473     
01474     setemptystring (bsobj);
01475     
01476     if ((*objdesc).descriptorType != typeObjectSpecifier) {
01477         
01478         switch ((*objdesc).descriptorType) {
01479             
01480             case typeObjectBeingExamined:
01481                 copystring ("\pit", bsobj);
01482                 
01483                 AEDisposeDesc (objdesc);
01484                 
01485                 break;
01486             
01487             case typeNull:
01488                 AEDisposeDesc (objdesc); /*leave string empty*/
01489                 
01490                 break;
01491             
01492             default:
01493                 if (!setdescriptorvalue (*objdesc, &vobj))
01494                     return (false);
01495                 
01496                 if (!getobjectmodeldisplaystring (&vobj, bsobj))
01497                     return (false);
01498                 
01499                 disposevaluerecord (vobj, false);
01500                 
01501                 break;
01502             }
01503         
01504         return (true);
01505         }
01506     
01507     fl = false;
01508     
01509     while (true) {
01510         
01511         if (oserror (langsystem7parseobject (objdesc, &class, &container, &keyform, &keydata)))
01512             goto exit;
01513         
01514         if (!setdescriptorvalue (keydata, &vkey)) /*if successful, keydata is on temp stack*/
01515             goto exit;
01516         
01517         getostypeidentifier (class, bsclass);
01518         
01519         switch (keyform) {
01520             
01521             case formTest: {
01522                 bigstring bstest;
01523                 
01524                 if (!testtostring (&keydata, bstest))
01525                     goto exit;
01526                 
01527                 parsedialogstring ("\p^0 [^1]", bsclass, bstest, nil, nil, bsitem);
01528                 
01529                 break;
01530                 }
01531             
01532             case formRange: {
01533                 bigstring bsrange;
01534                 
01535                 if (!rangetostring (class, &container, &keydata, bsrange))
01536                     goto exit;
01537                 
01538                 parsedialogstring ("\p^0 [^1]", bsclass, bsrange, nil, nil, bsitem);
01539                 
01540                 break;
01541                 }
01542             
01543             case formPropertyID: {
01544                 if (!coercetoostype (&vkey))
01545                     goto exit;
01546                 
01547                 getostypeidentifier (vkey.data.ostypevalue, bsitem);
01548                 
01549                 break;
01550                 }
01551             
01552             case formName:
01553             case formAbsolutePosition:
01554             case formRelativePosition: {
01555                 bigstring bskey;
01556                 
01557                 if (!getobjectmodeldisplaystring (&vkey, bskey))
01558                     goto exit;
01559                 
01560                 if (equaldescriptors (examinedcontainer, &container)) {
01561                     
01562                     AEDisposeDesc (&container);
01563                     
01564                     container.descriptorType = typeCurrentContainer;
01565                     }
01566                 
01567                 if ((examinedclass == class) && (container.descriptorType == typeCurrentContainer))
01568                     copystring (bskey, bsitem);
01569                 else
01570                     parsedialogstring ("\p^0 [^1]", bsclass, bskey, nil, nil, bsitem);
01571                 
01572                 break;
01573                 }
01574             
01575             default: {
01576                 byte bsform [64];
01577                 bigstring bskey;
01578                 
01579                 if (!getobjectmodeldisplaystring (&vkey, bskey))
01580                     goto exit;
01581                 
01582                 getostypedisplaystring (keyform, bsform);
01583                 
01584                 parsedialogstring ("\p^0 [^1:^2]", bsclass, bsform, bskey, nil, bsitem);
01585                 
01586                 break;
01587                 }
01588             }
01589         
01590         disposevaluerecord (vkey, false);
01591         
01592         if (fldisposeobj)
01593             AEDisposeDesc (objdesc);
01594         
01595         *objdesc = container;
01596         
01597         fldisposeobj = true;
01598         
01599         if (!isemptystring (bsobj))
01600             insertchar ('.', bsobj);
01601         
01602         if (!insertstring (bsitem, bsobj)) {
01603             
01604             insertchar ('', bsobj);
01605             
01606             break;
01607             }
01608         
01609         if ((*objdesc).descriptorType != typeObjectSpecifier)
01610             break;
01611         }
01612     
01613     fl = true;
01614     
01615     exit:
01616     
01617     if (fldisposeobj)
01618         AEDisposeDesc (objdesc);
01619     
01620     return (fl);
01621     } /*objtostring*/
01622 
01623 
01624 boolean objspectostring (Handle hobjspec, bigstring bs) {
01625     
01626     AEDesc objdesc;
01627     
01628     setupdescriptor (hobjspec, &objdesc);
01629     
01630     return (objtostring (&objdesc, false, 0, nil, bs));
01631     } /*objspectostring*/
01632 
01633 
01634 static void getdefaultcontainer (OSType nulltype, AEDesc *containerdesc, boolean fluseexternalcontainer) {
01635     
01636     /*
01637     8/13/92 dmb: create a container descriptor based on nulltype.
01638     
01639     the smarts: if nulltype is typeNull, and there is a with statement that 
01640     defines a container value, then use that container. otherwise, a normal
01641     null container is returned.
01642     
01643     3.0.3 dmb: added fluseexternalcontainer parameter. if true, allow
01644     "with" statements in external contexts to show through by setting the 
01645     flfindanyspecialsymbol global to true. in practice, we're allowing 
01646     string4 property values to be coerced to objspecs in glue scripts with 
01647     the caller's "with <obj>" statement respected. at the same time, fully-
01648     formed object specifications don't erroniously pick up a parent 
01649     container from a calling script. so, we've created an inconsistency 
01650     that suites our needs and will create expected behavior in most scripts.
01651     */
01652     
01653     hdlhashnode hnode;
01654 
01655     if (nulltype == typeNull) { /*not a special type of null container*/
01656         
01657         tyvaluerecord containerval;
01658         boolean fl;
01659         
01660         flfindanyspecialsymbol = fluseexternalcontainer;
01661         
01662         fl = langgetsymbolval (bscontainername, &containerval, &hnode);
01663         
01664         flfindanyspecialsymbol = false; /*restore to default*/
01665                 
01666         if (fl) { /*got container*/
01667             
01668             setupdescriptor (containerval.data.objspecvalue, containerdesc);
01669             
01670             return;
01671             }
01672         }
01673     
01674     (*containerdesc).descriptorType = nulltype;
01675     
01676     (*containerdesc).dataHandle = nil;
01677     } /*getdefaultcontainer*/
01678 
01679 
01680 static boolean createpropertyspecifier (AEDesc *containerdesc, OSType propkey, AEDesc *objectdesc) {
01681     
01682     AEDesc keydatadesc;
01683     OSErr errcode;
01684     
01685     errcode = AECreateDesc (typeType, (Ptr) &propkey, longsizeof (propkey), &keydatadesc);
01686     
01687     if (oserror (errcode))
01688         return (false);
01689     
01690     errcode = CreateObjSpecifier (cProperty, containerdesc, formPropertyID, &keydatadesc, false, objectdesc);
01691     
01692     AEDisposeDesc (&keydatadesc);
01693     
01694     return (!oserror (errcode));
01695     } /*createpropertyspecifier*/
01696 
01697 
01698 static boolean valtoobjspec (tyvaluerecord *val, OSType nulltype, AEDesc *objectdesc) {
01699     
01700     /*
01701     return an object specifier interpretation of the given value record. 
01702     val should be a temporary value. object is returned free & clear; the 
01703     caller is responsible for its handle.
01704     
01705     12/24/91 dmb: when coercing from binary, make sure we form null spec
01706     properly with nil handle.
01707     
01708     6/24/92 dmb: fixed heap bug in binary-to-objspec coercion (when null)
01709     
01710     9/14/92 dmb: finalized treatment of null objects.
01711     */
01712     
01713     register tyvaluerecord *v = val;
01714     register AEDesc *obj = objectdesc;
01715     OSType id;
01716     AEDesc containerdesc;
01717     Handle x;
01718     
01719     switch ((*v).valuetype) {
01720         
01721         case objspecvaluetype:
01722             x = (*v).data.objspecvalue;
01723             
01724             break;
01725         
01726         case binaryvaluetype:
01727             if (!coercebinaryval (v, objspecvaluetype, 0L, objspecvaluetype))
01728                 return (false);
01729             
01730             x = (*v).data.objspecvalue;
01731             
01732             if (gethandlesize (x) == 0) { /*null spec; special case*/
01733                 
01734                 releaseheaptmp (x);
01735                 
01736                 x = nil;
01737                 }
01738             
01739             break;
01740         
01741         case recordvaluetype: {
01742             
01743             AEDesc desc;
01744             
01745             if (!langipcconvertoplist (v, &desc))
01746                 return (false);
01747             
01748             if (oserror (AECoerceDesc (&desc, typeObjectSpecifier, obj)))
01749                 return (false);
01750             
01751             exemptfromtmpstack (v);
01752             
01753             return (true);
01754             }
01755         
01756         case ostypevaluetype:
01757             id = (*v).data.ostypevalue;
01758             
01759             getdefaultcontainer (nulltype, &containerdesc, true);
01760             
01761             if (id == typeObjectBeingExamined) /*special "it" value*/
01762                 return (!oserror (AEDuplicateDesc (&containerdesc, obj)));
01763             
01764             return (createpropertyspecifier (&containerdesc, id, obj));
01765         
01766         default:
01767             if ((*v).data.longvalue == 0) { /*a nil value -- special case*/
01768                 
01769                 x = nil;
01770                 
01771                 break;
01772                 }
01773             
01774             langcoerceerror (v, objspecvaluetype);
01775             
01776             return (false);
01777         } /*switch*/
01778     
01779     (*obj).dataHandle = x;
01780     
01781     if (x == nil) {
01782         
01783         (*obj).descriptorType = typeNull; /*don't use nulltype here; nil spec is always typeNull*/
01784         }
01785     else {
01786         
01787         exemptfromtmpstack (v);
01788         
01789         (*obj).descriptorType = typeObjectSpecifier;
01790         }
01791         
01792     return (true);
01793     } /*valtoobjspec*/
01794 
01795 
01796 boolean coercetoobjspec (tyvaluerecord *v) {
01797     
01798     /*
01799     9/14/92 dmb: this guy's guts have been moved into valtoobjspec
01800     
01801     2.1b2 dmb: added missing case for list->objspec
01802     
01803     2.1b5 dmb: added support for filespec->objspec
01804     */
01805     
01806     AEDesc objectdesc;
01807     
01808     switch ((*v).valuetype) {
01809         
01810         case objspecvaluetype:
01811             return (true);
01812         
01813         case stringvaluetype:
01814             return (stringtoobjspec (v));
01815         
01816         case listvaluetype:
01817             return (coercelistvalue (v, objspecvaluetype));
01818         
01819         case filespecvaluetype:
01820             return (filespectoobjspec (v));
01821         
01822         default:
01823             if (!valtoobjspec (v, typeNull, &objectdesc))
01824                 return (false);
01825             
01826             return (setheapvalue (objectdesc.dataHandle, objspecvaluetype, v));
01827         } /*switch*/
01828     } /*coercetoobjspec*/
01829 
01830 
01831 boolean setobjspecverb (hdltreenode hparam1, tyvaluerecord *val) {
01832     
01833     /*
01834     a brute-force verb to building object specifiers.
01835     
01836     8/31/92 dmb: if the keyform isn't one of the three simple grammar forms, 
01837     assume that the script writer is trying to do a custom keyform, and 
01838     take the keydata literally. with this change, setobj continues to offer 
01839     functionality that isn't otherwise available.
01840     */
01841     
01842     OSType class;
01843     tyvaluerecord container;
01844     OSType keyform;
01845     long longkey;
01846     bigstring bskey;
01847     OSType propkey;
01848     tyvaluerecord customkey;
01849     AEDesc containerdesc;
01850     AEDesc keydatadesc;
01851     AEDesc objspecdesc;
01852     OSErr errcode = noErr;
01853     
01854     
01855     #ifdef flsystem6
01856     
01857     if (!langcanuseappleevents ())
01858         return (false);
01859     
01860     #endif
01861     
01862     if (!getostypevalue (hparam1, 1, &class))
01863         return (false);
01864     
01865     if (!getobjspecparam (hparam1, 2, &container))
01866         return (false);
01867     
01868     if (!getostypevalue (hparam1, 3, &keyform))
01869         return (false);
01870     
01871     flnextparamislast = true;
01872     
01873     switch (keyform) {
01874         
01875         case formName:
01876             if (!getstringvalue (hparam1, 4, bskey))
01877                 return (false);
01878             
01879             errcode = AECreateDesc (typeChar, (Ptr) bskey + 1, (long) stringlength (bskey), &keydatadesc);
01880             
01881             break;
01882         
01883         case formAbsolutePosition:
01884             if (!getlongvalue (hparam1, 4, &longkey))
01885                 return (false);
01886             
01887             errcode = AECreateDesc (typeLongInteger, (Ptr) &longkey, longsizeof (longkey), &keydatadesc);
01888             
01889             break;
01890         
01891         case formPropertyID:
01892             if (!getostypevalue (hparam1, 4, &propkey))
01893                 return (false);
01894             
01895             errcode = AECreateDesc (typeType, (Ptr) &propkey, longsizeof (propkey), &keydatadesc);
01896             
01897             break;
01898         
01899         default:
01900             if (!getparamvalue (hparam1, 4, &customkey))
01901                 return (false);
01902             
01903             if (!valuetodescriptor (&customkey, &keydatadesc)) /*consumes customkey*/
01904                 return (false);
01905             
01906             break;
01907             
01908         }
01909     
01910     if (oserror (errcode))
01911         return (false);
01912     
01913     setupdescriptor (container.data.objspecvalue, &containerdesc);
01914     
01915     errcode = CreateObjSpecifier (class, &containerdesc, keyform, &keydatadesc, false, &objspecdesc);
01916     
01917     AEDisposeDesc (&keydatadesc);
01918     
01919     if (oserror (errcode))
01920         return (false);
01921     
01922     return (setheapvalue (objspecdesc.dataHandle, objspecvaluetype, val));
01923     } /*setobjspecverb*/
01924 
01925 
01926 static boolean getclassvalue (hdltreenode htree, OSType *class) {
01927     
01928     tyvaluerecord val;
01929     
01930     if ((**htree).nodetype == bracketop) /*shed brackets if present*/
01931         htree = (**htree).param1;
01932     
01933     if (!evaluatetree (htree, &val))
01934         return (false);
01935     
01936     if (!coercetoostype (&val))
01937         return (false);
01938     
01939     *class = val.data.ostypevalue;
01940     
01941     return (true);
01942     } /*getclassvalue*/
01943 
01944 
01945 static boolean evaluateobject (hdltreenode htree, OSType nulltype, AEDesc *objectdesc); /*forward*/
01946 
01947 
01948 static boolean evaluateproperty (hdltreenode htree, OSType nulltype, AEDesc *objectdesc) {
01949     
01950     /*
01951     1/25/93 dmb: keep track of tmps and dispose if created (to avoid tmpstack overflow)
01952     */
01953     
01954     register hdltreenode h = htree;
01955     register hdltreenode hp1;
01956     register tytreetype op;
01957     AEDesc containerdesc;
01958     OSType propkey;
01959     boolean fltmp = false;
01960     
01961     assert (h != nil);
01962     
01963     langseterrorline (h); /*set globals for error reporting*/
01964     
01965     op = (**h).nodetype; /*copy into register*/
01966     
01967     hp1 = (**h).param1;
01968     
01969     switch (op) {
01970         
01971         case identifierop:
01972         case bracketop:
01973             if (!getclassvalue (h, &propkey))
01974                 return (false);
01975             
01976             getdefaultcontainer (nulltype, &containerdesc, true);
01977             
01978             break;
01979         
01980         case dotop:
01981             if (!evaluateobject ((**h).param1, nulltype, &containerdesc)) /*daisy-chain recursion*/
01982                 return (false);
01983             
01984             pushtmpstack (containerdesc.dataHandle); /*until it's merged*/
01985             
01986             fltmp = true;
01987             
01988             if (!getclassvalue ((**h).param2, &propkey))
01989                 return (false);
01990             
01991             break;
01992         
01993         default:
01994             langerror (badobjectspecificationerror);
01995             
01996             return (false);
01997         }
01998     
01999     if (!createpropertyspecifier (&containerdesc, propkey, objectdesc))
02000         return (false);
02001     
02002     if (fltmp)
02003         releaseheaptmp (containerdesc.dataHandle);
02004     
02005     return (true);
02006     } /*evaluateproperty*/
02007 
02008 
02009 static boolean evaluatesimplekey (hdltreenode htree, OSType *keyform, AEDesc *keydatadesc) {
02010     
02011     /*
02012     8/10/92 dmb: fixed constants for formRelativePosition specifiers
02013     */
02014     
02015     bigstring bskey;
02016     DescType type;
02017     long longkey;
02018     tyvaluerecord keyval;
02019     OSErr errcode;
02020     
02021     if (!evaluatetree (htree, &keyval))
02022         return (false);
02023     
02024     switch (keyval.valuetype) {
02025         
02026         case stringvaluetype:
02027             pullstringvalue (&keyval, bskey);
02028             
02029             errcode = AECreateDesc (typeChar, (Ptr) bskey + 1, (long) stringlength (bskey), keydatadesc);
02030             
02031             *keyform = formName;
02032             
02033             break;
02034         
02035         case ostypevaluetype:
02036             longkey = (long) keyval.data.ostypevalue;
02037             
02038             if ((longkey == kAENext) || (longkey == kAEPrevious)) {
02039                 
02040                 type = typeEnumeration;
02041                 
02042                 *keyform = formRelativePosition;
02043                 }
02044             else {
02045                 
02046                 type = typeAbsoluteOrdinal;
02047                 
02048                 *keyform = formAbsolutePosition;
02049                 }
02050             
02051             errcode = AECreateDesc (type, (Ptr) &longkey, longsizeof (longkey), keydatadesc);
02052             
02053             break;
02054         
02055         default:
02056             if (!coercetolong (&keyval))
02057                 return (false);
02058             
02059             longkey = keyval.data.longvalue;
02060             
02061             errcode = AECreateDesc (typeLongInteger, (Ptr) &longkey, longsizeof (longkey), keydatadesc);
02062             
02063             *keyform = formAbsolutePosition;
02064             
02065             break;
02066         }
02067     
02068     return (!oserror (errcode));
02069     } /*evaluatesimplekey*/
02070 
02071 
02072 static boolean evaluatefield (hdltreenode htree, OSType *key, AEDesc *data) {
02073     
02074     /*
02075     3/23/93 dmb: htree is a x:y field specification. return the field key, 
02076     and the field data as a descriptor record whose dataHandle is not on the 
02077     temp stack.
02078     */
02079     
02080     register hdltreenode h = htree;
02081     tyvaluerecord keyval;
02082     tyvaluerecord itemval;
02083     
02084     assert ((**h).nodetype == fieldop);
02085     
02086     if (!evaluatetree ((**h).param1, &keyval))
02087         return (false);
02088     
02089     if (!coercetoostype (&keyval))
02090         return (false);
02091     
02092     if (!evaluatetree ((**h).param2, &itemval))
02093         return (false);
02094     
02095     if (!valuetodescriptor (&itemval, data)) /*consumes itemval*/
02096         return (false);
02097     
02098     *key = keyval.data.ostypevalue;
02099     
02100     return (true);
02101     } /*evaluatefield*/
02102 
02103 
02104 static boolean evaluatecustomkey (hdltreenode htree, OSType *keyform, AEDesc *keydatadesc) {
02105     
02106     /*
02107     3/23/93 dmb: a custom key looks like a single field in a record, 
02108     an x:y field specification. our job is to return the keyform and keydata, without anything on 
02109     the temp stack
02110     */
02111     
02112     if (!evaluatefield (htree, keyform, keydatadesc))
02113         return (false);
02114     
02115     /*
02116     removeheaptmp ((*keydatadesc).dataHandle);
02117     */
02118     
02119     return (true);
02120     } /*evaluatecustomkey*/
02121 
02122 
02123 static boolean evaluatecomparison (hdltreenode htree, DescType operator, AEDesc *keydatadesc) {
02124     
02125     /*
02126     1/25/93 dmb: dispose tmps (to avoid tmpstack overflow)
02127     */
02128     
02129     register hdltreenode h = htree;
02130     AEDesc objectdesc;
02131     tyvaluerecord val;
02132     AEDesc valdesc;
02133     OSErr errcode;
02134     
02135     if (!evaluateobject ((**h).param1, typeObjectBeingExamined, &objectdesc))
02136         return (false);
02137     
02138     pushtmpstack (objectdesc.dataHandle); /*until it's merged*/
02139     
02140     if (!evaluatetree ((**h).param2, &val))
02141         return (false);
02142     
02143     if (!valuetodescriptor (&val, &valdesc))
02144         return (false);
02145     
02146     errcode = CreateCompDescriptor (operator, &objectdesc, &valdesc, false, keydatadesc);
02147     
02148     releaseheaptmp (objectdesc.dataHandle); /*keep tmpstack cleared out*/
02149     
02150     AEDisposeDesc (&valdesc);
02151     
02152     return (!oserror (errcode));
02153     } /*evaluatecomparison*/
02154 
02155 
02156 static boolean evaluatetest (hdltreenode, tytreetype, AEDesc *);
02157 
02158 
02159 static boolean evaluatelogical (hdltreenode hcomp1, tytreetype op1, hdltreenode hcomp2, tytreetype op2, DescType operator, AEDesc *keydatadesc) {
02160     
02161     AEDesc compdesc1, compdesc2;
02162     AEDesc listdesc;
02163     
02164     if (oserror (AECreateList (nil, 0, false, &listdesc)))
02165         return (false);
02166     
02167     if (!evaluatetest (hcomp1, op1, &compdesc1))
02168         goto error;
02169     
02170     if (oserror (AEPutDesc (&listdesc, 0, &compdesc1)))
02171         goto error;
02172     
02173     AEDisposeDesc (&compdesc1);
02174     
02175     if (hcomp2 != nil) {
02176         
02177         if (!evaluatetest (hcomp2, op2, &compdesc2))
02178             goto error;
02179         
02180         if (oserror (AEPutDesc (&listdesc, 0, &compdesc2)))
02181             goto error;
02182         
02183         AEDisposeDesc (&compdesc2);
02184         }
02185     
02186     return (!oserror (CreateLogicalDescriptor (&listdesc, operator, true, keydatadesc)));
02187     
02188     error: {
02189         
02190         AEDisposeDesc (&listdesc);
02191         
02192         return (false);
02193         }
02194     } /*evaluatelogical*/
02195 
02196 
02197 static boolean evaluatetest (hdltreenode htree, tytreetype op, AEDesc *keydatadesc) {
02198     
02199     /*
02200     12/8/92 dmb: created this routine to dispath logical & comarison ops, so 
02201     that logical operands can in turn be any kind of test, not just comparisons. 
02202     this removes the 2-criteria limiation of the 1st release of 2.0.
02203     
02204     not: the reason that op is passed in is to support the handling of NEop, since 
02205     there is not corresponding AE comparison operator. instead, if must be forced 
02206     to EQop, and put inside of a logical NOT expression.
02207     */
02208     
02209     register hdltreenode h = htree;
02210     register DescType operator;
02211     hdltreenode hp1 = (**h).param1;
02212     
02213     if (op == noop) /*not pre-determined*/
02214         
02215         op = (**h).nodetype;
02216     
02217     switch (op) {
02218         
02219         case EQop:
02220             operator = kAEEquals;
02221             
02222             break;
02223         
02224         case GTop:
02225             operator = kAEGreaterThan;
02226             
02227             break;
02228         
02229         case LTop:
02230             operator = kAELessThan;
02231             
02232             break;
02233         
02234         case GEop:
02235             operator = kAEGreaterThanEquals;
02236             
02237             break;
02238         
02239         case LEop:
02240             operator = kAELessThanEquals;
02241             
02242             break;
02243         
02244         case beginswithop:
02245             operator = kAEBeginsWith;
02246             
02247             break;
02248         
02249         case endswithop:
02250             operator = kAEEndsWith;
02251             
02252             break;
02253         
02254         case containsop:
02255             operator = kAEContains;
02256             
02257             break;
02258         
02259         case NEop:
02260             return (evaluatelogical (h, EQop, nil, (tytreetype) 0, kAENOT, keydatadesc));
02261         
02262         case notop:
02263             return (evaluatelogical (hp1, noop, nil, (tytreetype) 0, kAENOT, keydatadesc));
02264         
02265         case andandop:
02266             return (evaluatelogical (hp1, noop, (**h).param2, (tytreetype) 0, kAEAND, keydatadesc));
02267         
02268         case ororop:
02269             return (evaluatelogical (hp1, noop, (**h).param2, (tytreetype) 0, kAEOR, keydatadesc));
02270         
02271         default:
02272             langlongparamerror (badobjectspecificationerror, (long) op);
02273             
02274             return (false);
02275         }
02276     
02277     /*common code for comarisons*/
02278     
02279     return (evaluatecomparison (h, operator, keydatadesc));
02280     } /*evaluatetest*/
02281 
02282 
02283 static boolean evaluateboundryobject (hdltreenode htree, OSType rangeclass, AEDesc *objectdesc) {
02284     
02285     register hdltreenode h = htree;
02286     OSType keyform;
02287     AEDesc containerdesc;
02288     AEDesc keydatadesc;
02289     OSErr errcode;
02290     
02291     if (isobjspectree (h))
02292         return (evaluateobject (h, typeCurrentContainer, objectdesc));
02293     
02294     if (!evaluatesimplekey (h, &keyform, &keydatadesc))
02295         return (false);
02296     
02297     containerdesc.descriptorType = typeCurrentContainer;
02298     
02299     containerdesc.dataHandle = nil;
02300     
02301     errcode = CreateObjSpecifier (rangeclass, &containerdesc, keyform, &keydatadesc, true, objectdesc);
02302     
02303     return (!oserror (errcode));
02304     } /*evaluateboundryobject*/
02305 
02306 
02307 static boolean evaluaterange (hdltreenode htree, OSType class, AEDesc *keydatadesc) {
02308     
02309     register hdltreenode h = htree;
02310     AEDesc rangedesc1, rangedesc2;
02311     OSErr errcode;
02312     
02313     if (!evaluateboundryobject ((**h).param1, class, &rangedesc1))
02314         return (false);
02315     
02316     if (!evaluateboundryobject ((**h).param2, class, &rangedesc2)) {
02317         
02318         AEDisposeDesc (&rangedesc1);
02319         
02320         return (false);
02321         }
02322     
02323     errcode = CreateRangeDescriptor (&rangedesc1, &rangedesc2, true, keydatadesc);
02324     
02325     return (!oserror (errcode));
02326     } /*evaluaterange*/
02327 
02328 
02329 static boolean evaluateelement (hdltreenode htree, OSType nulltype, OSType *elementclass, AEDesc *objectdesc) {
02330     
02331     /*
02332     9/14/92 dmb: interpret double-array operations has specifying the same class as the 
02333     container, so that:
02334         
02335         word [it beginsWith "foo"] [last]
02336         
02337     means "the last word that begins with "foo". assuming, of course, that the app 
02338     knows how to resolve such a specifier
02339     
02340     1/25/93 dmb: keep track of tmps and dispose if created (to avoid tmpstack overflow)
02341     */
02342     
02343     register hdltreenode h = htree;
02344     register hdltreenode hp1, hp2;
02345     register tytreetype op;
02346     OSType keyform;
02347     AEDesc containerdesc;
02348     AEDesc keydatadesc;
02349     OSType class;
02350     OSErr errcode;
02351     boolean fltmp = false;
02352     
02353     assert (h != nil);
02354     
02355     langseterrorline (h); /*set globals for error reporting*/
02356     
02357     op = (**h).nodetype; /*copy into register*/
02358     
02359     assert (op == arrayop);
02360     
02361     hp1 = (**h).param1;
02362     
02363     op = (**hp1).nodetype;
02364     
02365     switch (op) {
02366         
02367         case identifierop:
02368         case bracketop:
02369             if (!getclassvalue (hp1, &class))
02370                 return (false);
02371             
02372             getdefaultcontainer (nulltype, &containerdesc, false);
02373             
02374             break;
02375         
02376         case dotop:
02377             if (!evaluateobject ((**hp1).param1, nulltype, &containerdesc)) /*daisy-chain recursion*/
02378                 return (false);
02379             
02380             pushtmpstack (containerdesc.dataHandle); /*until it's merged*/
02381             
02382             fltmp = true;
02383             
02384             if (!getclassvalue ((**hp1).param2, &class))
02385                 return (false);
02386             
02387             break;
02388         
02389         case arrayop:
02390             if (!evaluateelement (hp1, nulltype, &class, &containerdesc))
02391                 return (false);
02392             
02393             pushtmpstack (containerdesc.dataHandle); /*until it's merged*/
02394             
02395             fltmp = true;
02396             
02397             break;
02398         
02399         default:
02400             langlongparamerror (badobjectspecificationerror, (long) op);
02401             
02402             return (false);
02403         }
02404     
02405     hp2 = (**h).param2;
02406     
02407     op = (**hp2).nodetype;
02408     
02409     switch (op) {
02410         
02411         case EQop:
02412         case GTop:
02413         case LTop:
02414         case GEop:
02415         case LEop:
02416         case beginswithop:
02417         case endswithop:
02418         case containsop:
02419         case NEop:
02420         case notop:
02421         case andandop:
02422         case ororop:
02423             if (!evaluatetest (hp2, op, &keydatadesc))
02424                 return (false);
02425             
02426             keyform = formTest;
02427             
02428             break;
02429         
02430         case rangeop:
02431             if (!evaluaterange (hp2, class, &keydatadesc))
02432                 return (false);
02433             
02434             keyform = formRange;
02435             
02436             break;
02437         
02438         case fieldop:
02439             if (!evaluatecustomkey (hp2, &keyform, &keydatadesc))
02440                 return (false);
02441             
02442             break;
02443         
02444         default:
02445             if (!evaluatesimplekey (hp2, &keyform, &keydatadesc))
02446                 return (false);
02447             
02448             break;
02449         }
02450     
02451     errcode = CreateObjSpecifier (class, &containerdesc, keyform, &keydatadesc, false, objectdesc);
02452     
02453     if (fltmp)
02454         releaseheaptmp (containerdesc.dataHandle);
02455     
02456     AEDisposeDesc (&keydatadesc);
02457     
02458     *elementclass = class;
02459     
02460     return (!oserror (errcode));
02461     } /*evaluateelement*/
02462 
02463 
02464 static boolean evaluateobject (hdltreenode htree, OSType nulltype, AEDesc *objectdesc) {
02465     
02466     /*
02467     evaluate an object specifier code tree
02468     
02469     3/18/93 dmb: added stack space check
02470     */
02471     
02472     register hdltreenode h = htree;
02473     register tytreetype op;
02474     OSType class;
02475     tyvaluerecord val;
02476     
02477     if (fllangerror) { /*a language error dialog has appeared, unwind*/
02478         
02479         return (false); /*return false, aid in the unwinding process*/
02480         }
02481     
02482     if (!langcheckstackspace ())
02483         return (false);
02484     
02485     assert (h != nil);
02486     
02487     op = (**h).nodetype; /*copy into register*/
02488     
02489     /*langseterrorline (h); /*set globals for error reporting*/
02490     
02491     switch (op) {
02492         
02493         case identifierop:
02494             if (!evaluatetree (h, &val))
02495                 return (false);
02496             
02497             if (!valtoobjspec (&val, nulltype, objectdesc))
02498                 return (false);
02499             
02500             break;
02501             
02502         case bracketop:
02503             if (!evaluatetree ((**h).param1, &val))
02504                 return (false);
02505             
02506             if (!valtoobjspec (&val, nulltype, objectdesc))
02507                 return (false);
02508             
02509             break;
02510         
02511         case dotop:
02512             if (!evaluateproperty (h, nulltype, objectdesc))
02513                 return (false);
02514             
02515             break;
02516         
02517         case arrayop:
02518             if (!evaluateelement (h, nulltype, &class, objectdesc))
02519                 return (false);
02520             
02521             break;
02522         
02523         default:
02524             langlongparamerror (badobjectspecificationerror, (long) op);
02525             
02526             return (false);
02527         }
02528     
02529     return (true);
02530     } /*evaluateobject*/
02531 
02532 
02533 boolean evaluateobjspec (hdltreenode htree, tyvaluerecord *vreturned) {
02534     
02535     AEDesc objectdesc;
02536     
02537     if (!evaluateobject (htree, typeNull, &objectdesc))
02538         return (false);
02539     
02540     return (setheapvalue (objectdesc.dataHandle, objspecvaluetype, vreturned));
02541     } /*evaluateobjspec*/
02542 
02543 
02544 static boolean getidvalue (hdltreenode htree, tyvaluerecord *val) {
02545     
02546     /*
02547     just like idvalue, but we don't make a copy
02548     
02549     2.1b2 dmb: dive into bracketops to more closely simulate objspec evaluation
02550     
02551     7.2.97 dmb: prevent extended symbol searching in langgetsymbolval
02552     */
02553     
02554     register hdltreenode h = htree;
02555     bigstring bs;
02556     hdlhashtable htable;
02557     boolean fl = false;
02558     hdlhashnode hnode;
02559     
02560     switch ((**h).nodetype) {
02561         
02562         case bracketop: /*look for string4 literal only*/
02563             
02564             h = (**h).param1;
02565             
02566             if ((**h).nodetype != constop)
02567                 break;
02568             
02569             *val = (**h).nodeval;
02570             
02571             fl = true;
02572             
02573             break;
02574         
02575         case identifierop:
02576             
02577             if (!langgetidentifier (h, bs))
02578                 break;
02579             
02580             langsearchpathlookup (bs, &htable);
02581             
02582             pushhashtable (htable);
02583             
02584             fl = langgetsymbolval (bs, val, &hnode);
02585             
02586             pophashtable ();
02587             
02588             break;
02589         
02590         default:
02591             break;
02592         }
02593     
02594     return (fl);
02595     } /*getidvalue*/
02596 
02597 
02598 boolean isobjspectree (hdltreenode htree) {
02599     
02600     /*
02601     determine whether the given code tree appears to be an object specification.
02602     
02603     at this point we're observing the following rule: an objspec expression may 
02604     be a dotted id or an array operation (which yeild properties & elements 
02605     respectively), and the root of the tree must be an objspec or a string4 (a 
02606     class id).  any such expression is likely to be intended as an objspec, and 
02607     will certainly fail when evaluated normally.
02608     
02609     note that the objspec verb can always be used to force an expression to be 
02610     evaluated as an object specifier.
02611     
02612     also note that we don't call idvalue at the end to avoid creating a copy of 
02613     the value record.
02614     
02615     special note: for performance, we currently assume that we're only being called 
02616     by dotvalue and arrayvalue, so we can go directly to param1.
02617     
02618     1/13/93 dmb: if param2 of a dotop is an undefined identifier, keep scanning so 
02619     param1 can be checked. this allows the appropriate error message to be generated.
02620     */
02621     
02622     register hdltreenode h = htree;
02623     register tytreetype op;
02624     tyvaluerecord val;
02625     
02626     while (true) {
02627         
02628         op = (**h).nodetype;
02629         
02630         switch (op) {
02631             
02632             case dotop: { /*verify current dot node, then continue scanning tree*/
02633                 
02634                 register hdltreenode hp2 = (**h).param2;
02635                 
02636                 if (true /*(**hp2).nodetype == identifierop*/) { /*a node we can check quickly w/no side-effects*/
02637                     
02638                     if (getidvalue (hp2, &val)) {
02639                         
02640                         if (val.valuetype != ostypevaluetype)
02641                             return (false);
02642                         }
02643                     }
02644                 
02645                 break;
02646                 }
02647             
02648             case arrayop: /*continue scanning tree*/
02649                 break;
02650             
02651             case bracketop:
02652             case identifierop:
02653                 if (!getidvalue (h, &val))
02654                     return (false);
02655                 
02656                 return ((val.valuetype == objspecvaluetype) || (val.valuetype == ostypevaluetype));
02657                 
02658             default:
02659                 return (false);
02660             }
02661         
02662         h = (**h).param1;
02663         }
02664     } /*isobjspectree*/
02665 
02666 
02667 #ifndef oplanglists
02668 
02669 boolean makelistvalue (hdltreenode htree, tyvaluerecord *vreturned) {
02670     
02671     /*
02672     4/1/93 dmb: don't cleartmpstack here -- we might be creating a value in 
02673     an expression. just take care of what we create.
02674     */
02675     
02676     register hdltreenode h;
02677     tyvaluerecord itemval;
02678     AEDesc itemdesc;
02679     AEDesc listdesc;
02680     OSErr err;
02681     
02682     if (oserror (AECreateList (nil, 0, false, &listdesc)))
02683         return (false);
02684     
02685     for (h = htree; h != nil; h = (**h).link) { /*process each expression in the list*/
02686         
02687         if (!evaluatetree (h, &itemval))
02688             goto error;
02689         
02690         if (!valuetodescriptor (&itemval, &itemdesc))
02691             goto error;
02692         
02693         err = AEPutDesc (&listdesc, 0, &itemdesc);
02694         
02695         AEDisposeDesc (&itemdesc);
02696         
02697         if (oserror (err))
02698             goto error;
02699         }
02700     
02701     return (setheapvalue (listdesc.dataHandle, listvaluetype, vreturned));
02702     
02703     error: {
02704         
02705         AEDisposeDesc (&listdesc);
02706         
02707         return (false);
02708         }
02709     } /*makelistvalue*/
02710 
02711 
02712 boolean makerecordvalue (hdltreenode htree, tyvaluerecord *vreturned) {
02713     
02714     /*
02715     4/1/93 dmb: don't cleartmpstack here -- we might be creating a value in 
02716     an expression. just take care of what we create.
02717     */
02718     
02719     register hdltreenode h;
02720     OSType key;
02721     AEDesc itemdesc;
02722     AEDesc listdesc;
02723     OSErr err;
02724     
02725     if (oserror (AECreateList (nil, 0, true, &listdesc)))
02726         return (false);
02727     
02728     for (h = htree; h != nil; h = (**h).link) { /*process each expression in the list*/
02729         
02730         if (!evaluatefield (h, &key, &itemdesc))
02731             goto error;
02732         
02733         err = AEPutKeyDesc (&listdesc, key, &itemdesc);
02734         
02735         AEDisposeDesc (&itemdesc);
02736         
02737         if (oserror (err))
02738             goto error;
02739         }
02740     
02741     return (setheapvalue (listdesc.dataHandle, recordvaluetype, vreturned));
02742     
02743     error: {
02744         
02745         AEDisposeDesc (&listdesc);
02746         
02747         return (false);
02748         }
02749     } /*makerecordvalue*/
02750 
02751 
02752 static void listvaltodesc (const tyvaluerecord *val, AEDesc *desc) {
02753     
02754     (*desc).dataHandle = (*val).data.listvalue;
02755     
02756     if ((*val).valuetype == listvaluetype)
02757         (*desc).descriptorType = typeAEList;
02758     else
02759         (*desc).descriptorType = typeAERecord;
02760     } /*listvaltodesc*/
02761 
02762 
02763 boolean langgetlistsize (const tyvaluerecord *vlist, long *size) {
02764     
02765     AEDesc desc;
02766     
02767     listvaltodesc (vlist, &desc);
02768     
02769     return (!oserror (AECountItems (&desc, size)));
02770     } /*langgetlistsize*/
02771 
02772 
02773 static boolean getnthlistval (const AEDesc *listdesc, long n, OSType *pkey, tyvaluerecord *val) {
02774     
02775     AEDesc itemdesc;
02776     
02777     if (oserror (AEGetNthDesc (listdesc, n, typeWildCard, pkey, &itemdesc)))
02778         return (false);
02779     
02780     return (setdescriptorvalue (itemdesc, val));
02781     } /*getnthlistval*/
02782 
02783 
02784 boolean langgetlistitem (const tyvaluerecord *vlist, long ix, OSType *pkey, tyvaluerecord *vitem) {
02785     
02786     /*
02787     6/17/93 dmb: pass the key informatino on through
02788     */
02789     
02790     AEDesc desc;
02791     
02792     listvaltodesc (vlist, &desc);
02793     
02794     return (getnthlistval (&desc, ix, pkey, vitem));
02795     } /*langgetlistitem*/
02796 
02797 
02798 static boolean listtostring (const AEDesc *listdesc, tyvaluerecord *val) {
02799     
02800     /*
02801     12/22/92 dmb: starter version: 255-char limit
02802     
02803     4/2/93 dmb: next version: 255-char limit for individual items only.
02804     */
02805     
02806     long i, n;
02807     OSType key;
02808     AEDesc itemdesc;
02809     tyvaluerecord itemval;
02810     bigstring bs;
02811     Handle hlist;
02812     
02813     if (oserror (AECountItems (listdesc, &n)))
02814         return (false);
02815     
02816     if (!newtexthandle ("\p{", &hlist))
02817         return (false);
02818     
02819     for (i = 1; i <= n; ++i) {
02820         
02821         if (oserror (AEGetNthDesc (listdesc, i, typeWildCard, &key, &itemdesc)))
02822             goto error;
02823         
02824         if (!setdescriptorvalue (itemdesc, &itemval))
02825             goto error;
02826         
02827         if ((*listdesc).descriptorType == typeAERecord) {
02828             
02829             getostypedisplaystring (key, bs);
02830             
02831             pushchar (':', bs);
02832             
02833             pushtexthandle (bs, hlist);
02834             }
02835         
02836         if (!getobjectmodeldisplaystring (&itemval, bs)) /*max 253 characters*/
02837             goto error;
02838         
02839         disposevaluerecord (itemval, true); /*don't clog temp stack*/
02840         
02841         if (i < n)
02842             pushstring ("\p, ", bs);
02843         
02844         if (!pushtexthandle (bs, hlist))
02845             goto error;
02846         }
02847     
02848     if (!pushtexthandle ("\p}", hlist))
02849         goto error;
02850     
02851     return (setheapvalue (hlist, stringvaluetype, val));
02852     
02853     error:
02854     
02855     disposehandle (hlist);
02856     
02857     return (false);
02858     } /*listtostring*/
02859 
02860 
02861 static boolean makeintegerlist (tyvaluerecord *v, tyvaluetype listtype, void *pints, short ctints, AEDesc *intlist) {
02862     
02863     /*
02864     2.1b2 dmb: create a list containing the short integers in the pints array 
02865     
02866     2.1b8 dmb: for now, disallow coercion to record. later, we might have 
02867     an array of keys for each type.
02868     */
02869     
02870     register short *pi = (short *) pints;
02871     boolean flrecord = listtype == recordvaluetype;
02872     
02873     if (flrecord) {
02874         
02875         langcoerceerror (v, listtype);
02876         
02877         return (false);
02878         }
02879     
02880     if (oserror (AECreateList (nil, 0, flrecord, intlist)))
02881         return (false);
02882     
02883     while (--ctints >= 0) { /*process each int in the array*/
02884         
02885         if (oserror (AEPutPtr (intlist, 0, typeShortInteger, (Ptr) pi++, sizeof (short)))) {
02886             
02887             AEDisposeDesc (intlist);
02888             
02889             return (false);
02890             }
02891         }
02892     
02893     return (true);
02894     } /*makeintegerlist*/
02895 
02896 
02897 static boolean pullintegerlist (AEDesc *intlist, short ctints, void *pints) {
02898     
02899     /*
02900     2.1b2 dmb: pull out the array of short integers from the list
02901     */
02902     
02903     register short *pi = (short *) pints;
02904     long ctitems;
02905     long n;
02906     OSType key;
02907     OSType type;
02908     long size;
02909     
02910     if (oserror (AECountItems (intlist, &ctitems)))
02911         return (false);
02912     
02913     if (ctitems < ctints) {
02914         
02915         langlongparamerror (listcoerceerror, ctints);
02916         
02917         return (false);
02918         }
02919     
02920     for (n = 1; n <= ctints; ++n) { /*grab each int in the list*/
02921         
02922         if (oserror (AEGetNthPtr (intlist, n, typeShortInteger, &key, &type, (Ptr) pi++, sizeof (short), &size)))
02923             return (false);
02924         }
02925     
02926     return (true);
02927     } /*pullintegerlist*/
02928 
02929 
02930 static Point swappoint (Point pt) {
02931     
02932     short temp = pt.h;
02933     
02934     pt.h = pt.v;
02935     
02936     pt.v = temp;
02937     
02938     return (pt);
02939     } /*swappoint*/
02940 
02941 
02942 static boolean stringtolist (tyvaluerecord *val, tyvaluetype type) {
02943     
02944     /*
02945     4.1b2 dmb: if a string is actually a list expression, that's what 
02946     this coercion should yield.
02947     */
02948     
02949     Handle htext;
02950     hdltreenode hmodule;
02951     boolean fl = false;
02952     unsigned short savelines;
02953     unsigned short savechars;
02954     
02955     if (gethandlesize ((*val).data.stringvalue) == 0) { /*empty string -> null list*/
02956         
02957         disposevaluerecord (*val, true);
02958         
02959         if (type == listvaluetype)
02960             return (makelistvalue (nil, val));
02961         else
02962             return (makerecordvalue (nil, val));
02963         }
02964     
02965     if (!copyhandle ((*val).data.stringvalue, &htext))
02966         return (false);
02967     
02968     savelines = ctscanlines;
02969     
02970     savechars = ctscanchars;
02971     
02972     disablelangerror ();
02973     
02974     fl = langcompiletext (htext, false, &hmodule); /*always disposes htext*/
02975     
02976     enablelangerror ();
02977     
02978     if (fl) {
02979         
02980         register hdltreenode h = (**hmodule).param1;
02981         register tytreetype op = (**h).nodetype;
02982         
02983         if (type == listvaluetype)
02984             fl = op == listop;
02985         else
02986             fl = op == recordop;
02987         
02988         if (fl) {
02989             
02990             disposevaluerecord (*val, true);
02991             
02992             disablelangerror (); /*we'll generate own error w/correct position*/
02993             
02994             fl = evaluatetree (h, val);
02995             
02996             enablelangerror ();
02997             }
02998         
02999         langdisposetree (hmodule);
03000         }
03001     
03002     ctscanlines = savelines;
03003     
03004     ctscanchars = savechars;
03005     
03006     return (fl);
03007     } /*stringtolist*/
03008 
03009 
03010 boolean coercetolist (tyvaluerecord *val, tyvaluetype type) {
03011     
03012     /*
03013     4/14/93 dmb: support list <-> record coercion when empty, but don't allow 
03014     it otherwise
03015     
03016     2.1b8 dmb: coercing a list to a record creates a true record
03017     
03018     4.1b2 dmb: use stringtolist for string values
03019     */
03020     
03021     register tyvaluerecord *v = val;
03022     register tyvaluetype vtype = (*v).valuetype;
03023     AEDesc valdesc;
03024     AEDesc listdesc;
03025     long size;
03026     OSErr errcode;
03027     
03028     if (vtype == type)
03029         return (true);
03030     
03031     switch (vtype) {
03032         
03033         case novaluetype:
03034             if (flinhibitnilcoercion)
03035                 return (false);
03036             
03037             if (type == listvaluetype)
03038                 return (makelistvalue (nil, v));
03039             else
03040                 return (makerecordvalue (nil, v));
03041         
03042         case externalvaluetype:
03043             langbadexternaloperror (badexternaloperationerror, *v);
03044             
03045             return (false);
03046         
03047         case listvaluetype:
03048         case recordvaluetype:
03049             if (!langgetlistsize (v, &size))
03050                 return (false);
03051             
03052             if (size > 0) {
03053                 
03054                 langcoerceerror (v, type);
03055                 
03056                 return (false);
03057                 }
03058             
03059             if (oserror (AECreateList (nil, 0, type == recordvaluetype, &listdesc)))
03060                 return (false);
03061             
03062             break;
03063         
03064         case pointvaluetype: {
03065             Point pt = swappoint ((*v).data.pointvalue);
03066             
03067             if (!makeintegerlist (v, type, &pt, 2, &listdesc))
03068                 return (false);
03069             
03070             break;
03071             }
03072         
03073         case rgbvaluetype: {
03074             RGBColor rgb = **(*v).data.rgbvalue;
03075             
03076             if (!makeintegerlist (v, type, &rgb, 3, &listdesc))
03077                 return (false);
03078             
03079             break;
03080             }
03081         
03082         case rectvaluetype: {
03083             Rect r = **(*v).data.rectvalue;
03084             
03085             if (!makeintegerlist (v, type, &r, 4, &listdesc))
03086                 return (false);
03087             
03088             break;
03089             }
03090         
03091         case stringvaluetype:
03092             
03093             if (stringtolist (v, type))
03094                 return (true);
03095             
03096             /*else fall through...*/
03097         
03098         default:
03099             if (!coercetobinary (v))
03100                 return (false);
03101             
03102             binarytodesc ((*v).data.binaryvalue, &valdesc);
03103             
03104             errcode = AECoerceDesc (&valdesc, langgettypeid (type), &listdesc);
03105             
03106             if (errcode != noErr) {
03107                 
03108                 if (errcode == errAECoercionFail) {
03109                     
03110                     coercevalue (v, vtype); /*back to it's original type for the error message*/
03111                     
03112                     langcoerceerror (v, type);
03113                     }
03114                 else
03115                     oserror (errcode);
03116                 
03117                 return (false);
03118                 }
03119             
03120             break;
03121         }
03122     
03123     disposevaluerecord (*v, true);
03124     
03125     return (setheapvalue (listdesc.dataHandle, type, v));
03126     } /*coercetolist*/
03127 
03128 
03129 static boolean coercelistcontents (tyvaluerecord *val, tyvaluetype totype, AEDesc *listdesc, long ctitems) {
03130     
03131     /*
03132     4.0b7 dmb:  when list->totype coercion otherwise fails, we try to coerce each item 
03133     in the list to totype. if we success, we'll return true even though the value we 
03134     return will still be a list, not a totype value. since this used to be a failure 
03135     case, it can't break working scripts. but it means that glue scripts can coerce to
03136     objspec, alias, or whatever and still allow a list of those items be pass through.
03137     */
03138     
03139     short ix;
03140     OSErr errcode;
03141     
03142     for (ix = 1; ix <= ctitems; ++ix) {
03143 
03144         tyvaluerecord itemval;
03145         AEDesc itemdesc;
03146         OSType key;
03147         
03148         if (!getnthlistval (listdesc, ix, &key, &itemval))
03149             return (false);
03150         
03151         if (!coercevalue (&itemval, totype))
03152             return (false);
03153         
03154         if (!valuetodescriptor (&itemval, &itemdesc))   // steals handle
03155             return (false);
03156     
03157         errcode = AEPutDesc (listdesc, ix, &itemdesc);  // merge handle into list
03158         
03159         AEDisposeDesc (&itemdesc);
03160         
03161         if (oserror (errcode))
03162             return (false);
03163         }
03164     
03165     return (true);
03166     } /*coercelistcontents*/
03167 
03168 
03169 boolean coercelistvalue (tyvaluerecord *val, tyvaluetype totype) {
03170     
03171     /*
03172     2.1b6 dmb: coercing a list to a boolean indicates whether or not the 
03173     list is empty, except when the list contains a single, boolean item.
03174     
03175     2.1b8 dmb: for a single-item list, try to coerce item to desired type, 
03176     instead of requiring the the type already match
03177     */
03178     
03179     register tyvaluerecord *v = val;
03180     AEDesc listdesc;
03181     long ctitems;
03182     tyvaluerecord itemval;
03183     
03184     if (totype == (*v).valuetype)
03185         return (true);
03186     
03187     listvaltodesc (v, &listdesc);
03188     
03189     switch (totype) {
03190         
03191         case listvaluetype: {
03192             AEDesc desc;
03193             
03194             if (oserror (AECoerceDesc (&listdesc, typeAEList, &desc)))
03195                 return (false);
03196             
03197             if (!setheapvalue (desc.dataHandle, totype, v))
03198                 return (false);
03199             
03200             break;
03201             }
03202         
03203         case stringvaluetype:
03204             if (!listtostring (&listdesc, v))
03205                 return (false);
03206             
03207             break;
03208         
03209         case binaryvaluetype:
03210             return (coercetobinary (v));
03211         
03212         case pointvaluetype: {
03213             Point pt;
03214             
03215             if (!pullintegerlist (&listdesc, 2, &pt))
03216                 return (false);
03217             
03218             if (!setpointvalue (swappoint (pt), v))
03219                 return (false);
03220             
03221             break;
03222             }
03223         
03224         case rgbvaluetype: {
03225             RGBColor rgb = **(*v).data.rgbvalue;
03226             
03227             if (!pullintegerlist (&listdesc, 3, &rgb))
03228                 return (false);
03229             
03230             if (!newheapvalue (&rgb, sizeof (rgb), rgbvaluetype, v))
03231                 return (false);
03232             
03233             break;
03234             }
03235         
03236         case rectvaluetype: {
03237             Rect r = **(*v).data.rectvalue;
03238             
03239             if (!pullintegerlist (&listdesc, 4, &r))
03240                 return (false);
03241             
03242             if (!newheapvalue (&r, sizeof (r), rectvaluetype, v))
03243                 return (false);
03244             
03245             break;
03246             }
03247         
03248         default:
03249             if (oserror (AECountItems (&listdesc, &ctitems)))
03250                 return (false);
03251             
03252             if (ctitems == 1) {
03253                 
03254                 OSType key;
03255                 
03256                 if (!getnthlistval (&listdesc, 1, &key, &itemval))
03257                     return (false);
03258                 
03259                 if (coercevalue (&itemval, totype)) {
03260                     
03261                     disposevaluerecord (*v, true);
03262                     
03263                     *v = itemval;
03264                     
03265                     return (true);
03266                     }
03267                 
03268                 return (false);
03269                 }
03270             
03271             if (totype == booleanvaluetype) {
03272                 
03273                 if (!setbooleanvalue (ctitems > 0, v))
03274                     return (false);
03275                 
03276                 break;
03277                 }
03278             
03279             /*
03280             langcoerceerror (v, totype);
03281             
03282             return (false);
03283             */
03284             return (coercelistcontents (v, totype, &listdesc, ctitems));    // 4.0b7 dmb
03285         }
03286     
03287     releaseheaptmp (listdesc.dataHandle);
03288     
03289     return (true);
03290     } /*coercelistvalue*/
03291 
03292 
03293 static boolean equalsublists (AEDesc *list1, AEDesc *list2, long ixcompare, long ctcompare, boolean flbykey) {
03294     
03295     /*
03296     compare the sublist of list1 starting at ixcompare with list2.  if flbykey, 
03297     order doesn't matter and ixcompare is ignored.  ctcompare is expected to be 
03298     the size of list2
03299     */
03300     
03301     register AEDesc *d1 = list1;
03302     register AEDesc *d2 = list2;
03303     register long ix;
03304     register long n = ctcompare;
03305     AEDesc item1;
03306     AEDesc item2;
03307     OSErr err;
03308     OSType key1;
03309     OSType key2;
03310     boolean fl = true;
03311     
03312     for (ix = 1; ix <= n; ++ix) {
03313         
03314         if (oserror (AEGetNthDesc (d2, ix, typeWildCard, &key1, &item2)))
03315             return (false);
03316         
03317         if (flbykey) {
03318             
03319             err = AEGetKeyDesc (d1, key1, typeWildCard, &item1);
03320             
03321             key2 = key1;
03322             }
03323         else
03324             err = AEGetNthDesc (d1, ix + ixcompare, typeWildCard, &key2, &item1);
03325         
03326         fl = ((err == noErr) && (key1 == key2) && equaldescriptors (&item1, &item2));
03327         
03328         AEDisposeDesc (&item1);
03329         
03330         AEDisposeDesc (&item2);
03331         
03332         if (!fl)
03333             break;
03334         }
03335     
03336     return (fl);
03337     } /*equalsublists*/
03338 
03339 
03340 boolean listaddvalue (tyvaluerecord *v1, tyvaluerecord *v2, tyvaluerecord *vreturned) {
03341     
03342     /*
03343     add the two list values. both lists should be of the same type, since langvalue 
03344     does the necessary coercion first. But if one is an AEList and the other an AERecord,
03345     the AE Manager will generate errors if appropriate.
03346     
03347     when adding records, only add fields from the 2nd record that don't already exist
03348     in the first
03349     
03350     2.1b8 dmb: initialize errcode to noErr, or random error results if adding 
03351     two records where the 1st item in record 2 is already in record 1
03352     */
03353     
03354     AEDesc desc1;
03355     AEDesc desc2;
03356     AEDesc desc3;
03357     long i, n;
03358     OSErr errcode = noErr;
03359     OSType key;
03360     AEDesc itemdesc;
03361     
03362     listvaltodesc (v1, &desc1);
03363     
03364     listvaltodesc (v2, &desc2);
03365     
03366     if (oserror (AECountItems (&desc2, &n)))
03367         return (false);
03368     
03369     if (oserror (AEDuplicateDesc (&desc1, &desc3))) /*start with first list*/
03370         return (false);
03371     
03372     if (!setheapvalue (desc3.dataHandle, (*v1).valuetype, vreturned)) /*get it into temp stack now*/
03373         return (false);
03374     
03375     for (i = 1; i <= n; ++i) { /*copy values over from second list*/
03376         
03377         if (oserror (AEGetNthDesc (&desc2, i, typeWildCard, &key, &itemdesc)))
03378             return (false);
03379         
03380         if (desc3.descriptorType == typeAERecord) {
03381             
03382             DescType type;
03383             long size;
03384             
03385             if (AESizeOfKeyDesc (&desc3, key, &type, &size) == errAEDescNotFound)
03386                 errcode = AEPutKeyDesc (&desc3, key, &itemdesc);
03387             }
03388         else
03389             errcode = AEPutDesc (&desc3, 0, &itemdesc);
03390         
03391         AEDisposeDesc (&itemdesc);
03392         
03393         if (oserror (errcode))
03394             return (false);
03395         }
03396     
03397     return (true);
03398     } /*listaddvalue*/
03399 
03400 
03401 boolean listsubtractvalue (tyvaluerecord *v1, tyvaluerecord *v2, tyvaluerecord *vreturned) {
03402     
03403     /*
03404     add the two list values. both lists should be of the same type, since langvalue 
03405     does the necessary coercion first. But if one is an AEList and the other an AERecord,
03406     the AE Manager will generate errors if appropriate.
03407     
03408     when adding records, only add fields from the 2nd record that don't already exist
03409     in the first
03410     */
03411     
03412     AEDesc desc1;
03413     AEDesc desc2;
03414     AEDesc desc3;
03415     long ix1, ix2, n1, n2;
03416     
03417     listvaltodesc (v1, &desc1);
03418     
03419     listvaltodesc (v2, &desc2);
03420     
03421     if (oserror (AECountItems (&desc1, &n1)))
03422         goto error;
03423     
03424     if (oserror (AECountItems (&desc2, &n2)))
03425         goto error;
03426     
03427     if (oserror (AEDuplicateDesc (&desc1, &desc3))) /*start with first list*/
03428         goto error;
03429     
03430     if (!setheapvalue (desc3.dataHandle, (*v1).valuetype, vreturned)) /*get it into temp stack now*/
03431         goto error;
03432     
03433     if (desc3.descriptorType == typeAERecord) {
03434         
03435         for (ix1 = 1; ix1 <= n2; ++ix1) { /*delete values that appear in second record*/
03436             
03437             OSType key;
03438             AEDesc item1, item2;
03439             
03440             if (oserror (AEGetNthDesc (&desc2, ix1, typeWildCard, &key, &item1)))
03441                 goto error;
03442             
03443             if (AEGetKeyDesc (&desc3, key, typeWildCard, &item2) == noErr) {
03444                 
03445                 if (equaldescriptors (&item1, &item2))
03446                     AEDeleteKeyDesc (&desc3, key); /*ignore result, may be descNotFound*/
03447                 
03448                 AEDisposeDesc (&item2);
03449                 }
03450             
03451             AEDisposeDesc (&item1);
03452             }
03453         }
03454     else {
03455         
03456         ix2 = n1 - n2;
03457         
03458         for (ix1 = 0; ix1 <= ix2; ++ix1) {
03459             
03460             if (equalsublists (&desc1, &desc2, ix1, n2, false)) {
03461                 
03462                 while (--n2 >= 0)
03463                     if (oserror (AEDeleteItem (&desc3, ix1 + 1)))
03464                         goto error;
03465                 
03466                 break;
03467                 }
03468             }
03469         }
03470     
03471     return (true);
03472     
03473     error:
03474     
03475     return (false);
03476     } /*listsubtractvalue*/
03477 
03478 
03479 static boolean comparelists (AEDesc *desc1, AEDesc *desc2, tytreetype comparisonop) {
03480     
03481     /*
03482     compare the two lists, returning true if the comparison holds, false 
03483     if it doesn't or an error occurs
03484     */
03485     
03486     register AEDesc *d1 = desc1;
03487     register AEDesc *d2 = desc2;
03488     long n1, n2;
03489     register long ix1, ix2;
03490     boolean flbykey;
03491     
03492     if (oserror (AECountItems (d1, &n1)))
03493         goto exit;
03494     
03495     if (oserror (AECountItems (d2, &n2)))
03496         goto exit;
03497     
03498     ix1 = 0;
03499     
03500     ix2 = n1 - n2;
03501     
03502     if (ix2 < 0) /*v1 can't beginwith, endwith, contain or be equal to v2*/
03503         goto exit;
03504     
03505     flbykey = (*d1).descriptorType == typeAERecord;
03506     
03507     switch (comparisonop) {
03508         
03509         case beginswithop:
03510             ix2 = 0;
03511             
03512             flbykey = false;
03513             
03514             break;
03515         
03516         case endswithop:
03517             ix1 = ix2;
03518             
03519             flbykey = false;
03520             
03521             break;
03522         
03523         case EQop:
03524             if (ix2 != 0) /*n2 != n1*/
03525                 goto exit;
03526             
03527             break;
03528         
03529         case containsop:
03530             if (flbykey)
03531                 ix2 = 0;
03532             
03533             break;
03534         }
03535     
03536     for (; ix1 <= ix2; ++ix1) {
03537         
03538         if (equalsublists (d1, d2, ix1, n2, flbykey))
03539             return (true);
03540         }
03541     
03542     exit:
03543     
03544     return (false);
03545     } /*comparelists*/
03546 
03547 
03548 boolean listcomparevalue (tyvaluerecord *v1, tyvaluerecord *v2, tytreetype comparisonop, tyvaluerecord *vreturned) {
03549     
03550     AEDesc d1;
03551     AEDesc d2;
03552     boolean fl;
03553     
03554     listvaltodesc (v1, &d1);
03555     
03556     listvaltodesc (v2, &d2);
03557     
03558     fl = comparelists (&d1, &d2, comparisonop);
03559     
03560     if (fllangerror)
03561         return (false);
03562     
03563     return (setbooleanvalue (fl, vreturned));
03564     } /*listcomparevalue*/
03565 
03566 
03567 boolean coercetolistposition (tyvaluerecord *val) {
03568     
03569     /*
03570     get a list position parameter -- either an index (number) or a keyword (string4)
03571     */
03572     
03573     tyvaluerecord *v = val;
03574     boolean fl;
03575     
03576     switch ((*v).valuetype) {
03577         
03578         case longvaluetype:
03579         case ostypevaluetype:
03580             return (true);
03581         
03582         default:
03583             disablelangerror ();
03584             
03585             fl = coercetolong (v) || coercetoostype (v);
03586             
03587             enablelangerror ();
03588             
03589             if (fl)
03590                 return (true);
03591         }
03592     
03593     langerror (badipclistposerror);
03594     
03595     return (false);
03596     } /*coercetolistposition*/
03597 
03598 
03599 static boolean listerror (OSErr errcode, bigstring bsname, tyvaluerecord *vlist, tyvaluerecord *vindex) {
03600     
03601     switch (errcode) {
03602         
03603         case noErr:
03604             return (false);
03605         
03606         case errAEIllegalIndex:
03607         case errAEBadListItem:
03608         case errAEDescNotFound:
03609             langarrayreferror (0, bsname, vlist, vindex);
03610             
03611             return (true);
03612         
03613         default:
03614             oserror (errcode);
03615             
03616             return (true);
03617         }
03618     } /*listerror*/
03619     
03620 
03621 boolean listarrayvalue (tyvaluerecord *vlist, bigstring bsname, register tyvaluerecord *vindex, tyvaluerecord *vreturned) {
03622     
03623     /*
03624     bsname is provided for error reporting only
03625     */
03626     
03627     AEDesc listdesc;
03628     AEDesc itemdesc;
03629     OSType key;
03630     OSErr errcode;
03631     
03632     listvaltodesc (vlist, &listdesc);
03633     
03634     if (!coercetolistposition (vindex))
03635         return (false);
03636     
03637     if ((*vindex).valuetype == longvaluetype)
03638         errcode = AEGetNthDesc (&listdesc, (*vindex).data.longvalue, typeWildCard, &key, &itemdesc);
03639     else
03640         errcode = AEGetKeyDesc (&listdesc, (*vindex).data.ostypevalue, typeWildCard, &itemdesc);
03641     
03642     if (listerror (errcode, bsname, vlist, vindex))
03643         return (false);
03644     
03645     return (setdescriptorvalue (itemdesc, vreturned));
03646     } /*listarrayvalue*/
03647 
03648 
03649 boolean listassignvalue (tyvaluerecord *vlist, bigstring bsname, register tyvaluerecord *vindex, tyvaluerecord *vassign) {
03650     
03651     /*
03652     bsname is provided for error reporting only
03653     */
03654     
03655     AEDesc listdesc;
03656     AEDesc itemdesc;
03657     OSErr errcode;
03658     
03659     listvaltodesc (vlist, &listdesc);
03660     
03661     if (!coercetolistposition (vindex))
03662         return (false);
03663     
03664     if (!valuetodescriptor (vassign, &itemdesc))
03665         return (false);
03666     
03667     if ((*vindex).valuetype == longvaluetype)
03668         errcode = AEPutDesc (&listdesc, (*vindex).data.longvalue, &itemdesc);
03669     else
03670         errcode = AEPutKeyDesc (&listdesc, (*vindex).data.ostypevalue, &itemdesc);
03671     
03672     AEDisposeDesc (&itemdesc);
03673     
03674     if (listerror (errcode, bsname, vlist, vindex))
03675         return (false);
03676     
03677     return (true);
03678     } /*listassignvalue*/
03679 
03680 
03681 boolean listdeletevalue (tyvaluerecord *vlist, bigstring bsname, register tyvaluerecord *vindex) {
03682     
03683     /*
03684     bsname is provided for error reporting only
03685     */
03686     
03687     AEDesc listdesc;
03688     OSErr errcode;
03689     
03690     listvaltodesc (vlist, &listdesc);
03691     
03692     if (!coercetolistposition (vindex))
03693         return (false);
03694     
03695     if ((*vindex).valuetype == longvaluetype)
03696         errcode = AEDeleteItem (&listdesc, (*vindex).data.longvalue);
03697     else
03698         errcode = AEDeleteKeyDesc (&listdesc, (*vindex).data.ostypevalue);
03699     
03700     if (listerror (errcode, bsname, vlist, vindex))
03701         return (false);
03702     
03703     return (true );
03704     } /*listdeletevalue*/
03705 
03706 #endif
03707 
03708 
03709 
03710 

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