Otherware

home *** CD-ROM | disk | FTP | other *** search

/ Otherware / Otherware_1_SB_Development.iso / mac / developm / scnote / stdfile.018 / StdFile.p < prev next >

Wrap

Text File | 1989-04-02 | 65.3 KB | 1,913 lines

{------------------------------------------------------------------------------ # # Apple Macintosh Developer Technical Support # # Standard File Sample Application # # StdFile # # StdFile.p - Pascal Source # # Copyright ⌐ 1989 Apple Computer, Inc. # All rights reserved. # # Versions: # 1.00 04/89 # # Components: # StdFile.c April 1, 1989 # StdFile.p April 1, 1989 # StdFile.h April 1, 1988 # StdFile.r April 1, 1988 # StdFile.rsrc April 1, 1988 # CStdFile.make April 1, 1989 # PStdFile.make April 1, 1988 # OBJECTIVES ---------- This program attempts to demonstrate the following techniques: - Normal use of SFGetFile and SFPutFile - Normal use of SFPGetFile and SFPPutFile. This includes use of Custom Dialogs with handling of extra items through the implementation of a DlgHook. - First time initialization - Extra Simple buttons (Quit/Directory/ThisDir) - Radio buttons (file format, types of files to show) - Aliasing click on some buttons to clicks on other buttons - Regenerating the list of files displayed - Creating a full pathname from the reply record (using Working Directories or DirID) - Selecting a directory (ala MPW's "GetFileName -d") - Simple file filter (checks file type) - Complex file filter (looking inside the file) - Adding and deleting and extra List Manager lists. This is shown for both SFGetFile and SFPutFile. - Select multiple files using one of two methods - Replace SF's list with one of your own - Add a second list to the Dialog Box. This method is not shown explicitly. Rather, I show how to install and dispose of the actual list item. Inserting filenames into the list is left as an exercise to you, the Programmer. - Setting the starting Directory/Volume - Describe pending update event clogging NOTES ----- - This application assumes existance of HFS. It makes HFS calls and accesses HFS data structures without first checking to see if HFS exists on this machine. - In some cases, you will see me make use of a peculiar Pascal syntax: "IF <expr> THEN;". This is intentional. It gets the Pascal compiler to discard function results that I'm not interested in. ------------------------------------------------------------------------------} {$R-} {turn off range checking - we made sure the stove was off when we left!} PROGRAM SFSample; USES Types,QuickDraw,ToolUtils,Events,Controls,Windows,Dialogs,Menus,Desk, SegLoad,Files,OSEvents,Traps,Fonts,OSUtils,Resources,Memory,Packages, Lists; CONST { Low memory nasties } kSFSaveDisk = $214; { Negative of current volume refnum [WORD] } kCurDirStore = $398; { DirID of current directory [LONG] } kResLoad = $A5E; { Boolean ResLoad setting [WORD] } kTopMapHndl = $A50; { 1st map in resource list [Handle] } kHWCfgFlags = $B22; { Used to see if A/UX is running } { Resource ID's for some dialog boxes } rAboutMeDLOG = 128; rRealAboutMeDLOG = 129; rShowSelectionDLOG = 130; { Resource ID's for Standard File Dialogs } rSFPGetFileDLOG = 1000; rSFPPutFileDLOG = 1001; rGetDirectoryDLOG = 1002; rMultiFileDLOG = 1003; rListsNPutFileDLOG = 1004; rOptionsDLOG = 1005; rOptionsSubDLOG = 2000; { STR# resources } rStrMisc = 256; { Miscellaneous strings } rStrList = 257; { Used to create a List Manager list } { menubar resource number } rMenuBar = 128; { indexes for Apple menu items } mApple = 128; iAboutMe = 1; { indexes for File menu items } mFile = 129; iQuit = 1; { indexes for Edit menu items } mEdit = 130; iUndo = 1; iCut = 3; iCopy = 4; iPaste = 5; iClear = 6; { indexes for Standard File menu items } mSFile = 131; iNormalGet = 1; iNormalPut = iNormalGet + 1; iNormalPGet = iNormalPut + 1; iNormalPPut = iNormalPGet + 1; iFileFilter = iNormalPPut + 1; iGetDirectory = iFileFilter + 1; iMultiFile = iGetDirectory + 1; iListsNPutFile = iMultiFile + 1; iPutOptions = iListsNPutFile + 1; iIdleUpdates = iPutOptions + 1; iForceDirectory = iIdleUpdates+1; firstTime = -1; {the first time our hook is called, it is passed a -1} reDrawList = 101; {returning 101 as item number will cause the FILE list to be recalculated} BTNON = 1; {Control value for on} BTNOFF = 0; {Control value for off} TYPE PtrToLong = ^longint; PtrToWord = ^integer; StringHolderHdl = ^StringHolderPtr; StringHolderPtr = ^StringHolder; StringHolder = RECORD link: StringHolderHdl; title: str255; END; TwoIntsMakesALong = RECORD CASE Integer OF 1: (long: LongInt); 2: (ints: ARRAY [0..1] OF Integer); END; {TwoIntsMakesALong} VAR doneFlag : BOOLEAN; { set to TRUE when time to quit } myEvent : EventRecord; deskPart : integer; { result from FindWindow } whichWindow : WindowPtr; { used for FindWindow } dummy : Integer; flagPtr : PtrToWord; haveAUX : Boolean; { Set to TRUE if A/UX is running } theWorld : SysEnvRec; WNEIsImplemented : BOOLEAN; haveEvent : BOOLEAN; { TRUE if interesting event } reply : SFReply; { used in all SF samples } typeList : SFTypeList; { typelist for all SF samples } SFSaveDisk : PtrToWord; { pointer to SFSaveDisk value } CurDirStore : PtrToLong; { pointer to CurDirStore value } TopMapHndl : PtrToLong; { pointer to TopMapHndl handle } err : OSErr; { used in all OS calls } textOnly : Boolean; { for normal SFPPutFile sample } MySaveDisk : integer; { for normal SFPPutFile sample } freeItemBox : Rect; { for normal SFPPutFile sample } MyStr, MyStr2 : str255; { for normal SFPPutFile sample } MyCurDir : Longint; { for SetDirectory sample } CurDirValid : boolean; { for SetDirectory sample } LHandle : ListHandle; { for MultiFile and ListsNPut samples } OptionNumber : integer; { for PutOptions sample } OptionsDPtr : DialogPtr; { for PutOptions sample } firstName : StringHolderHdl; { for MultiFile } namesChanged : boolean; { for MultiFile } needToUpdate : boolean; { for MultiFile } PROCEDURE _DataInit; EXTERNAL; (** SetUpMenus ****************************************************************) (* (* Read in the menu resources and create a menu bar out of them. Draw the (* menu bar. (* (******************************************************************************) PROCEDURE SetUpMenus; VAR menuBar: Handle; BEGIN menuBar := GetNewMBar(rMenuBar); {read menus into menu bar} IF (menuBar = NIL) THEN ExitToShell; SetMenuBar(menuBar); {install menus} DisposHandle(menuBar); AddResMenu(GetMHandle(mApple), 'DRVR'); {add DA names to Apple menu} DrawMenuBar; END; (** SetRadioButton ************************************************************) (* (* Handy routine for setting the value of a radio button. Given a dialog (* pointer, and item number, and a state, this routine will take care of (* the rest. (* (******************************************************************************) PROCEDURE SetRadioButton(dialog:DialogPtr; item:integer; state:integer); VAR kind: integer; h: handle; r: rect; BEGIN GetDItem(dialog,item,kind,h,r); SetCtlValue(ControlHandle(h),state); END; (** ShowAboutMeDialog *********************************************************) (* (* Shows the obligatory vanity box. Normally shows the standard boring (* Developer Technical Support About box, but can be enlivened by holding (* the Command key when making the menu selection. Rick Blair says that in the (* future, we'll have better ones... (* (******************************************************************************) PROCEDURE ShowAboutMeDialog; VAR itemHit: Integer; BEGIN IF (BAND(myEvent.modifiers,cmdKey) = 0) THEN itemHit := Alert(raboutMeDLOG, NIL) ELSE itemHit := Alert(rRealAboutMeDLOG, NIL); END; (** PathNameFromDirID *********************************************************) (* (* Given a DirID and real vRefnum, this routine will create and return the (* full pathname that corresponds to it. It does this by calling PBGetCatInfo (* for the given directory, and finding out its name and the DirID of its (* parent. It the performs the same operation on the parent, sticking ITS (* name onto the beginning of the first directory. This whole process is (* carried out until we have processed the root directory (identified with (* a DirID of 2. (* (* NOTE: This routine is now A/UX friendly. A/UX likes sub-directories (* separated by slashes in a pathname. This routine automatically (* uses colons or slashes as separators based on the value of the (* global gHasAUX. This global must be initialized correctly for (* this routine to do its thing. However, because of this dependancy (* on the idiosyncracies of file systems, generating full pathnames (* for other than display purposes is discouraged; it's changed in (* the past when A/UX was implemented, and it may change again in (* the future it support for other file systems such as ProDOS, (* MS-DOS, or OS/2 are added. (* (******************************************************************************) FUNCTION PathNameFromDirID (DirID:longint; vRefnum:integer):str255; VAR Block : CInfoPBRec; directoryName, FullPathName : str255; BEGIN FullPathName := ''; WITH block DO BEGIN ioNamePtr := @directoryName; ioDrParID := DirId; END; REPEAT WITH block DO BEGIN ioVRefNum := vRefNum; ioFDirIndex := -1; ioDrDirID := block.ioDrParID; END; err := PBGetCatInfo(@Block,FALSE); IF haveAUX THEN BEGIN IF directoryName[1] <> '/' THEN BEGIN { If this isn't root (i.e. "/"), append a slash ('/') } directoryName := concat(directoryName, '/'); END; END ELSE BEGIN directoryName := concat(directoryName,':'); END; fullPathName := concat(directoryName,fullPathName); UNTIL (block.ioDrDirID = 2); PathNameFromDirID := fullPathName; END; (** PathNameFromWD ************************************************************) (* (* Given an HFS working directory, this routine returns the full pathname (* that corresponds to it. It does this by calling PBGetWDInfo to get the (* VRefNum and DirID of the real directory. It then calls PathNameFromDirID, (* and returns its result. (* (******************************************************************************) FUNCTION PathNameFromWD(vRefNum:longint):str255; VAR myBlock : WDPBRec; BEGIN { { PBGetWDInfo has a bug under A/UX 1.1. If vRefNum is a real vRefNum { and not a wdRefNum, then it returns garbage. Since A/UX has only 1 { volume (in the Macintosh sense) and only 1 root directory, this can { occur only when a file has been selected in the root directory (/). { So we look for this and hardcode the DirID and vRefNum. } IF (haveAUX) AND (vRefNum = -1) THEN BEGIN PathNameFromWD := PathNameFromDirID(2,-1); END ELSE BEGIN WITH myBlock DO BEGIN ioNamePtr := NIL; ioVRefNum := vRefNum; ioWDIndex := 0; ioWDProcID := 0; END; { Change the Working Directory number in vRefnum into a real vRefnum } { and DirID. The real vRefnum is returned in ioVRefnum, and the real } { DirID is returned in ioWDDirID. } err := PBGetWDInfo(@myBlock,FALSE); WITH myBlock DO PathNameFromWD := PathNameFromDirID(ioWDDirID,ioWDVRefnum) END; END; (** ShowSelection *************************************************************) (* (* This routine accepts a string as input, prepends STR#(256,4) - which (* should be "The item selected was " - and shows a NoteAlert with the (* result. (* (******************************************************************************) PROCEDURE ShowSelection(theString:str255); VAR tStr: str255; BEGIN GetIndString(tStr,rStrMisc,4); ParamText(concat(tStr,theString),'','',''); IF Boolean(NoteAlert(rShowSelectionDLOG, NIL)) THEN; END; (** ShowCancelled *************************************************************) (* (* Shows STR#(256,5) in a NoteAlert. This string says in English "The Cancel (* button was pressed." (* - Douglas Hofstadter (* (******************************************************************************) PROCEDURE ShowCancelled; VAR tStr: str255; BEGIN GetIndString(tStr,rStrMisc,5); ParamText(tStr,'','',''); IF Boolean(NoteAlert(rShowSelectionDLOG,NIL)) THEN; END; (** doNormalGet ***************************************************************) (* (* Simplest form of SFGetFile. This routine puts up a GetFile dialog with (* a request to show all files. When this is done, a check is made to see (* which of the Save or Cancel buttons were pressed. If the Save button was (* pressed, ShowSelection is called to display which file was selected. If the (* Cancel button was pressed, a dialog is shown saying so. (* (* NOTE: the second parameter - the prompt string - is ignored in SFGetFile (* calls. As noted on page I-523 of Inside Mac, it is there for (* historical reasons only. (* (******************************************************************************) PROCEDURE doNormalGet; BEGIN SFGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} NIL, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} NIL, {dlgHook} reply); {record for returned values} IF reply.good THEN ShowSelection(concat(PathnameFromWD(reply.vRefNum),reply.fName)) ELSE ShowCancelled; END; (** doNormalPut ***************************************************************) (* (* Simplest form of SFPutFile. This routine puts up a PutFile dialog with a (* prompt and suggested file name. (* (******************************************************************************) PROCEDURE doNormalPut; BEGIN SFPutFile(Point($00400040), {location} 'Save document as:', {prompt string} 'Doug', {original name} NIL, {dlgHook} reply); {record for returned values} IF reply.good THEN ShowSelection(concat(PathnameFromWD(reply.vRefNum),reply.fName)) ELSE ShowCancelled; END; (** doNormalPGet **************************************************************) (* (* SFPGetFile with Dialog Hook and Simple File Filter. Depending on the value (* of the Global variable "textOnly", it shows either TEXT files, or TEXT and (* APPL files. The value of "textOnly" is determined by the states of two (* radio buttons that are added to the dialog box. Our dlgHook routine is used (* to initialize the radio buttons and handle hits on them. When there is a (* hit on a radio button, "textOnly" is set to either TRUE or FALSE, and a (* special command is sent back to Standard File, telling it to regenerate (* the list of file names it is displaying. This sample consists of 3 parts: (* (* doNormalPGet - Called by doCommand. This routine initializes a variable (* for our file filter, and then calls SFPGetFile with pointers to (* two other routines and a resource number for a special dialog box (* with extra items in it. (* (* SimpleFileFilter - Specified in our SFPGetFile call to be called to (* specify whether or not a file should be displayed. All TEXT files (* are displayed. If the global variable 'textOnly' is FALSE, then (* applications (APPL files) are also displayed. NO other files are (* displayed. (* (* MySFGetHook - A routine that is called to handle hits on the non-standard (* items in our dialog box. These items are: (* - 2 radio buttons that affect the setting of the 'textOnly' (* variable, (* - a Quit button that causes the GetFile dialog box to be put (* away (like pressing Cancel), but also causes this demo to be (* exitted. (* (* The dlgHook is also used to perform some special initialization (* on the items in the dialog box. Standard file does this by calling (* this routine with a bogus 'item' number of -1. When we get this (* number, we initialize our radio buttons, and change the text in the (* Open button. (* (* The radio buttons are used to determine what files will appear in (* the files list. It does this by apporpriately setting the 'textOnly' (* variable for SimpleFileFilter, and then telling Standard File that (* the file list needs to be regenerated by passing back 101 as the (* the function result. (* (* The Quit button causes the dialog box to go away by returning the (* 'getCancel' to Standard File. It also sets the 'doneFlag' variable (* to TRUE for our MainEventLoop to notice. (* (******************************************************************************) FUNCTION MySFGetHook(MySFitem: integer; theDialog: DialogPtr): integer; CONST textButton = 11; {DITL item number of textButton} textAppButton = 12; {DITL item number of textAppButton} quitButton = 13; {DITL item number of quitButton} VAR itemToChange : Handle; {needed for GetDItem and SetCtlValue} itemBox : Rect; {needed for GetDItem} itemType : integer; {needed for GetDItem} buttonTitle : Str255; {needed for GetIndString} BEGIN { MySFGetHook is a function that requires that an item number be passed } { back from it. Normally, this is the same item number that was passed } { to us, but not necessarily. For instance, clicks on the Quit button } { get translated into clicks on the Cancel button. We could also return } { values that cause the file names to be redrawn or have the whole event } { ignored. However, by default, we'll return what was sent to us. } MySFGetHook := MySFitem; CASE MySFitem OF firstTime: BEGIN { Before the dialog is drawn, our hook gets called with a -1. } { This gives us the opportunity to change things like Button titles, etc. } { Set the textAppButton to OFF, the textButton to ON } SetRadioButton(theDialog,textAppButton,BTNOFF); SetRadioButton(theDialog,textButton,BTNON); { Get the Button title from the resource fork. If we can't get the } { resource, we just won't change the open Button's title} GetIndString(buttonTitle,rStrMisc,1); IF buttonTitle <> '' THEN BEGIN { if we really got the resource} GetDItem(theDialog,getOpen,itemType,itemToChange,itemBox); SetCTitle(ControlHandle(itemToChange),buttonTitle); END; END; {firstTime} textButton: BEGIN { Turn the textAppButton OFF, the textButton ON and redraw the list} IF NOT textOnly THEN BEGIN SetRadioButton(theDialog,textAppButton,BTNOFF); SetRadioButton(theDialog,textButton,BTNON); textOnly := TRUE; MySFGetHook := reDrawList; {we must tell SF to redraw the list} END; END; textAppButton: BEGIN { Turn the textButton OFF, the textAppButton ON and redraw the list} IF textOnly THEN BEGIN SetRadioButton(theDialog,textButton,BTNOFF); SetRadioButton(theDialog,textAppButton,BTNON); textOnly := FALSE; MySFGetHook := reDrawList; {we must tell SF to redraw the list} END; END; quitButton: BEGIN { Alias clicks on the Quit button to clicks on the Cancel Button. Also, } { set 'doneFlag' to TRUE so that the MainEventLoop terminates. } MySFGetHook := getCancel; {Pass SF back a 'cancel Button'} doneFlag := TRUE; END; END; END; FUNCTION SimpleFileFilter(p: ParmBlkPtr): BOOLEAN; BEGIN SimpleFileFilter := TRUE; {Don't show it -- default} { If we have a 'TEXT' file, or we have an 'APPL' file and 'textOnly' is } { FALSE, then signify that we should show the file by returning FALSE } WITH p^.ioFlFndrInfo DO IF ((fdType = 'TEXT') OR (NOT(textOnly) AND (fdType = 'APPL'))) THEN SimpleFileFilter := FALSE; {Show it} END; PROCEDURE doNormalPGet; BEGIN textOnly := TRUE; SFPGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} @SimpleFileFilter, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} @MySFGetHook, {dlgHook} reply, {record for returned values} rSFPGetFileDLOG, {ID of Custom Dialog} NIL); {ModalDialog filterProc} END; (** doNormalPPut **************************************************************) (* (* Normal SFPPutFile sample. This custom PutFile routine adds several new (* to the dialog box. There are 2 radio buttons that determine what format (* the user wants to save the information in. There is a Quit buttons that (* will cause us to leave this program. And there is a Static Text item that (* displays the amount of free space left on the disk. This text item is (* updated whenever we detect that the volume we are currently looking at is (* not the same as the last volume we looked at. Therefore, we maintain a (* variable called MySaveDisk to track this. This sample consists of 3 parts: (* (* doNormalPPut - This routine, called by doCommand, calls SFPPutFile. Note (* the extra 'P' in the name. This toolbox call allows us to specify a (* customized dialog box, and dlgHook that handles hits on special (* items. (* (* MySFPutHook - A routine that is called to handle the non-standard items (* in our dialog box. These items are: (* - 2 radio buttons that affect the setting of the 'textOnly' (* variable, (* - a Quit button that causes the GetFile dialog box to be put (* away (like pressing Cancel), but also causes this demo to be (* exitted, (* - a UserItem that displays the amount of free space on the (* current volume. (* (* The dlgHook is also used to perform some special initialization (* on the items in the dialog box. Standard file does this by calling (* this routine with a bogus 'item' number of -1. When we get this (* number, we initialize our radio buttons, change the text in the (* save button, and prepare the user item by initializing the routine (* that will draw it and getting the text that will appear in it. (* (* The radio buttons are used to determine what format the file will be (* saved in. They are functionless in this sample, merely changing (* their state and setting a global variable for possible use later. (* (* The Quit button causes the dialog box to go away by returning the (* 'putCancel' to Standard File. It also sets the 'doneFlag' variable (* to TRUE for our MainEventLoop to notice. (* (* Finally, this routine performs one other function. When SFPPutFile (* is called, we make note of the current volume (the one that will (* be displayed in the dialog box). This routine is responsible for (* checking to see whenever we change volumes, and to update the (* Free Space notice accordingly. It does this by looking at the value (* stored at SFSaveDisk. Whenever that value changes, we have changed (* volumes and need to make a PBHGetVInfo call to find out how much (* room is left on the disk. (* (* DrawFreeSpaceItem - used to draw a user item that displays the amount of (* free space left on the disk. (* (******************************************************************************) PROCEDURE DrawFreeSpaceItem(theWindow: WindowPtr; itemNo: Integer); BEGIN TextBox(Pointer(Ord(@myStr) + 1),length(myStr),freeItemBox,teJustCenter); END; FUNCTION MySFPutHook(MySFitem: Integer; theDialog: DialogPtr): Integer; CONST quitButton = 9; {DITL item number of quitButton} textButton = 10; {DITL item number of textButton} FormatButton = 11; {DITL item number of FormatButton} FreeSpaceItem = 12; {DITL item number of free space static text} VAR itemToChange : Handle; {needed for GetDItem and SetCtlValue} itemType : Integer; {needed for GetDItem} itemBox : Rect; {needed for GetDItem} myHPB : HParamBlockRec; convert : TwoIntsMakesALong; BEGIN {MySFHook} { MySFPutHook is a function that requires that an item number be passed } { back from it. Normally, this is the same item number that was passed } { to us, but not necessarily. For instance, clicks on the Quit button } { get translated into clicks on the Cancel button. We could also return } { values that cause the file names to be redrawn or have the whole event } { ignored. However, by default, we'll return what was sent to us. } MySFPutHook := MySFitem; { Before the dialog is drawn, our hook gets called with a -1. } { This gives us the opportunity to change things like Button titles, etc. } IF (MySFitem = firstTime) THEN BEGIN { Set the FormatButton to ON, the textButton to OFF} SetRadioButton(theDialog,formatButton,BTNON); SetRadioButton(theDialog,textButton,BTNOFF); textOnly := FALSE; { Get the text for the Save button from the resource fork. } { If we can't get the resource, we just won't change the Button's title} GetIndString(myStr,rStrMisc,1); IF myStr <> '' THEN BEGIN {if we really got the resource} GetDItem(theDialog,putSave,itemType,itemToChange,itemBox); SetCTitle(ControlHandle(itemToChange),myStr); END; { Set up our routine to draw our user item } GetDItem(theDialog,FreeSpaceItem,itemType,itemToChange,freeItemBox); SetDItem(theDialog,FreeSpaceItem,itemType,Handle(@DrawFreeSpaceItem), freeItemBox); { Get the text to be used in our user item. } GetIndString(myStr2,rStrMisc,2); END; {if MySFItem = firstTime } { Check to see if we have changed drives. If so, then we need to update } { the text in our UserItem. } IF (MySaveDisk <> SFSaveDisk^) THEN BEGIN WITH myHPB DO BEGIN { set up the block for the PBHGetVInfo call} ioNamePtr := NIL; { we don't care about the name} ioVRefNum := -(SFSaveDisk^); ioVolIndex := 0; { use ioVRefNum only} END; {with} err := PBHGetVInfo(@myHPB,FALSE); IF (err = noErr) THEN BEGIN convert.ints[0] := 0; convert.ints[1] := myHPB.ioVFrBlk; NumToString((convert.long * myHPB.ioVAlBlkSiz) DIV 1024,myStr); END ELSE {else Handle error - we can't get the free space size!} myStr := '??'; { Add the file size to 'K free' (or whatever) } myStr := concat(myStr,myStr2); { Draw the new freeBlocks in our userItem } DrawFreeSpaceItem(theDialog,FreeSpaceItem); { SFSaveDisk changed, so we need to update mySaveDisk} MySaveDisk := SFSaveDisk^; END; {IF mySaveDisk <> SFSaveDisk^} CASE MySFitem OF textButton: BEGIN { Turn the FormatButton OFF, the textButton ON } IF NOT textOnly THEN BEGIN SetRadioButton(theDialog,formatButton,BTNOFF); SetRadioButton(theDialog,textButton,BTNON); textOnly := TRUE; { change our flag accordingly } END; {if not textOnly} END; {textOnlyButton} FormatButton: BEGIN { Turn the textButton OFF, the FormatButton ON } IF textOnly THEN BEGIN SetRadioButton(theDialog,textButton,BTNOFF); SetRadioButton(theDialog,formatButton,BTNON); textOnly := FALSE; { change our flag accordingly } END; {if not textOnly} END; {FormatButton} quitButton: BEGIN MySFPutHook := putCancel; {Pass SF back a 'cancel Button'} doneFlag := TRUE; END; END; {case} END; {MySFHook} PROCEDURE doNormalPPut; BEGIN SFPPutFile(Point($00400040), {location} 'Save document as:', {prompt string} 'Doug', {original name} @MySFPutHook, {dlgHook} reply, {record for returned values} rSFPPutFileDLOG, {ID of custom Dialog} NIL); {ModalDialog filterProc} END; (** ComplexFileFilter *********************************************************) (* (* Sample of a less trivial file filter. This routine is responsible for (* displaying only files that have 'ALRT' resources. It shows how to (* correctly look inside a file for qualifying information, and demonstrates (* how to get around a particular quirk when attempting multiple access to (* the resource fork. (* (* In order to save time, the first thing we do is turn off resource loading; (* we just want to count the number of ALRT resources, and don't care about (* the actual data itself. So I save off the current ResLoad setting, and (* then set it to FALSE. (* (* I then prepare to open the resource fork of the file. However, I can't (* simply call OpenResFile. OpenResFile only works for files that are in (* the default directory. Standard file makes HFS calls when it can, and (* explicitly uses DirIDs when getting file names and other information. (* Therefore, I can't count on the default directory being set to the dir- (* ectory that we are examining. In order to call OpenResFile, I have to set (* the default directory. (* (* So I take the VRefNum and DirID passed to me, and I create a Working (* Directory from them. I save the old default directory, and then set it (* to the WD I just created. (* (* So far, so good. I am now ready to open the resource fork of the file, (* call Count1Resources (which limits enumeration to the current file only, (* excluding other files in the resource chain), and close the file. But (* wait! I must make sure that I am not closing a file that I don't really (* want to close. For example, one of the files I may be examining may be (* myself. If I were to blindly close that file, I would be closing my CODE (* resources, removing them from memory. Empirical experience has told me that (* this is not good. (* (* So I have to make sure that I don't close my own resource fork. I could (* possibly check the refnum that I get back from OpenResFile against one (* that I could get by calling CurResFile at the start of the program. If (* they match, then I am looking at my own file, and I shouldn't close it. But (* this doesn't work always. For instance, I also want to make sure that I (* don't close the System Resource file when I point and click my way into (* the System Folder. What if there are DA's open? I don't want to close them. (* How about the Fonts/DA's file used by Suitcase? What about the DeskTop (* file? Basically, I need a way to determine on the fly if a resource file (* is already open before I try to open it myself. (* (* Well, there is a way. Within the parameter block passed to me is a field (* called ioFlAttrib. It is described on page IV-122 of Inside Mac. As (* described there, bit 2 contains the state of the resource fork. If the fork (* is open, then the bit is set. All that is necessary for me to do is check (* the state of this bit before I open the file. If the bit is clear, then (* I need to close the file when I am done. (* (* But wait! There's more. This technique - alas! - will not work under (* MultiFinder! Why? Because this bit is set even if another program in (* another partition has the resource fork open. I would test that bit, find (* that the file is open, open the file for myself, count the number of (* resources, and then leave the file open. This now leaves another resource (* file in the resource chain - one that wasn't there before and that (* shouldn't be there now. Another technique is needed. (* (* Fortunately, one is at hand. On page I-115 of Inside Mac is a brief (* description of a low-memory variable called TopMapHndl. This contains (* a handle to the resource map of the first resource file in the chain. (* Since a resource file is made the current resource file when OpenResFile (* is called if it is actually being opened, we can test the value of (* TopMapHndl to see if the file was really opened. If the value of TopMapHndl (* changes after OpenResFile, then the resource fork was open for this (* application, and should be closed when we are done with it. If TopMapHndl (* doesn't change, then no new resource maps were added to the chain; no (* new files were opened. Therefore, the file doesn't need to be closed later. (* So far, this solution seems to be the best. (* (* After doing all of this, we are almost done. All that needs to be done is (* restore the default directory and the value of ResLoad to their previous (* settings. When we have done so, we can return to Standard File. (* (******************************************************************************) FUNCTION ComplexFileFilter(p: ParmBlkPtr): BOOLEAN; TYPE LongPtr = ^longint; BoolPtr = ^Boolean; VAR refnum,tRefnum : integer; WDRec : WDPBRec; oldVol,newVol : ParamBlockRec; tBPtr : BoolPtr; oldResLoad, closeIt : Boolean; tHandle: handle; BEGIN { Save the current setting of ResLoad. Then set it to FALSE. } tBPtr := BoolPtr(kResLoad); oldResLoad := tBPtr^; SetResLoad(FALSE); ComplexFileFilter := TRUE; { Don't show it -- default } { Save the current default directory/volume. } oldVol.ioNamePtr := NIL; err := PBGetVol(@oldVol,FALSE); { Create a working directory for the directory we are examining. } WITH WDRec DO BEGIN ioNamePtr := NIL; ioVRefNum := p^.ioVRefNum; ioWDProcID := longint('ERIK'); ioWDDirID := CurDirStore^; END; err := PBOpenWD(@WDRec,FALSE); { Set the Working Directory we just created to be the default. } WITH newVol DO BEGIN ioNamePtr := NIL; ioVRefNum := WDRec.ioVRefNum; END; err := PBSetVol(@newVol,FALSE); { Check the current value of TopMapHndl, open the resource file, and } { check it again. If it changed, then note that we should close this } { file later when we are done with it. } tHandle := handle(TopMapHndl^); refnum := OpenResFile(str255(p^.ioNamePtr^)); IF (tHandle <> handle(TopMapHndl^)) THEN closeIt := TRUE ELSE closeIt := FALSE; { If we successfully opened the file, then count the number of ALRT } { resources in it. Call UseResFile to make sure that the file we just } { 'opened' is the current one. We have to do this, as OpenResFile will } { not make the file the current one if it is already open. So save the } { current resFile, (possibly) change it to the one we want, read the } { number of ALRT resources in it, and then set the current resource } { file back to what it was. Finally, if we need to close the file we } { opened, do so. } IF (ResError = noErr) THEN BEGIN tRefNum := CurResFile; UseResFile(refNum); IF (Count1Resources('ALRT') > 0) THEN ComplexFileFilter := FALSE; UseResFile(tRefNum); IF closeIt THEN CloseResFile(refnum); END; { All done! Reset the default directory and ResLoad, and then blow. } err := PBSetVol(@oldVol,FALSE); err := PBCloseWD(@WDRec,FALSE); SetResLoad(oldResLoad); END; PROCEDURE doFileFilter; BEGIN SFGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} @ComplexFileFilter, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} NIL, {dlgHook} reply); {record for returned values} END; (** doGetDirectory ************************************************************) (* (* Shows how to modify SFGetFile to allow you to select a directory. This (* mimics the "GetFileName -d" function of MPW. As a matter of fact, the (* DLOG and DITL used in this sample are taken directly out of MPW. (* (* There are 2 major additions in the dialog used in this sample: (* - a Simple button that lets one select the directory that is (* currently highlighted in the list of directories, (* - a Simple button at the top of the dialog that lets the user select (* the directory that we are currently *IN*. (* (* No new techniques are really used in this sample. Hits on the two simple (* buttons are handled by a dlgHook called MyGetDirHook. Depending on (* which button is hit, we set the global variable MyCurDir to either (* reply.fType (for the currently highlighted directory) or CurDirStore^ (for (* the directory that we are currently in). We then simulate a hit on the (* Cancel button so that Standard File will return to our application. (* (* However, when we get back to our application, there is no way for it to (* determine if we simulated a click on the Cancel Button, or if the user (* actually clicked on it; reply.good will be FALSE in either case. So we also (* set the value of global variable CurDirValid to TRUE if we only simulated (* a click on Cancel. (* (* We also use the "Item = -1" feature to set up a prompt string and init- (* alize the value of CurDirValid to FALSE. (* (******************************************************************************) FUNCTION MyGetDirHook(item: integer; dPtr: DialogPtr):integer; CONST { Equates for the items that I've added } getDirButton = 11; getDirNowButton = 12; getDirMessage = 13; VAR messageTitle: str255; h:Handle; kind:integer; r:rect; BEGIN { By default, return the item passed to us. } MyGetDirHook := item; CASE item OF firstTime: BEGIN { Read in the prompt string from the resource fork, and initialize } { CurDirValid to FALSE. } GetIndString(messageTitle,rStrMisc,3); GetDItem(dPtr,getDirMessage,kind,h,r); SetIText(h,messageTitle); CurDirValid := FALSE; END; getDirButton: BEGIN IF LONGINT(reply.fType) <> 0 THEN BEGIN MyCurDir := LONGINT(reply.fType); myGetDirHook := getCancel; CurDirValid := TRUE; END; END; getDirNowButton: BEGIN MyCurDir := CurDirStore^; myGetDirHook := getCancel; CurDirValid := TRUE; END; END; END; FUNCTION FoldersOnly(p:ParmBlkPtr):BOOLEAN; { Normally, folders are ALWAYS shown, and aren't even passed to } { this file filter for judgement. Under such circumstances, it is } { only necessary to blindly return TRUE (allow no files whatsoever). } { However, Standard File is not documented in such a manner, and } { this feature may not be TRUE in the future. Therefore, we DO check } { to see if the entry passed to us describes a file or a directory. } BEGIN FoldersOnly := TRUE; IF BTst(p^.ioFlAttrib,4) THEN FoldersOnly := FALSE; END; PROCEDURE doGetDirectory; BEGIN SFPGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} @FoldersOnly, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} @MyGetDirHook, {dlgHook} reply, {record for returned values} rGetDirectoryDLOG, NIL); IF CurDirValid THEN ShowSelection(PathnameFromDirID(MyCurDir,-(SFSaveDisk^))) END; (** MultiFile *****************************************************************) (* (* WARNING! The following is an experiment that failed! I was playing around (* with different ways for implementing a facility for multiple (* file handling. This was one of them. As with all experiments that (* fail, it's pretty ugly. The following should NOT be used as a (* sample on how to do things right, but as a lesson on how NOT to (* do things. (* (* This sample is an attempt to implement the facilty to let the user choose (* more than one file at once. It does this by remembering all of the files (* passed to the fileFilter, and using those names to create a new, application (* governed filename list that will replace the one displayed by Standard File. (* However, this experiment seems doomed to failure, for the following reasons: (* (* - Icons are not displayed next to the names of files. The resulting (* presentation is more disconcerting that I thought. (* - The current directory button (the one displayed above the list of (* filenames) disappears. This seems due to the fact that that pop-up (* menu-like item is not actually a dialog item, and is somehow attached (* to the list of filenames handled by Standard File. Since I move that (* list off of the window so that I can display my own, the current (* directory button seems to go with it. (* - Updating the list is difficult. The normal sequence of events would (* desirably be: 1) have the fileFilter create a linked list of names (* to appear in the dialog, 2) insert those names into the List Manager (* list, and 3) display the list. However, by following this outine, (* the list does not get updated, as the update region for that area (* is empty. So, at some time, we need to invalidate the area (* that holds our list. But there is no convenient place in which to (* do that. We can't call InvalRect within our fileFilter routine, as (* we don't have the DialogPtr at the time (needed to get the bounding (* rectangle of the list item). Neither can we call InvalRect within (* step 2, as we are between BeginUpdate/EndUpdates, and calling (* InvalRect would be useless. (* - We can't display directories. They are not offered to the judgement (* of our fileFilter, and hence cannot be added to our list. (* - Key presses would have do be handled manually by our dlgHook. (* (* Our thesis is implemented as described, with all of the above limitations. (* What follows is a description of the routines used: (* (* ScoopNames - The fileFilter routine that is responsible for remembering (* the names of all the files passed to it by Standard file. The names (* are stored in a singly linked list of handles. Each handle contains (* a Str255 to hold the name, and room for the handle for the next name. (* The root of the list is stored in the global variable 'firstName'. (* The list is used by SetNames to set the data for the list cells. (* (* MultiFileHook - Creates the list and installs it as a user item. Also, (* we check on NULL events to see if our list needs to be updated. If (* so, we call InvalRect to force it to be redrawn. Finally, this (* routine disposes of the list if Open or Cancel are pressed. (* (* MFModalFilter - Calls LClick for MouseDowns on the list. (* (* MFDrawList - Redraws the list. If there are new names to be displayed, then (* they are inserted into the cells. Then LUpdate is called to redraw (* the list. (* (* SetNames - Called by MFDrawList when FirstName is <> NIL, indicating that (* there are new names to be displayed. We first get a count of the (* number of names in the linked list, and the List Manager list is (* adjusted accordingly. Then, the linked list is traversed, with each (* name being inserted into its appropriate cell. The nodes of the (* linked list are disposed of along the way. When everything is done, (* the List Manager list is appropriately set up, and the linked list is (* disposed of, with FirstName = NIL. (* (******************************************************************************) PROCEDURE SetNames; VAR nextName: StringHolderHdl; count: integer; delta: integer; theCell: Cell; BEGIN nextName := firstName; count := 0; IF (nextName <> NIL) THEN BEGIN REPEAT count := count + 1; nextName := nextName^^.link; UNTIL (nextName = NIL); END; delta := count - LHandle^^.databounds.bottom; IF (delta < 0) THEN {need to remove this many cells} LDelRow(-delta,0,LHandle) ELSE IF (delta > 0) THEN {need to add this many cells} IF boolean(LAddRow(delta,LHandle^^.databounds.bottom,LHandle)) THEN; theCell.h := 0; theCell.v := count-1; REPEAT HLock(handle(firstName)); WITH firstName^^ DO LSetCell(ptr(@title[1]),integer(title[0]),theCell,LHandle); HUnlock(handle(firstName)); nextName := firstName^^.link; DisposHandle(handle(firstName)); firstName := nextName; theCell.v := theCell.v - 1; UNTIL (firstName = NIL); namesChanged := FALSE; END; PROCEDURE MFDrawList(theWindow:WindowPtr; item:integer); CONST ListItem = 11; VAR kind: integer; h: handle; r: rect; BEGIN IF (item = ListItem) THEN BEGIN GetDItem(theWindow,ListItem,kind,h,r); EraseRect(r); FrameRect(r); LUpdate(theWindow^.visRgn,LHandle); IF (namesChanged) THEN SetNames; END; END; FUNCTION MFModalFilter(theDialog:DialogPtr; VAR theEvent:EventRecord; VAR itemHit:integer):boolean; VAR doubleClick : boolean; localPt : Point; BEGIN IF (theEvent.what = mouseDown) THEN BEGIN localPt := theEvent.where; GlobalToLocal(localPt); doubleClick := LClick(localPt,theEvent.modifiers,LHandle); { should check for double clicks here } END; MFModalFilter := FALSE; END; FUNCTION MultiFileHook(item: integer; dPtr: DialogPtr):integer; CONST ListItem = 11; VAR kind: integer; h: handle; r: rect; rView,dataBounds: rect; BEGIN CASE item OF firstTime: BEGIN GetDItem(dPtr,ListItem,kind,h,r); SetDItem(dPtr,ListItem,kind,handle(@MFDrawList),r); rView := r; rView.right := rView.right - 15; InsetRect(rView,1,1); dataBounds.topLeft := Point(0); dataBounds.bottom := 0; databounds.Right := 1; LHandle := LNew(rView, { position in window } dataBounds, { initial size of array } Point(0), { cell size (0 = default) } 0, { resource ID of LDEF } dPtr, { window pointer } TRUE, { drawit } FALSE, { has grow } FALSE, { scrollHoriz } TRUE); { scrollVert } END; 100: BEGIN IF (needToUpdate) THEN BEGIN GetDItem(dPtr,ListItem,kind,h,r); InvalRect(r); needToUpdate := FALSE; END; END; getOpen,getCancel:BEGIN LDispose(LHandle); { Our linked list of names was already disposed } { of in SetNames, so nothing else to do here... } END; END; MultiFileHook := item; END; FUNCTION ScoopNames(pb: ParmBlkPtr):BOOLEAN; VAR nextName : stringHolderHdl; BEGIN nextName := StringHolderHdl(NewHandle(sizeof(stringHolder))); HLock(handle(nextName)); nextName^^.title := str255(pb^.ioNamePtr^); nextName^^.link := firstName; firstName := nextName; HUnlock(handle(nextName)); namesChanged := TRUE; needToUpdate := TRUE; ScoopNames := FALSE; {show everything} END; PROCEDURE doMultiFile; BEGIN firstName := NIL; namesChanged := FALSE; SFPGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} @ScoopNames, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} @MultiFileHook, {dlgHook} reply, {record for returned values} rMultiFileDLOG, {ID of Custom Dialog} @MFModalFilter); {ModalDialog filterProc} END; (** doListsNPutFile ***********************************************************) (* (* This sample demonstrates putting a List Manager list into an SFPPutFile (* dialog, describes a problem that can occur by doing so, and shows one (* solution to the problem. (* (* Putting another list into a Standard File dialog can be useful for a number (* of reasons. One of them was shown above, where we attempted to replace (* Standard File's list with one of our own. However, the failure we met with (* there forces us to look for another solution. This solution could possibly (* take place in the form of TWO lists: one supplied by Standard file, and the (* other handled by us to hold the multiple file names. (* (* While the actual logistics of putting the selected filenames into the list (* as they are selected is left to you, the Programmer, I do show how to (* create and handle the list. (* (* While *I* can't think of a reason for wanting to put a second list into (* a PutFile dialog, it is possible that you may wish to. However, there is (* a subtle problem that arises if you do: that of determining when to (* dispose of the list. In the MultiFile example above, we were perfectly (* justified in disposing of the list when the user clicked on Open or (* Cancel. However, in the following example, if were to dispose of the list (* when the user clicked on Save, we may hit a snag. It is possible for the (* user to specify the name of a file that alreay exists. When that happens, (* s/he is presented with another dialog that asks if they are sure of what (* they are doing. At that point, the user could press Cancel, and return us (* to the PutFile dialog, SANS our 2nd list! Neither can we defer disposing (* of list until Standard File is done and returns to our application, as the (* Dialog box we were using is gone, and the List Manager try to perform an (* InvalRect on a non-existant window when it erases its list. (* (* There are two solutions to this problem: (* (* 1) Implement the list as a Custom Control. Then, when it somes time to (* close the dialog box, the custom control will get called with a (* dispCntl message. It can take that opportunity to call LDispose. (* (* This technique is not presented here, as it is more appropriate (* for a Custom Control Sample program. However, it is the suggested (* way to proceed. (* (* 2) Ensure that the confirmation dialog box never comes up under Standard (* File's control. By calling it ourself, we know what the user chooses. (* If the user presses OK, we delete the offending file, dispose of our (* list, and return to Standard File. If the user presses Cancel, we (* change the click on the Save button into a NULL event. This is the (* algorithm we use below. (* (* There is a major disadvantage with this approach, however. With it, (* we cannot implement a safe saving procedure. Normally, the best way (* to save a file (disk space permitting), is to save the data to a (* temporary file, delete the original, and then rename the temporary (* file to that of the original. However, with approach #2, the file (* is deleted well before it is safe to do so. (* (* This routine *could* be reworked to avoid this problem. For instance, (* instead of being deleted, the offending file could be renamed to (* something else or moved to another directory. (* (******************************************************************************) PROCEDURE LNPFDrawList(theWindow:WindowPtr; item:integer); CONST ListItem = 9; VAR kind: integer; h: handle; r: rect; BEGIN IF (item = ListItem) THEN BEGIN GetDItem(theWindow,ListItem,kind,h,r); FrameRect(r); LUpdate(theWindow^.visRgn,LHandle); END; END; FUNCTION LNPFModalFilter(theDialog:DialogPtr; VAR theEvent:EventRecord; VAR itemHit:integer):boolean; VAR localPt : Point; BEGIN IF (theEvent.what = mouseDown) THEN BEGIN localPt := theEvent.where; GlobalToLocal(localPt); IF LClick(localPt,theEvent.modifiers,LHandle) THEN; END; LNPFModalFilter := FALSE; END; FUNCTION ListsNPutFileHook(item: integer; dPtr: DialogPtr):integer; CONST ListItem = 9; ExistingFileALRT = -3996; VAR kind: integer; h: handle; r: rect; rView,dataBounds: rect; count: integer; entry: str255; theCell: Cell; choice: integer; fndrInfo: FInfo; WDRec: WDPBRec; AlertHandle: handle; dLoc: point; BEGIN ListsNPutFileHook := item; CASE item OF firstTime: BEGIN GetDItem(dPtr,ListItem,kind,h,r); SetDItem(dPtr,ListItem,kind,handle(@LNPFDrawList),r); rView := r; rView.right := rView.right - 15; InsetRect(rView,1,1); dataBounds.topLeft := Point(0); dataBounds.bottom := 0; databounds.Right := 1; LHandle := LNew(rView, { position in window } dataBounds, { initial size of array } Point(0), { cell size (0 = default) } 0, { resource ID of LDEF } dPtr, { window pointer } TRUE, { drawit } FALSE, { has grow } FALSE, { scrollHoriz } TRUE); { scrollVert } theCell := point(0); REPEAT GetIndString(entry,rStrList,theCell.v + 1); IF (entry <> '') THEN BEGIN IF boolean(LAddRow(1,LHandle^^.dataBounds.bottom,LHandle)) THEN; LSetCell(@entry[1],integer(entry[0]),theCell,LHandle); END; theCell.v := theCell.v + 1; UNTIL (entry = ''); END; putSave: BEGIN WITH WDRec DO BEGIN ioNamePtr := NIL; ioVRefNum := -(SFSaveDisk^); ioWDProcID := longint('ERIK'); ioWDDirID := CurDirStore^; END; err := PBOpenWD(@WDRec,FALSE); err := GetFInfo(reply.fName,WDRec.ioVRefNum,fndrInfo); IF (err = noErr) THEN BEGIN ParamText(reply.fName,'','',''); { Before bringing up the Alert that asks for confirmation, we } { have to relocate it. To start with, the window is located at } { 0,0 in the Window Manager port. To move the Alert Window, read } { the resource into memory and change the boundsRect field so } { that its topleft is at 12,100 within Standard File's dialog. } AlertHandle := GetResource('ALRT',ExistingFileALRT); dLoc := dPtr^.portRect.topleft; { get global location of SF's } LocalToGlobal(dLoc); { dialog box. } WITH AlertTHndl(AlertHandle)^^.boundsRect DO BEGIN right := right - left; { get width and height of the Alert } bottom := bottom - top; { into botRight. } left := dLoc.h + 12; { Change Alert.TopLeft to SF.Dlog.TopLeft } top := dLoc.v + 100; { plus 12,100. } right := right + left; { Adjust Alert.BotRight accordingly. } bottom := bottom + top; END; choice := Alert(ExistingFileALRT,NIL); IF (choice = Cancel) THEN BEGIN {the OK button is in the Cancel slot} err := FSDelete(reply.fName,WDRec.ioVRefNum); LDispose(LHandle); END ELSE BEGIN ListsNPutFileHook := 100; {Change "Save" into null event} END; END; END; putCancel:BEGIN LDispose(LHandle); END; END; END; PROCEDURE doListsNPutFile; VAR vRefNum: integer; BEGIN err := GetVol(NIL,vRefNum); err := Create('Doug',vRefNum,'KAAR','APPL'); SFPPutFile(Point($00400040), {location} 'Save document as:', {prompt string} 'Doug', {original name} @ListsNPutFileHook, {dlgHook} reply, {record for returned values} rListsNPutFileDLOG, {ID of custom Dialog} @LNPFModalFilter); {ModalDialog filterProc} END; (** doPutOptions **************************************************************) (* (* Apple's suggested options box - A modest proposal. (* (* With the proliferation of applications and different file types, many (* developers are allowing the user to select from various file formats they (* want to save their data as. In an effort to maintain consistancy among (* all applications in this respect, we are presenting a sample interface for (* letting the user select the file type they want. (* (* This is done by adding 2 items to the PutFile dialog box. One is a text (* item that displays the file format that the file will be saved as. The (* second is an "Options╔" button that brings up another dialog box. This (* dialog box conatins a series of radio buttons next to the names of the (* various file formats supported by the application. Also in the second (* dialog box are OK and Cancel buttons. After a selection has been made (* by the user, the text in the PutFile dialog is updated accordingly. (* (******************************************************************************) PROCEDURE SetFormatString(number:integer; theDialog:DialogPtr); CONST FormatString = 10; VAR kind: integer; h: handle; r: rect; title: str255; BEGIN GetDItem(OptionsDPtr,OptionNumber,kind,h,r); GetCTitle(ControlHandle(h),title); GetDItem(theDialog,formatString,kind,h,r); SetIText(h,title); END; PROCEDURE DrawFrame(theWindow: WindowPtr; itemNo: integer); VAR kind: integer; h: handle; r: rect; ps: PenState; BEGIN GetDItem(theWindow,itemNo,kind,h,r); GetPenState(ps); PenSize(2,2); FrameRect(r); SetPenState(ps); END; PROCEDURE doOptionsDialog(VAR item:integer); VAR newItem: integer; itemHit: integer; BEGIN newItem := OptionNumber; SelectWindow(OptionsDPtr); ShowWindow(OptionsDPtr); REPEAT ModalDialog(NIL,itemHit); IF ((itemHit <> newItem) AND (itemHit > 2)) THEN BEGIN SetRadioButton(OptionsDPtr,newItem,BTNOFF); SetRadioButton(OptionsDPtr,itemHit,BTNON); newItem := itemHit; END; UNTIL ((itemHit = OK) OR (itemHit = Cancel)); HideWindow(OptionsDPtr); IF (itemHit = OK) THEN item := newItem; END; FUNCTION PutOptionsHook(item: Integer; theDialog: DialogPtr): Integer; CONST FirstRadioButton = 3; OptionsButton = 9; FrameItem = 10; VAR kind: integer; h: handle; r: rect; BEGIN PutOptionsHook := item; CASE item OF firstTime: BEGIN OptionNumber := FirstRadioButton; SetRadioButton(OptionsDPtr,OptionNumber,BTNON); SetFormatString(OptionNumber,theDialog); GetDItem(OptionsDPtr,FrameItem,kind,h,r); SetDItem(OptionsDPtr,FrameItem,kind,handle(@DrawFrame),r); END; OptionsButton: BEGIN doOptionsDialog(OptionNumber); SetFormatString(OptionNumber,theDialog); END; END; END; PROCEDURE doPutOptions; BEGIN OptionsDPtr := GetNewDialog(rOptionsSubDLOG,NIL,WindowPtr(-1)); SFPPutFile(Point($00400040), {location} 'Save document as:', {prompt string} 'Doug', {original name} @PutOptionsHook, {dlgHook} reply, {record for returned values} rOptionsDLOG, {ID of custom Dialog} NIL); {ModalDialog filterProc} DisposDialog(OptionsDPtr); END; (** doIdleUpdates *************************************************************) (* (* There is a problem that Standard File has with updates pending in (* background windows in the current application partition. (* (* Standard File calls ModalDialog at the heart of its Main Event Loop. (* ModalDialog calls GetNextEvent, and then calls a filterProc internal (* to Standard File. This filterProc performs some processing on the event, (* (like handling hits on the filename list, the Current Directory button, and (* the Disk Name Icon), and then calls the filterProc specified in SFPxxxFile (* calls. (* (* Another of the things that the internal filterProc does is look for NULL (* events. When one is found, the filterProc returns 100 as the "itemHit". (* This forces ModalDialog to return to SF, which in turn can now call (* the dlgHook with the bogus 100 item number, indicating that idle time (* processing can be performed. (* (* The problem occurs when there are updates pending in windows open in (* the current application's partition. These updates will 'clog' the event (* queue. When ModalDialog calls GetNextEvent, it will get the update (* event. However, there is no way for ModalDialog to respond to it. It (* therefore passes the event off to the filterProc, which is SF's internal (* one. This filterProc doesn't know how to handle it either. Normally, (* the event would be ignored at this point, and the update event would be (* unresolved. Control returns back to ModalDialog, which calls GetNextEvent (* again, and gets the same udpate event back. NULL events will not get (* returned by GetNextEvent, and, hence, the dlgHook will never get called (* with itemHit=100. (* (* This situation can be solved by providing your own filterProc (* procedure to be called after SF's internal filterProc. It will be this (* routine's responsibility to check for update events, and handle them (* appropriately. Usually, this would mean that the update procedure (* within the application would be called, and the update could be cleared. (* However, the filterProc could also just handle update events in the same (* way that Standard File's filterProc handles NULL events. This is done (* by returning 100 in the ItemHit parameter and TRUE as the function result. (* This is the approach taken by the sample below. (* (******************************************************************************) { This is our dlgHook routine. All it does is wait around for NULL events } { and draws the current time when it gets one. Note that this routine will } { NOT get called with item=100 if we did not have the filter procedure } { below. } FUNCTION IdleTimeHook(item: integer; dlg:DialogPtr): integer; VAR dateTime:LONGINT; result: str255; BEGIN IdleTimeHook := item; IF (item = 100) THEN BEGIN TextMode(srcCopy); MoveTo(250,15); GetDateTime(dateTime); IUTimeString(dateTime,{wantSeconds=}TRUE,result); result := concat(result,' '); {pad with spaces to erase longer strings} DrawString(result); END; END; FUNCTION filter(dlg:DialogPtr; VAR evt: EventRecord; VAR itemHit: integer): boolean; { If we get an update event for a window other than the dialog box, change } { it to a NULL event, and tell ModalDialog that we handled it. } BEGIN filter := FALSE; IF ((evt.what = updateEvt) and (DialogPtr(evt.message) <> dlg)) THEN BEGIN itemHit := 100; filter := TRUE; END; END; PROCEDURE doIdleUpdates; VAR r: rect; tPtr: WindowPtr; BEGIN { Create a window with a non-empty update region. } r.top := 40; r.left := 10; r.bottom := 340; r.right := 500; tPtr := NewWindow(NIL, { Window storage } r, { bounding rectangle } 'Un-updated Window', TRUE, { is visible } documentProc, { procID } Pointer(-1), { bring it up on top } TRUE, { has goaway } 0); { refcon } SFPGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} NIL, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} @IdleTimeHook, {dlgHook} reply, {record for returned values} -4000, {ID of Normal Dialog} @filter); {ModalDialog filterProc} DisposeWindow(tPtr); END; (** doForceDirectory **********************************************************) (* (* This is a quick sample that shows how to set the initial directory that (* Standard File comes up with. Basically, this is done by storing apporpriate (* values into SFSaveDisk and CurDirStore. In this example, I force the (* directory to be the Blessed Folder as specified by SysEnvirons. (* (******************************************************************************) PROCEDURE doForceDirectory; VAR pb: WDPBRec; err: OSErr; BEGIN WITH pb DO BEGIN ioNamePtr := NIL; ioVRefNum := theWorld.sysVRefNum; ioWDIndex := 0; ioWDProcID := 0; END; err := PBGetWDInfo(@pb,FALSE); CurDirStore^ := pb.ioWDDirID; SFSaveDisk^ := -pb.ioWDVRefNum; SFGetFile(Point($00400040), {location} 'Space for Rent', {vestigial string} NIL, {fileFilter} -1, {numtypes; -1 means all} typeList, {array to types to show} NIL, {dlgHook} reply); {record for returned values} IF reply.good THEN ShowSelection(concat(PathnameFromWD(reply.vRefNum),reply.fName)) ELSE ShowCancelled; END; (************************ Performed the selected command *************************) PROCEDURE DoCommand(mResult: Longint); VAR theItem: Integer; theMenu: Integer; name: str255; temp: Integer; templ: Longint; oldPort: GrafPtr; BEGIN theItem:=LoWord(mResult); theMenu:=HiWord(mResult); CASE theMenu OF mApple: IF (theItem=iAboutMe) THEN ShowAboutMeDialog ELSE BEGIN GetItem(GetMHandle(mApple),theItem,name); GetPort(oldPort); temp:=OpenDeskAcc(name); SetPort(oldPort); END; mFile: CASE theItem OF iQuit: doneFlag:=TRUE; END; mEdit: BEGIN IF NOT SystemEdit(theItem-1) THEN; END; mSFile: BEGIN CASE theItem OF iNormalGet: doNormalGet; iNormalPut: doNormalPut; iNormalPGet: doNormalPGet; iNormalPPut: doNormalPPut; iFileFilter: doFileFilter; iGetDirectory: doGetDirectory; iMultiFile: doMultiFile; iListsNPutFile: doListsNPutFile; iPutOptions: doPutOptions; iIdleUpdates: doIdleUpdates; iForceDirectory: doForceDirectory; END; END; END; HiliteMenu(0); END; BEGIN UnLoadSeg(@_DataInit); MaxApplZone; InitGraf(@thePort); InitFonts; FlushEvents(everyEvent,0); InitWindows; InitMenus; TEInit; InitDialogs(NIL); InitCursor; dummy:=SysEnvirons(1,theWorld); WNEIsImplemented:=((theWorld.machineType>=0) AND (NGetTrapAddress(_WaitNextEvent, ToolTrap)<>NGetTrapAddress(_Unimplemented,ToolTrap))); flagPtr := PtrToWord(kHWCfgFlags); IF BAnd(flagPtr^,$0200) <> 0 THEN BEGIN haveAUX := TRUE; END ELSE BEGIN haveAUX := FALSE; END; SetUpMenus; doneFlag:=FALSE; SFSaveDisk := PtrToWord(kSFSaveDisk); CurDirStore := PtrToLong(kCurDirStore); TopMapHndl := PtrToLong(kTopMapHndl); MySaveDisk := SFSaveDisk^ + 1; {so we're sure that they're different} REPEAT IF WNEIsImplemented THEN haveEvent:=WaitNextEvent(everyEvent,myEvent,$7FFFFFFF,NIL) ELSE BEGIN SystemTask; haveEvent:=GetNextEvent(everyEvent,myEvent); END; deskPart := FindWindow(myEvent.where,whichWindow); IF deskPart <> inSysWindow THEN InitCursor; IF haveEvent THEN BEGIN CASE myEvent.what OF mouseDown: CASE deskPart OF inSysWindow: SystemClick(myEvent,whichWindow); inMenuBar: DoCommand(MenuSelect(myEvent.where)); END; keyDown,autoKey: IF BAND(myEvent.modifiers,cmdKey)<>0 THEN DoCommand(MenuKey(CHR(BAND(myEvent.message,charCodeMask)))) END; END; UNTIL doneFlag; END.