home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / MacPerl / MacPerl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-11-18  |  16.9 KB  |  752 lines  |  [TEXT/MPS ]
  1. /* $Header: tyrathect:Development:Perl::RCS:missing.c,v 1.2 1994/05/04 02:12:43 neeri Exp $
  2.  *
  3.  *    Copyright (c) 1995 Matthias Neeracher
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log: missing.c,v $
  9.  */
  10.  
  11. #define MAC_CONTEXT
  12.  
  13. #include "EXTERN.h"
  14. #include "perl.h"
  15. #include "XSUB.h"
  16. #include <Types.h>
  17. #include <QuickDraw.h>
  18. #include <Dialogs.h>
  19. #include <Lists.h>
  20. #include <TFileSpec.h>
  21. #include <Files.h>
  22. #include <Fonts.h>
  23. #include <Resources.h>
  24.  
  25. /* Shamelessly borrowed from Apple's includes. Sorry */
  26.  
  27. /*
  28.  * faccess() commands; for general use
  29.  */
  30.                      /* 'd' => "directory" ops */
  31. #define F_DELETE        (('d'<<8)|0x01)
  32. #define F_RENAME        (('d'<<8)|0x02)
  33.  
  34. /*
  35.  * more faccess() commands; for use only by MPW tools
  36.  */
  37.  
  38. #define F_OPEN             (('d'<<8)|0x00)        /* reserved for operating system use */
  39.                     /* 'e' => "editor" ops */
  40. #define F_GTABINFO         (('e'<<8)|0x00)        /* get tab offset for file */    
  41. #define F_STABINFO         (('e'<<8)|0x01)        /* set     "    "        "    "  */
  42. #define F_GFONTINFO        (('e'<<8)|0x02)        /* get font number and size for file */
  43. #define F_SFONTINFO        (('e'<<8)|0x03)        /* set     "        "    "    "    "    "      */
  44. #define F_GPRINTREC        (('e'<<8)|0x04)        /* get print record for file */
  45. #define F_SPRINTREC        (('e'<<8)|0x05)        /* set     "        "    "    "      */
  46. #define F_GSELINFO         (('e'<<8)|0x06)        /* get selection information for file */
  47. #define F_SSELINFO         (('e'<<8)|0x07)        /* set        "        "        "        " */
  48. #define F_GWININFO         (('e'<<8)|0x08)        /* get current window position */
  49. #define F_SWININFO         (('e'<<8)|0x09)        /* set    "        "        "        */
  50. #define F_GSCROLLINFO    (('e'<<8)|0x0A)        /* get scroll information */
  51. #define F_SSCROLLINFO    (('e'<<8)|0x0B)        /* set    "           "        */
  52. #define F_GMARKER        (('e'<<8)|0x0D)        /* Get Marker */
  53. #define F_SMARKER        (('e'<<8)|0x0C)        /* Set   "       */
  54. #define F_GSAVEONCLOSE    (('e'<<8)|0x0F)        /* Get Save on close */
  55. #define F_SSAVEONCLOSE    (('e'<<8)|0x0E)        /* Set   "     "     "      */
  56.  
  57. /*
  58.  *    argument structure for use with F_SMARKER command
  59.  */
  60. #ifdef powerc
  61. #pragma options align=mac68k
  62. #endif
  63. struct MarkElement {
  64.     int                start;            /* start position of mark */
  65.     int                end;            /* end position */
  66.     unsigned char    charCount;        /* number of chars in mark name */
  67.     char            name[64];        /* marker name */
  68. };                                    /* note: marker may be up to 64 chars long */
  69.  
  70. #ifdef powerc
  71. #pragma options align=reset
  72. #endif
  73.  
  74. #ifndef __cplusplus
  75. typedef struct MarkElement MarkElement;
  76. #endif
  77.  
  78. #ifdef powerc
  79. #pragma options align=mac68k
  80. #endif
  81. struct SelectionRecord {
  82.     long    startingPos;
  83.     long    endingPos;
  84.     long    displayTop;
  85. };
  86. #ifdef powerc
  87. #pragma options align=reset
  88. #endif
  89. #ifndef __cplusplus
  90. typedef struct SelectionRecord SelectionRecord;
  91. #endif
  92.  
  93. static char gMacPerlScratch[256];
  94. #define gMacPerlScratchString ((StringPtr) gMacPerlScratch)
  95.  
  96. static ControlHandle GetDlgCtrl(DialogPtr dlg, short item)
  97. {
  98.     short     kind;
  99.     Handle    hdl;
  100.     Rect    box;
  101.     
  102.     GetDItem(dlg, item, &kind, &hdl, &box);
  103.     return (ControlHandle) hdl;
  104. }
  105.  
  106. static void GetDlgText(DialogPtr dlg, short item, StringPtr text)
  107. {
  108.     GetIText((Handle) GetDlgCtrl(dlg, item), text);
  109. }
  110.  
  111. static void SetDlgText(DialogPtr dlg, short item, char * text)
  112. {
  113.     setitext((Handle) GetDlgCtrl(dlg, item), text);
  114. }
  115.  
  116. static void GetDlgRect(DialogPtr dlg, short item, Rect * r)
  117. {
  118.     short     kind;
  119.     Handle    hdl;
  120.     
  121.     GetDItem(dlg, item, &kind, &hdl, r);
  122. }
  123.  
  124. static void FrameDlgRect(DialogPtr dlg, short item)
  125. {
  126.     Rect    r;
  127.     
  128.     GetDlgRect(dlg, item, &r);
  129.     InsetRect(&r, -4, -4);
  130.     PenSize(3, 3);
  131.     FrameRoundRect(&r, 16, 16);
  132.     PenSize(1,1);
  133. }
  134.  
  135. static ListHandle gPickList = NULL;
  136.  
  137. #define SetCell(cell, row, column)    { (cell).h = column; (cell).v = row; }
  138. #define ROW(cell)                     (cell).v
  139.  
  140. pascal void
  141. MacListUpdate(myDialog, myItem)
  142. DialogPtr        myDialog;
  143. short            myItem;
  144. {
  145.     Rect            myrect;
  146.  
  147.     LUpdate(myDialog->visRgn, gPickList);
  148.     myrect = (**(gPickList)).rView;
  149.     InsetRect(&myrect, -1, -1);
  150.     FrameRect(&myrect);
  151. }
  152.  
  153. #if USESROUTINEDESCRIPTORS
  154. RoutineDescriptor    uMacListUpdate = 
  155.         BUILD_ROUTINE_DESCRIPTOR(uppUserItemProcInfo, MacListUpdate);
  156. #else
  157. #define uMacListUpdate MacListUpdate
  158. #endif
  159.  
  160. pascal Boolean
  161. MacListFilter(myDialog, myEvent, myItem)
  162. DialogPtr        myDialog;
  163. EventRecord        *myEvent;
  164. short            *myItem;
  165. {
  166.     Rect    listrect;
  167.     short    myascii;
  168.     Handle    myhandle;
  169.     Point    mypoint;
  170.     short    mytype;
  171.     int        activate;
  172.  
  173.     SetPort(myDialog);
  174.     if (myEvent->what == keyDown) {
  175.         myascii = myEvent->message % 256;
  176.         if (myascii == '\015' || myascii == '\003') {    /* This is return or enter... */
  177.             *myItem = 1;
  178.             return true;
  179.             }
  180.         }
  181.     else if (myEvent->what == mouseDown) {
  182.         mypoint = myEvent->where;
  183.         GlobalToLocal(&mypoint);
  184.         GetDItem(myDialog, 4, &mytype, &myhandle, &listrect);
  185.         if (PtInRect(mypoint, &listrect) && gPickList != NULL) {
  186.             if (LClick(mypoint, (short)myEvent->modifiers, gPickList)) {
  187.                 /* User double-clicked in cell... */
  188.                 *myItem = 1;
  189.                 return true;
  190.                 }
  191.             }
  192.         }
  193.     else if (myEvent->what == activateEvt && gPickList != NULL) {
  194.         activate = (myEvent->modifiers & 0x01) != 0;
  195.         LActivate((Boolean) activate, gPickList);
  196.         }
  197.     
  198.     return false;
  199. }
  200.  
  201. #if USESROUTINEDESCRIPTORS
  202. RoutineDescriptor    uMacListFilter = 
  203.         BUILD_ROUTINE_DESCRIPTOR(uppModalFilterProcInfo, MacListFilter);
  204. #else
  205. #define uMacListFilter MacListFilter
  206. #endif
  207.  
  208. static OSErr GetVolInfo(short volume, Boolean indexed, FSSpec * spec)
  209. {
  210.     OSErr                err;
  211.     HParamBlockRec    pb;
  212.     
  213.     pb.volumeParam.ioNamePtr    =    spec->name;
  214.     pb.volumeParam.ioVRefNum    =    indexed ? 0 : volume;
  215.     pb.volumeParam.ioVolIndex    =    indexed ? volume : 0;
  216.     
  217.     if (err = PBHGetVInfoSync(&pb))
  218.         return err;
  219.     
  220.     spec->vRefNum    =    pb.volumeParam.ioVRefNum;
  221.     spec->parID        =    1;
  222.     
  223.     return noErr;
  224. }
  225.  
  226. XS(XS_MacPerl_MP_SetFileInfo)
  227. {
  228.     dXSARGS;
  229.     if (items < 3) {
  230.     croak("Usage: MacPerl::SetFileInfo(creator, type, path, ...)");
  231.     }
  232.     {
  233.     OSType    creator;
  234.     OSType    type;
  235.     char *    path = (char *)SvPV(ST(2),na);
  236.  
  237.     memcpy(&creator, SvPV(ST(0),na), 4);
  238.  
  239.     memcpy(&type, SvPV(ST(1),na), 4);
  240.     {
  241.         int i;
  242.         for (i=2; i<items; i++)
  243.             fsetfileinfo((char *) SvPV(ST(i), na), creator, type);
  244.     }
  245.     }
  246.     XSRETURN(1);
  247. }
  248.  
  249. XS(XS_MacPerl_MP_GetFileInfo)
  250. {
  251.     dXSARGS;
  252.     if (items != 1) {
  253.     croak("Usage: MacPerl::GetFileInfo(path)");
  254.     }
  255.     SP -= items;
  256.     {
  257.     char *    path = (char *)SvPV(ST(0),na);
  258.     {
  259.         unsigned long    creator;
  260.         unsigned long    type;
  261.         fgetfileinfo(path, &creator, &type);
  262.             
  263.         if (errno) {
  264.             if (GIMME != G_ARRAY)
  265.                 XPUSHs(&sv_undef);
  266.             /* Else return empty list */
  267.         } else if (GIMME != G_ARRAY) {
  268.             XPUSHs(sv_2mortal(newSVpv((char *) &type, 4)));
  269.         } else {
  270.             XPUSHs(sv_2mortal(newSVpv((char *) &creator, 4)));
  271.             XPUSHs(sv_2mortal(newSVpv((char *) &type, 4)));
  272.         }
  273.     }
  274.     PUTBACK;
  275.     return;
  276.     }
  277. }
  278.  
  279. XS(XS_MacPerl_MP_Ask)
  280. {
  281.     dXSARGS;
  282.     if (items < 1) {
  283.     croak("Usage: MacPerl::Ask(prompt, ...)");
  284.     }
  285.     {
  286.     char *    prompt = (char *)SvPV(ST(0),na);
  287.     char *    RETVAL;
  288.     {
  289.         short            item;
  290.         DialogPtr    dlg;
  291.         
  292.         dlg = GetNewDialog(2010, NULL, (WindowPtr)-1);
  293.         InitCursor();
  294.         SetDlgText(dlg, 3, prompt);
  295.         
  296.         if (items > 1)
  297.             SetDlgText(dlg, 4, (char *) SvPV(ST(1), na));
  298.         SelIText(dlg, 4, 0, 1024);
  299.         
  300.         ShowWindow(dlg);
  301.         SetPort(dlg);
  302.         FrameDlgRect(dlg, ok);
  303.         ModalDialog((ModalFilterUPP)0, &item);
  304.         switch (item) {
  305.         case ok:
  306.             GetDlgText(dlg, 4, gMacPerlScratchString);
  307.             ST(0) = sv_2mortal(newSVpv(gMacPerlScratch+1, gMacPerlScratch[0]));
  308.             break;
  309.         case cancel:
  310.             ST(0) = &sv_undef;
  311.             break;
  312.         }
  313.         DisposeDialog(dlg);
  314.     }
  315.     }
  316.     XSRETURN(1);
  317. }
  318.  
  319. XS(XS_MacPerl_MP_Answer)
  320. {
  321.     dXSARGS;
  322.     if (items < 1) {
  323.     croak("Usage: MacPerl::Answer(prompt, ...)");
  324.     }
  325.     {
  326.     char *    prompt = (char *)SvPV(ST(0),na);
  327.     int    RETVAL;
  328.     {
  329.         short            item;
  330.         DialogPtr    dlg;
  331.         
  332.         if (items > 4)
  333.             items = 4;
  334.             
  335.         dlg = GetNewDialog((items>1) ? 1999+items : 2001, NULL, (WindowPtr)-1);
  336.         InitCursor();
  337.         SetDlgText(dlg, 5, prompt);
  338.         
  339.         if (items > 1)
  340.             for (item = 1; item < items; item++) {
  341.                 strcpy(gMacPerlScratch+1, (char *) SvPV(ST(item), na));
  342.                 *gMacPerlScratchString = strlen(gMacPerlScratch+1);
  343.                 SetCTitle(GetDlgCtrl(dlg, item), gMacPerlScratchString);
  344.             }
  345.         else
  346.             SetCTitle(GetDlgCtrl(dlg, 1), "\pOK");
  347.             
  348.         ShowWindow(dlg);
  349.         SetPort(dlg);
  350.         FrameDlgRect(dlg, ok);
  351.         ModalDialog((ModalFilterUPP)0, &item);
  352.         DisposeDialog(dlg);
  353.         
  354.         RETVAL = (items > 1) ? items - item - 1 : 0;
  355.     }
  356.     ST(0) = sv_newmortal();
  357.     sv_setiv(ST(0), (IV)RETVAL);
  358.     }
  359.     XSRETURN(1);
  360. }
  361.  
  362. XS(XS_MacPerl_MP_Choose)
  363. {
  364.     dXSARGS;
  365.     if (items < 3) {
  366.     croak("Usage: MacPerl::Choose(domain, type, prompt, ...)");
  367.     }
  368.     {
  369.     int    domain = (int)SvIV(ST(0));
  370.     int    type = (int)SvIV(ST(1));
  371.     char *    prompt = (char *)SvPV(ST(2),na);
  372.     {
  373.         int          flags;
  374.         STRLEN    len;
  375.         char *     constraint;
  376.         char *     def_addr;
  377.         
  378.         constraint = (items>=4) ? ((char *) SvPV(ST(3), len)) : nil;
  379.         constraint = constraint && len ? constraint : nil;
  380.         flags = (items>=5) ? ((int) SvIV(ST(4))) : 0;
  381.         def_addr = (items>=6) ? ((char *) SvPV(ST(5), len)) : nil;
  382.         def_addr = def_addr && len ? def_addr : nil;
  383.         
  384.         gMacPerlScratch[0] = 0;
  385.         
  386.         if (def_addr) {
  387.             memcpy(gMacPerlScratch, def_addr, len);
  388.             gMacPerlScratch[len] = 0;    /* Some types require this */
  389.         } 
  390.         len = 256;                            /* Len is output only! */
  391.         
  392.         if (choose(domain, type, prompt, constraint, flags, gMacPerlScratch, &len) < 0)
  393.             ST(0) = &sv_undef;
  394.         else
  395.             ST(0) = sv_2mortal(newSVpv(gMacPerlScratch, len));
  396.     }
  397.     }
  398.     XSRETURN(1);
  399. }
  400.  
  401. XS(XS_MacPerl_MP_Pick)
  402. {
  403.     dXSARGS;
  404.     if (items < 1) {
  405.     croak("Usage: MacPerl::Pick(prompt, ...)");
  406.     }
  407.     {
  408.     char *    prompt = (char *)SvPV(ST(0),na);
  409.     {    
  410.         short            itemHit;
  411.         STRLEN        len;
  412.         Boolean        done;
  413.         DialogPtr    dlg;
  414.         ListHandle    mylist;
  415.         Cell            mycell;
  416.         short            mytype;
  417.         Handle        myhandle;
  418.         Point            cellsize;
  419.         Rect            listrect, dbounds;
  420.         char    *        item;
  421.             
  422.         InitCursor();
  423.         dlg = GetNewDialog(2020, NULL, (WindowPtr)-1);
  424.         
  425.         SetDlgText(dlg, 3, prompt);
  426.         GetDItem(dlg, 4, &mytype, &myhandle, &listrect);
  427.         SetDItem(dlg, 4, mytype, (Handle)&uMacListUpdate, &listrect);
  428.         
  429.         SetPort(dlg);
  430.         InsetRect(&listrect, 1, 1);
  431.         SetRect(&dbounds, 0, 0, 1, items-1);
  432.         cellsize.h = (listrect.right - listrect.left);
  433.         cellsize.v = 17;
  434.     
  435.         listrect.right -= 15;
  436.     
  437.         gPickList = LNew(&listrect, &dbounds, cellsize, 0,
  438.                                 dlg, true, false, false, true);
  439.     
  440.         LDoDraw(false, gPickList);
  441.         
  442.         SetCell(mycell, 0, 0);
  443.         for (; mycell.v<items-1; ++mycell.v)    {
  444.             item = (char *) SvPV(ST(mycell.v+1), len);
  445.             LSetCell(item, len, mycell, gPickList);
  446.         }
  447.     
  448.         LDoDraw(true, gPickList);
  449.         ShowWindow(dlg);
  450.         
  451.         for (done=false; !done; ) {
  452.             SetPort(dlg);
  453.             FrameDlgRect(dlg, ok);
  454.             ModalDialog((ModalFilterUPP) &uMacListFilter, &itemHit);
  455.             switch (itemHit) {
  456.             case ok:
  457.                 SetCell(mycell, 0, 0);
  458.                 done = true;
  459.                 if (!LGetSelect(true, &mycell, gPickList))
  460.                     itemHit = cancel;
  461.                 break;
  462.             case cancel:
  463.                 done = true;
  464.                 break;
  465.             }
  466.         }    /* Modal Loop */
  467.     
  468.         SetPort(dlg);
  469.         
  470.         LDispose(gPickList);
  471.         gPickList = nil;
  472.         DisposDialog(dlg);
  473.         
  474.         if (itemHit == ok)
  475.             ST(0) = sv_mortalcopy(ST(mycell.v+1));
  476.         else
  477.             ST(0) = &sv_undef;
  478.     }
  479.     }
  480.     XSRETURN(1);
  481. }
  482.  
  483. XS(XS_MacPerl_MP_Quit)
  484. {
  485.     dXSARGS;
  486.     if (items != 1) {
  487.     croak("Usage: MacPerl::Quit(condition)");
  488.     }
  489.     {
  490.     int    condition = (int)SvIV(ST(0));
  491.     gPerlQuit = condition;
  492.     }
  493.     XSRETURN(1);
  494. }
  495.  
  496. XS(XS_MacPerl_MP_FAccess)
  497. {
  498.     dXSARGS;
  499.     if (items < 2) {
  500.     croak("Usage: MacPerl::FAccess(file, cmd, ...)");
  501.     }
  502.     SP -= items;
  503.     {
  504.     char *    file = (char *)SvPV(ST(0),na);
  505.     unsigned    cmd = (unsigned)SvIV(ST(1));
  506.     {
  507.         unsigned                uarg;
  508.         Rect                    rarg;
  509.         SelectionRecord    sarg;
  510.         char *                 name;
  511.         
  512.         switch (cmd) {
  513.         case F_GFONTINFO:
  514.             if (faccess(file, cmd, (long *)&uarg) < 0)
  515.                 XPUSHs(&sv_undef);
  516.             else if (GIMME != G_ARRAY)
  517.                 XPUSHs(sv_2mortal(newSViv(uarg >> 16)));
  518.             else {
  519.                 GetFontName(uarg >> 16, gMacPerlScratchString);
  520.                 XPUSHs(sv_2mortal(newSVpv(gMacPerlScratch+1, *gMacPerlScratch)));
  521.                 XPUSHs(sv_2mortal(newSViv(uarg & 0xFFFF)));
  522.             }
  523.             break;
  524.         case F_GSELINFO:
  525.             if (faccess(file, cmd, (long *)&sarg) < 0)
  526.                 XPUSHs(&sv_undef);
  527.             else if (GIMME != G_ARRAY)
  528.                 XPUSHs(sv_2mortal(newSViv(sarg.startingPos)));
  529.             else {
  530.                 XPUSHs(sv_2mortal(newSViv(sarg.startingPos)));
  531.                 XPUSHs(sv_2mortal(newSViv(sarg.endingPos)));
  532.                 XPUSHs(sv_2mortal(newSViv(sarg.displayTop)));
  533.             }
  534.             break;
  535.         case F_GTABINFO:
  536.             if (faccess(file, cmd, (long *)&uarg) < 0) 
  537.                 XPUSHs(&sv_undef);
  538.             else
  539.                 XPUSHs(sv_2mortal(newSViv(uarg)));
  540.             break;
  541.         case F_GWININFO:
  542.             if (faccess(file, cmd, (long *)&rarg) < 0)
  543.                 XPUSHs(&sv_undef);
  544.             else if (GIMME != G_ARRAY)
  545.                 XPUSHs(sv_2mortal(newSViv(rarg.top)));
  546.             else {
  547.                 XPUSHs(sv_2mortal(newSViv(rarg.left)));
  548.                 XPUSHs(sv_2mortal(newSViv(rarg.top)));
  549.                 XPUSHs(sv_2mortal(newSViv(rarg.right)));
  550.                 XPUSHs(sv_2mortal(newSViv(rarg.bottom)));
  551.             }
  552.             break;
  553.         case F_SFONTINFO:
  554.             if (items < 3)
  555.                 croak("Usage: MacPerl::FAccess(file, F_SFONTINFO, font [, size])");
  556.             
  557.             name = SvPV(ST(2), na);
  558.             
  559.             if (items == 3) {
  560.                 if (faccess(file, F_GFONTINFO, (long *)&uarg) < 0)
  561.                     uarg = 9;
  562.             } else
  563.                 uarg = (unsigned) SvIV(ST(3));
  564.             
  565.             if (isalpha(*name)) {
  566.                 short    family;
  567.                 
  568.                 getfnum(name, &family);
  569.                 
  570.                 uarg = (uarg & 0xFFFF) | ((unsigned) family) << 16;
  571.             } else 
  572.                 uarg = (uarg & 0xFFFF) | ((unsigned) SvIV(ST(2))) << 16;
  573.             
  574.             if (faccess(file, cmd, (long *)uarg) < 0)
  575.                 XPUSHs(&sv_undef);
  576.             else
  577.                 XPUSHs(sv_2mortal(newSViv(1)));
  578.             break;
  579.         case F_SSELINFO:
  580.             if (items < 4)
  581.                 croak("Usage: MacPerl::FAccess(file, F_SSELINFO, start, end [, top])");
  582.             
  583.             if (items == 4) {
  584.                 if (faccess(file, F_GSELINFO, (long *) &sarg) < 0) 
  585.                     sarg.displayTop = SvIV(ST(2));
  586.             } else 
  587.                 sarg.displayTop = SvIV(ST(4));
  588.                 
  589.             sarg.startingPos = SvIV(ST(2));
  590.             sarg.endingPos = SvIV(ST(3));
  591.             
  592.             if (faccess(file, cmd, (long *)&sarg) < 0)
  593.                 XPUSHs(&sv_undef);
  594.             else
  595.                 XPUSHs(sv_2mortal(newSViv(1)));
  596.             break;
  597.         case F_STABINFO:
  598.             if (items < 3)
  599.                 croak("Usage: MacPerl::FAccess(file, F_STABINFO, tab)");
  600.             
  601.             uarg = SvIV(ST(2));
  602.             
  603.             if (faccess(file, cmd, (long *)uarg) < 0) 
  604.                 XPUSHs(&sv_undef);
  605.             else
  606.                 XPUSHs(sv_2mortal(newSViv(1)));
  607.             break;
  608.         case F_SWININFO:
  609.             if (items < 4 )
  610.                 croak("Usage: MacPerl::FAccess(file, F_SWININFO, left, top [, right [, bottom]])");
  611.             
  612.             if (items < 6) {
  613.                 if (faccess(file, F_GWININFO, (long *)&rarg) < 0)
  614.                     rarg.bottom = rarg.right = 400;
  615.                 else {
  616.                     rarg.bottom = rarg.bottom - rarg.top + (short) SvIV(ST(3));
  617.                     if (items == 4)
  618.                         rarg.right = rarg.right - rarg.left + (short) SvIV(ST(2));
  619.                 }
  620.             } else {
  621.                 rarg.right = (short) SvIV(ST(4));
  622.                 rarg.bottom = (short) SvIV(ST(5));
  623.             }
  624.                 
  625.             rarg.left = (short) SvIV(ST(2));
  626.             rarg.top = (short) SvIV(ST(3));
  627.             
  628.             if (faccess(file, cmd, (long *)&rarg) < 0)
  629.                 XPUSHs(&sv_undef);
  630.             else
  631.                 XPUSHs(sv_2mortal(newSViv(1)));
  632.             break;
  633.         default:
  634.             croak("MacPerl::FAccess() can't handle this command");
  635.         }
  636.     }
  637.     PUTBACK;
  638.     return;
  639.     }
  640. }
  641.  
  642. XS(XS_MacPerl_MP_MakeFSSpec)
  643. {
  644.     dXSARGS;
  645.     if (items != 1) {
  646.     croak("Usage: MacPerl::MakeFSSpec(path)");
  647.     }
  648.     {
  649.     char *    path = (char *)SvPV(ST(0),na);
  650.     {
  651.         FSSpec    spec;
  652.         
  653.         if (Path2FSSpec(path, &spec))
  654.              ST(0) = &sv_undef;
  655.         else
  656.             ST(0) = sv_2mortal(newSVpv(FSp2Encoding(&spec), 0));
  657.     }
  658.     }
  659.     XSRETURN(1);
  660. }
  661.  
  662. XS(XS_MacPerl_MP_MakePath)
  663. {
  664.     dXSARGS;
  665.     if (items != 1) {
  666.     croak("Usage: MacPerl::MakePath(path)");
  667.     }
  668.     {
  669.     char *    path = (char *)SvPV(ST(0),na);
  670.     {
  671.         FSSpec    spec;
  672.         
  673.         if (Path2FSSpec(path, &spec))
  674.              ST(0) = &sv_undef;
  675.         else
  676.             ST(0) = sv_2mortal(newSVpv(FSp2FullPath(&spec), 0));
  677.     }
  678.     }
  679.     XSRETURN(1);
  680. }
  681.  
  682. XS(XS_MacPerl_MP_Volumes)
  683. {
  684.     dXSARGS;
  685.     if (items != 0) {
  686.     croak("Usage: MacPerl::Volumes()");
  687.     }
  688.     SP -= items;
  689.     {
  690.     {
  691.         FSSpec spec;
  692.         
  693.         if (GIMME != G_ARRAY) {
  694.             Special2FSSpec('macs', kOnSystemDisk, 0, &spec);
  695.             GetVolInfo(spec.vRefNum, false, &spec);
  696.             
  697.             XPUSHs(sv_2mortal(newSVpv(FSp2Encoding(&spec), 0)));
  698.         } else {
  699.             short    index;
  700.             
  701.             for (index = 0; !GetVolInfo(index+1, true, &spec); ++index)
  702.                 XPUSHs(sv_2mortal(newSVpv(FSp2Encoding(&spec), 0)));
  703.         }
  704.     }
  705.     PUTBACK;
  706.     return;
  707.     }
  708. }
  709.  
  710. XS(boot_MacPerl)
  711. {
  712.     dXSARGS;
  713.     char* file = __FILE__;
  714.  
  715.     newXS("MacPerl::SetFileInfo", XS_MacPerl_MP_SetFileInfo, file);
  716.     newXS("MacPerl::GetFileInfo", XS_MacPerl_MP_GetFileInfo, file);
  717.     newXS("MacPerl::Ask", XS_MacPerl_MP_Ask, file);
  718.     newXS("MacPerl::Answer", XS_MacPerl_MP_Answer, file);
  719.     newXS("MacPerl::Choose", XS_MacPerl_MP_Choose, file);
  720.     newXS("MacPerl::Pick", XS_MacPerl_MP_Pick, file);
  721.     newXS("MacPerl::Quit", XS_MacPerl_MP_Quit, file);
  722.     newXS("MacPerl::FAccess", XS_MacPerl_MP_FAccess, file);
  723.     newXS("MacPerl::MakeFSSpec", XS_MacPerl_MP_MakeFSSpec, file);
  724.     newXS("MacPerl::MakePath", XS_MacPerl_MP_MakePath, file);
  725.     newXS("MacPerl::Volumes", XS_MacPerl_MP_Volumes, file);
  726.  
  727.     /* Initialisation Section */
  728.  
  729.     {
  730.         extern int    StandAlone;
  731.         VersRecHndl    vers         = (VersRecHndl) GetResource('vers', 1);
  732.         int             versLen    = *(*vers)->shortVersion;
  733.         SV *            version    = perl_get_sv("MacPerl::Version", TRUE);
  734.  
  735.         HLock((Handle) vers);
  736.         memcpy(gMacPerlScratch, (char *)(*vers)->shortVersion+1, versLen);
  737.         if (StandAlone) 
  738.             strcpy(gMacPerlScratch+versLen, " Application");
  739.         else
  740.             strcpy(gMacPerlScratch+versLen, " MPW");
  741.         
  742.         sv_setpv(version, gMacPerlScratch);
  743.         SvREADONLY_on(version);
  744.     }
  745.  
  746.  
  747.     /* End of Initialisation Section */
  748.  
  749.     ST(0) = &sv_yes;
  750.     XSRETURN(1);
  751. }
  752.