home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / hc / turbopgl.sit / FileName.p < prev    next >
Encoding:
Text File  |  1988-03-04  |  6.7 KB  |  214 lines  |  [TEXT/TPAS]
  1. program filename;
  2.  
  3. { 
  4. Name:    ╥FileName╙ -- a HyperCard "XFCN" (External Function) resource
  5.  
  6. Written By: Steve Maller
  7.       Apple Computer Training Support
  8.       Copyright ⌐ 1987 Apple Computer
  9.       AppleLink: MALLER1
  10.       Saturday, August 22, 1987 
  11.  
  12. Modified for Turbo Pascal by Stephen Kurtzman
  13.  
  14. Very slightly modified by Brian Liebowitz...Steve Kurtzman got it right
  15. for the DHDR's that he was using, so if it doesn't work it's my fault.
  16.  
  17.     You must install the DHDR resources called PasXFCN and PasXCMD 
  18.     into your copy of Turbo before compiling this XCMD.  You must also 
  19.      have compiled the unit HyperXCMD and moved it into the Turbo progam,
  20.       and the file XCMDGlue.inc must be accessible.  After compiling,use
  21.      ResEdit to change the ID from 300, and to copy the XCMD or XFCN into 
  22.     your stack or Hypercard.
  23.  
  24.  
  25. Language:  Turbo Pascal
  26.  
  27. Usage:   FileName("fileType") -- "fileType" is optional
  28.  
  29. Examples:  FileName("STAK")   -- limits list to HyperCard Stacks
  30.       FileName("TEXT")   -- limits list to text files
  31.       FileName("APPL")   -- limits list to applications
  32.       FileName()       -- lists ALL files
  33.  
  34. Result:   The full pathname of the selected file.
  35.       For example, if you selected the file "Address Stack" which is
  36.       in the folder "My Stacks" in the folder "HyperCard" on the
  37.       disk "HD" the result is:
  38.          HD:HyperCard:My Stacks:Address Stack
  39.       If the user clicks ╥Cancel╙ an empty string is returned.
  40.       
  41. Warning:  A word of caution: the Mac's file system can NOT accept
  42.       pathnames longer than 255 characters. Be careful...
  43.       
  44. Script
  45. Example:  on mouseUp
  46.        put FileName("TEXT") into theFile
  47.        if theFile is not empty then
  48.         open file theFile
  49.         read from file theFile for 2000
  50.         put it into bkgnd field 1
  51.         close file theFile
  52.        end if
  53.       end mouseUp
  54.  
  55. Why?    You must access files in HyperCard by their full pathname.
  56.       Unfortunately, HyperCard offers you no clear way of finding
  57.       out what that full name is. If files are on a hard disk, it
  58.       can be a real pain to remember the entire pathname. This
  59.       function simplifies that task for both the stackware developer
  60.       and the end user.
  61.  
  62. Thanks to: Ted Kaehler, Dan Winkler, and Bill Atkinson - my hero!
  63.  
  64. }
  65.  
  66. {$R-}
  67. {$U-}
  68. {$D PasXFCN}
  69.  
  70. USES   MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, HyperXCmd;
  71.  
  72.   PROCEDURE PasXFCN(paramPtr: XCmdPtr);
  73.  
  74.    VAR
  75.     myWDPB: WDPBPtr;       { some variants of the same animal }
  76.     myCPB: CInfoPBPtr;
  77.     myPB: HParmBlkPtr;
  78.     fullPathName: Str255;
  79.     numTypes: Integer;
  80.     reply: SFReply;
  81.     typeList: SFTypeList;
  82.  
  83.  PROCEDURE DoJsr(addr: ProcPtr); INLINE $205F,$4E90;
  84.  
  85. FUNCTION PasToZero(str: Str255): Handle;
  86. {  Convert a Pascal string to a zero-terminated string.  Returns a handle
  87.    to a new zero-terminated string.  The caller must dispose the handle.
  88.    You'll need to do this for any result or argument you send from 
  89.    your XCMD to HyperTalk. }
  90. BEGIN
  91.   WITH paramPtr^ DO
  92.     BEGIN
  93.       inArgs[1] := ORD(@str);
  94.       request := xreqPasToZero;
  95.       DoJsr(entryPoint);
  96.       PasToZero := Handle(outArgs[1]);
  97.     END;
  98. END;
  99.  
  100.  
  101.    FUNCTION TheyChoseAFile: Boolean;
  102.  
  103.     VAR
  104.      pt: Point;
  105.  
  106.     BEGIN
  107.      TheyChoseAFile := FALSE;
  108.      pt.v := 60;
  109.      pt.h := 82;
  110.      SFGetFile(pt, '', NIL, numTypes, typeList, NIL, reply);
  111.                         { have 'em pick a file }
  112.      IF reply.good THEN           { if they didn't choose Cancel }
  113.       BEGIN
  114.        TheyChoseAFile := TRUE;
  115.        fullPathName := reply.fName;    { start the ball rolling }
  116.       END;
  117.     END;
  118.  
  119.    PROCEDURE BuildThePathName;
  120.  
  121.     VAR
  122.      name: Str255;
  123.      err: Integer;
  124.  
  125.     BEGIN
  126.      name := '';              { start with an empty name }
  127.      myPB^.ioNamePtr := @name;       { we want the Volume name }
  128.       myPB^.ioCompletion := pointer(0);
  129.      myPB^.ioVRefNum := reply.vRefNum;   { returned from SFGetFile }
  130.      myPB^.ioVolIndex := 0;        { use the vRefNum and name }
  131.      err := PBHGetVInfo(myPB, FALSE);   { fill in the Volume info }
  132.      IF err <> noErr THEN
  133.       Exit;
  134.  
  135. { Now we need the Working Directory (WD) information because we're going 
  136.  to step backwards from the file through all of the the folders until
  137.  we reach the root directory }
  138.  
  139.      myWDPB^.ioVRefNum := reply.vRefNum;  { this got set to 0 above }
  140.      myWDPB^.ioWDProcID := 0;       { use the vRefNum }
  141.      myWDPB^.ioWDIndex := 0;        { we want ALL directories }
  142.      err := PBGetWDInfo(myWDPB, FALSE);  { do it }
  143.      IF err <> noErr THEN
  144.       Exit;
  145.  
  146.      myCPB^.ioFDirIndex := - 1;      { use the ioDirID field only }
  147.      myCPB^.ioDrDirID := myWDPB^.ioWDDirID;{ info returned above }
  148.      err := PBGetCatInfo(myCPB, FALSE);  { do it }
  149.      IF err <> noErr THEN
  150.       Exit;
  151.  
  152. { Here starts the real work - start to climb the tree by continually
  153.  looking in the ioDrParId field for the next directory above until we
  154.  fail... }
  155.  
  156.      myCPB^.ioDrDirID := myCPB^.ioDrParId; { the first folder}
  157.      fullPathName := Concat(myCPB^.ioNamePtr^, ':', reply.fName);
  158.      REPEAT
  159.       myCPB^.ioDrDirID := myCPB^.ioDrParId;
  160.       err := PBGetCatInfo(myCPB, FALSE); { the next level }
  161.  
  162. { Be careful of an error returned here - it means the user chose a file 
  163.  on the desktop level of this volume. If this is the case, just stop
  164.  here and return "VolumeName:FileName", otherwise loop until failure }
  165.       IF err = noErr THEN
  166.        fullPathName := Concat(myCPB^.ioNamePtr^, ':', fullPathName);
  167.  
  168.      UNTIL err <> noErr;
  169.      
  170.     END;  { PROCEDURE BuildThePathName }
  171.  
  172.    BEGIN  { PROCEDURE FileName }
  173.    
  174. { First we allocate some memory in the heap for the parameter block. This
  175.  could in theory work on the stack, but in reality it makes no difference
  176.  as we're entirely modal (ugh) here... }
  177.  
  178.     fullPathName := '';
  179.  
  180.     myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
  181.     IF ord4(myCPB) <= 0 THEN
  182.      Exit;       { Rats! Bill didn't leave enough room }
  183.     myWDPB := WDPBPtr(myCPB);   { icky Pascal type coercions follow }
  184.     myPB := HParmBlkPtr(myCPB);
  185.  
  186.     numTypes := 1;        { for SFGetFile }
  187.     WITH paramPtr^ DO
  188.      BEGIN
  189.       IF paramCount = 0 THEN
  190.        numTypes := - 1     { FileName() - get all files }
  191.       ELSE
  192.        BlockMove(params[1]^, @typeList[0], 4);
  193.                    { FileName("TYPE") }
  194.  
  195.       IF TheyChoseAFile THEN
  196.        BuildThePathName;
  197.  
  198. { PasToZero is very interesting - it is a HyperTalk command
  199.  that you can actually call from OUTSIDE of HyperCard.
  200.  You need it because HyperCard uses C format strings with
  201.  no length byte; they are terminated by a null byte. They are
  202.  actually HANDLES to C format strings. Nice work, Dan! }
  203.  
  204.       returnValue := PasToZero(fullPathName);
  205.  
  206.      END;  { WITH paramPtr^ DO }
  207.  
  208.     DisposPtr(pointer(myCPB));    { Clean Up Your Heap! }
  209.  
  210.    END;  { PROCEDURE FileName }
  211.  
  212. BEGIN
  213. END.
  214.