Related Info: Dialog Manager Standard File

Modeless SFDialongs

By Brendan Murphy, Palatine, IL

Jumping over ROM in a single bound....

I have always believed that what makes a Mac a Mac is not its hardware, but its operating system. The stuff in ROM and in the system folder really make the Mac what it is. The converse is also true, what is not in ROM is not part of the Mac. This can sometimes be a good thing. For example, what if there was a DOS manager which turned the Mac into a command line interface and back again at the whim of a system call. It would be unimaginable the affect on Mac software if such a manager had been included in the original operating system. There is also a down side to what is “not in ROM” as is so often state in Inside Mac I-V. If it ain’t there, it ain’t there--your stuck! This statement isn’t completely true, otherwise I would not be writing this article. This leads me to the motivation behind this article. What if you could have SFPutFile and SFGetFile dialogs that were modeless! Your probably thinking that is impossible! Ok, so your not thinking that it is impossible, but you have to admit it would be a difficult thing to accomplish.

Let’s think about a scenario for a few sentences. You launch Think Pascal 3.0 and you create a new project. So far, so good. Then it comes time to add files to the project, but you become a little annoyed and then potentially psychotic after adding fifty implementation files. What is the cause of those mental aberrations? Those jack-in-the-box SFGetFile dialogs that keep flashing on the screen every time you select a file. After you calm down with a diet seven up, you realize it was not Think Pascal’s fault, but it is a deficiency in the toolbox. Let’s alter the scenario and add the new modeless SFGetFile dialog. This time everything seems smoother and more peaceful. There are no annoying flashes on the screen. You can flip back and forth between windows with out having to close the SFGetFile dialog. Now you drink your diet seven up at your leisure and without massive brow strain. A happy ending to the scenario wouldn’t you say.

Pandora’s Dialog

The first thing to consider when using the modeless dialogs, is how should the modeless get and save dialogs behave. (I’ll refer to SFPutFile and SFGetFile dialogs as Save and Get dialogs respectively from now on.) Having modeless get and save dialogs provides a tremendous amount of flexibility to the programmer. This flexibility also has a dark side. If the get and save dialogs are used in an inconsistent manner across different applications then only confusion will result in the end user. Therefore I propose three guidelines to govern the use of modeless get and save dialogs. I am sure more guidelines could be added, but I will leave that up for debate among the Mac developer community.

1) Make clear the target of the get or save operation. In most situations this will be the top (not necessarily active) document window.

2) Operations should be sequential. An example of where operations could become non-sequential is when the user clicks on the save and open button several times and the the file system saves and gets files asynchronously. Make sure saving and getting sequences are logically interlocked.

3) Keep it simple. Don’t make the user’s life difficult with overly complicated get and save dialogs.

Full Reverse!

When I first started this project I knew I had to reverse engineer the modal get and save dialogs. After doing so, I discover some semi-startling facts. One of the first things I noticed was that the pulldown menu for the path names was not a pop-up menu, but a list from the list manager! The next thing I noticed was the interaction of all the elements in the modal dialogs were more complex than meets the eye or mouse. I’m not sure if I caught all of the complexities, but I am sure someone out there will find them for me. I would appreciate it if you do find some inconsistency in the modeless get and save dialogs that you will inform me of them.

The Nitty Gritty.

Today, not only do you have the burden to learn the toolbox but also OOP libraries like MacApp and TCL (essentially second toolboxes). CSFDialogs are a set of object-oriented classes based on TCL. You will need Think Pascal 3.x or better and TCL. I have created a sample starter application with all the necessary overrides. There is also a custom list definition project. All these files will add about 2000+ physical lines of code (comments not included) and about 12 k+ to your application.

There are three basic classes you need to be aware of--CSFWindow and its two subclasses CSFGetWindow and CSFSaveWindow. Most of the work is done in these three classes. You will have to create subclasses of these classes to make them work in your own application. CSFGetWindow and CSFSaveWindow override the methods of CSFWindow. When you create your subclasses, you will need to override a similar set of methods. I suggest beginning with a copying the CSFGetWindow or CSFSaveWindow class type declarations and modifying them from that point. If you want to to use the dialogs without modifications, you will have to override “PROCEDURE FileSelected (TheReply: SFReply);” in order to do something useful with the reply when a file is selected or there is a click in the save button. Subclasses of the director classes will also have to be created to install your subclass windows. The CApplication class has also been overriden so that the CSFSwitchboard may be installed. Make sure your application installs CSFApplication.

I have used Hungarian notation in the naming of fields and classes. Fields of objects start with f (e.g. fEmpty), classes start with C, constants start with k, and global variables start with g. SF stands for “Snazzy File”.

Where’s the override!

Described below is the main window class methods for the modeless get and save dialogs. The key to understanding this project is understanding the inner workings of CSFWindow. When you create your subclasses, follow the example of CSFGetWindow and CSFSaveWindow in how they modify CSFWindow.

CSFWindow = OBJECT(CWindow)

This class is the heart of the modeless dialogs. Normally you would not directly create subclasses of this class, but subclasses of CSFGetWindow and CSFSaveWindow. Make sure to create subclasses of the directors to install your window subclass.

PROCEDURE ICSFWindow (TheDirector: CDirector);

Initialize the window and all its buttons. Don’t override this method but override MoreInitializations.

PROCEDURE MoreInitializations;

Override this method to install your buttons and perform any necessary adjustments. The window is not visible when this method is called.

PROCEDURE SetfViewRect;

Override this method to position the main file selection box.

PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord);

Override;

Intercept special characters like tabs and returns.

PROCEDURE DoCommand (TheCommand: Longint);

Override;

Override this method to insert your own commands. Make sure to call the inherited DoCommand if your routine does not handle the command.

PROCEDURE Update;

Override;

Do not override this method, but override MoreUpdates instead.

PROCEDURE MoreUpdates;

Override this method to do any additional drawing or updating to the window. This method is called by Update.

PROCEDURE Free;

Override;

If you allocate any memory, dispose or free it here. Make sure to call the inherited free to free the rest of the dialog.

PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint);

Override;

This method mainly handles dispatching clicks to the file box and the pull down menu.

PROCEDURE Activate;

Override;

With modeless dialogs we don’t hold the system hostage, therefore there is no guarantee as to the current status of the mounted volumes when the window is activated. The dialog is updated to reflect the current state of affairs.

PROCEDURE Deactivate;

Override;

Deactivate the window and clean up.

PROCEDURE Close;

Override;

Close the window and its document.

FUNCTION CountDrives: Integer;

Count the number of mounted drives.

FUNCTION GetNextVol: Integer;

Index to the next mounted volume and return the its volume reference number.

FUNCTION CheckDrives: Boolean;

Check the statuses of the floppy drives and store there volume reference numbers.

PROCEDURE DoEject;

Eject the disk.

PROCEDURE DoDrive;

Find the next mounted drive.

PROCEDURE DoCancel;

The default method closes the dialog. In most cases you will want to override this method so it won’t close the dialog, but cancel any actions that are in progress.

PROCEDURE DoStatus;

Update the status of the buttons. Override this method if you are adding new controls.

FUNCTION FileFilter (ParamBlock: CInfoPBPtr): Boolean;

This method is called when reading files from a directory on the disk. If you want a file to appear in the file box, override this method and return true.

FUNCTION ActiveFilter (ParamBlock: CInfoPBPtr): Boolean;

This method is called when reading files from a directory on the disk. If you want a file to be active and selectable (not grayed out), override this method and return true.

PROCEDURE FillDialog (VRefNum: Integer);

Update the file box with the directory indicated by VRefNum.

PROCEDURE SetPathRect;

Resize the pull down menu for the path names.

PROCEDURE FindPath (VRefNum: Integer);

From the directory specified in VRefNum, find the path name to this directory and store in the list.

FUNCTION FindSelection: Str255;

Return the first selected file in the file box as a Pascal string Str255.

PROCEDURE DoSelection;

Handle a selected file. Do not override this method. FileSelected is called from here.

PROCEDURE FileSelected (TheReply: SFReply);

This method must be overriden! This is where a selected file is returned for processing. I suggest processing files asynchronously. This will allow your application to continue processing events and make the dialog more flexible. I also suggest setting up a “completion” routine to run after the operation is done to update the dialog.

FUNCTION RedAlert (AlertID: Integer): Integer;

Display alert messages. Override this method if you have specialized alerts. Make sure that the inherited method is called if you don’t handle the alert. (Yes, this is a cheap reference to Star Trek.)

LDEF

This program would not be complete without a custom list definition. The path name menu is a list from the list manager. There are two parts to this custom list definition. The first resides in the actual list definition and the second part is the ClickLoop routine that resides in the main source code. The ClickLoop routine allows scrolling of the pull down menu. This is necessary because of the custom list definition. The data for each item in the list is a text string. The first two characters of the text string are controlling characters and the rest is the actual text. The first character is ‘+’ for active or ‘-’ for inactive. The second character represents what icon to draw with the text. The various icons are defined as follows.

‘!’: File

‘@’: Closed Folder

‘#’: Application

‘$’: Open Folder

‘%’: Hard Drive

‘^’: Floppy Disk

Neat things you could do...

Here are some ideas you could add to your subclasses.

1) Have a pulldown menu to allow the user to randomly select mounted volumes.

2) As a variant to the first idea, make the pulldown menu hierarchical and allow the user to select the working directory within the volume.

3) Combine get and save operations into one dialog.

4) Add sound effects to the operations of the dialog.

5) Implement multiple file selection. Open more than one file at a time.

6) Have a pulldown menu that selects the document to be saved from among the open “dirty” documents.

Conclusion

After reading this article there are probably a lot of unanswered questions. These questions are left to the reader as an exercise (I always hated that in college). I’m not going to produce a Think C version or a MacApp version. I leave this honor to some hearty soul out there. I will release a maintenance version if enough bugs or deficiencies are brought to my attention. My hope for this piece of software is that it will someday be incorporated into Apple’s system software (7.x or 8.x) and thus make this article a moot exercise for future programmers.

In the future, I plan to write more articles on TCL and perhaps MacApp. I am already “cooking up” some ideas to remove some of the short comings of TCL, but I have not yet decided which idea to pursue. Half the battle is coming up with the idea and half the battle is sticking with the idea and half the battle is implementing the idea. Yes, that adds up to 3/2 which goes to show that anything worth doing, is more work than you thought.

Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks. Note--In the following listings, an "..." between sections of code signifies code deleted. The deleted code is the same as found in the TCL Starter application. I have only included the changes to the starter application. The full source code for this project can be found on the source disk.

Listing: CSFDialogs.p
{ Written by Brendan Murphy }
{ Version 1.0 }
UNIT CSFDialogs;
INTERFACE { TwilightZone }
USES
 TCL, Disks;
{ Make sure you have included 'Disks.p' in your project }
CONST
 cmdDiskEvent = 552;
 ScrDmpEnb = $2F8;  { Global }

 { Button stuff }
 kScrollBarWidth = 15;
 kButtonHeight = 17;
 kGetButtonOffset = 264;
 kSaveButtonOffset = 226;

 { Resource IDs }
 kRadioButton = 1;
 kCheckButton = 2;
 KPushButton = 3;

 { Buttons }
 kCancelButton = 20001;
 kEjectButton = 20002;
 kDriveButton = 20003;
 kOpenButton = 20004;
 kSaveButton = 20005;

 { More commands }
 kSelection = 21000;
 kEmptyText = 21001;
 kNonEmptyText = 21002;

 { Red Alert Errors }
 kDiskNotFound = -3994;
 kSystemError = -3995;
 kExistingFile = -3996;
 kLockedDisk = -3997;

TYPE
{ Shows volume name and icon }
 CSFVolumeBox = OBJECT(CPane)
 PROCEDURE Draw (VAR Area: Rect);
 Override;
 PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint);
 Override;
 END;

{ Text edit box for save dialog }
 CSFEditText = OBJECT(CEditText)
 fEmpty: Boolean; { Anybody Home? }

 PROCEDURE IEditText (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, 
aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aLineWidth: 
integer);
 Override;
 PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord);
 Override;
 PROCEDURE SetText;
 FUNCTION IsEmpty: Boolean;
 PROCEDURE Dawdle (VAR maxSleep: Longint);
 Override;
 PROCEDURE SelectText;
 FUNCTION GetStr255: Str255;
 END;

{ Main window class }
 CSFWindow = OBJECT(CWindow)
 fInitTime: Boolean;

 { Button references }
 fEject, fDrive, fCancel: CButton;

 fVolumeBox: CSFVolumeBox;

 { Holds the file listings }
 fFileList: ListHandle;
 fViewRect: Rect;

 { Holds the path to the directory }
 fPathList: ListHandle;
 fPathRect: Rect;
 fMenuWidth: Integer;
 fMenuHeight: Integer;

 fDriveIndex: Integer;
 fDrive1, fDrive2: Integer;

 { Internal directory information }
 fCurrentWD: Integer; { Holds current working directory }
 fGood: Boolean;
 fName: Str255;
 fVName: Str255;

 PROCEDURE ICSFWindow (TheDirector: CDirector);
 PROCEDURE MoreInitializations;
 PROCEDURE SetfViewRect;
 PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord);
 Override;
 PROCEDURE DoCommand (TheCommand: Longint);
 Override;
 PROCEDURE Update;
 Override;
 PROCEDURE MoreUpdates;
 PROCEDURE Free;
 Override;
 PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint);
 Override;
 PROCEDURE Activate;
 Override;
 PROCEDURE Deactivate;
 Override;
 PROCEDURE Close;
 Override;

 FUNCTION CountDrives: Integer;
 FUNCTION GetNextVol: Integer;
 FUNCTION CheckDrives: Boolean;

 PROCEDURE DoEject;
 PROCEDURE DoDrive;
 PROCEDURE DoCancel;
 PROCEDURE DoStatus;

 FUNCTION FileFilter (ParamBlock: CInfoPBPtr): Boolean;
 FUNCTION ActiveFilter (ParamBlock: CInfoPBPtr): Boolean;
 PROCEDURE FillDialog (VRefNum: Integer);

 PROCEDURE SetPathRect;
 PROCEDURE FindPath (VRefNum: Integer);
 FUNCTION FindSelection: Str255;

 PROCEDURE DoSelection;
 PROCEDURE FileSelected (TheReply: SFReply);

 FUNCTION RedAlert (AlertID: Integer): Integer;
 END;

{ Subclasses of main window }
{ You will want to override these subclasses }
 CSFGetWindow = OBJECT(CSFWindow)
 fOpen: CButton;

 PROCEDURE MoreInitializations;
 Override;
 PROCEDURE DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord);
 Override;
 PROCEDURE SetfViewRect;
 Override;
 PROCEDURE MoreUpdates;
 Override;
 PROCEDURE DoStatus;
 Override;
 PROCEDURE DoClick (hitPt: Point; modifierKeys: integer; when: longint);
 Override;
 PROCEDURE DoCommand (TheCommand: Longint);
 Override;
 PROCEDURE Free;
 Override;
 PROCEDURE DoOpen;
 END;

 CSFSaveWindow = OBJECT(CSFWindow)
 fSave: CButton;
 fFileName: CSFEditText;
 fPromptString: Str255;

 PROCEDURE MoreInitializations;
 Override;
 PROCEDURE SetfViewRect;
 Override;
 FUNCTION ActiveFilter (ParamBlock: CInfoPBPtr): Boolean;
 Override;
 PROCEDURE Activate;
 Override;
 PROCEDURE DoCommand (TheCommand: Longint);
 Override;
 PROCEDURE MoreUpdates;
 Override;
 PROCEDURE Free;
 Override;
 FUNCTION FileExists (vRefNum: Integer; TheName: Str255): Boolean;
 PROCEDURE DoSave;
 END;

{ Also make sure to create subclasses of these directors }

 CSFDialog = OBJECT(CDirector)
 PROCEDURE ICSFDialog;
 END;

 CSFGetDialog = OBJECT(CSFDialog)
 PROCEDURE ICSFDialog;
 Override;
 END;

 CSFSaveDialog = OBJECT(CSFDialog)
 PROCEDURE ICSFDialog;
 Override;
 END;

{ You don't have to do anything with the switchboard since }
{ it is installed by the CSFApplication }

 CSFSwitchboard = OBJECT(CSwitchBoard)
 PROCEDURE DoDiskEvent (macEvent: EventRecord);
 Override;
 END;

{ Make sure this class is installed in your application! }

 CSFApplication = OBJECT(CApplication)
 PROCEDURE ICSFApplication (extraMasters: integer; aRainyDayFund, aCreditLimit: 
Size);
 END;

IMPLEMENTATION
VAR
{ This list handle is critcal to the ClickLoop routine. }
{ It holds the current path menu list. }
 ThePathList: ListHandle;
 ThePathCell: Cell;

FUNCTION IsDirectory (ParamBlock: CInfoPBPtr): Boolean;
{ Is this a directory? }
 BEGIN
 IsDirectory := BitTst(@ParamBlock^.ioFLAttrib, 3);
 END;

PROCEDURE DropShadow (TheRect: Rect);
{ Draw a shadow around the box }
 BEGIN
 Moveto(TheRect.Left + 1, TheRect.Bottom);
 Lineto(TheRect.Right, TheRect.Bottom);
 Lineto(TheRect.Right, TheRect.Top + 1);
 END;

PROCEDURE FKeyEnable (OnOff: Boolean);
{ Turn off function keys }
{ Can't normaly intercept all disk events }
{ because they are masked out by the system }
{ before they are put in the event queue. }
 VAR
 P: Ptr;
 BEGIN
 { Enable Shift-Command-Keys }
 P := Ptr(ScrDmpEnb);
 IF OnOff THEN
 P^ := $FF
 ELSE
 P^ := $00
 END;

FUNCTION GetCellContents (TheCell: Cell; TheList: Listhandle): Str255;
{ Transform the cell data into a Pascal string. }
 VAR
 TempStr: Str255;
 DataLength: Integer;
 BEGIN
 TempStr := '';
 DataLength := 255;
 LGetCell(Ptr(Longint(@TempStr) + 1), DataLength, TheCell, TheList);
 BlockMove(Ptr(Longint(@DataLength) + 1), @TempStr, 1);
 GetCellContents := TempStr;
 END;

FUNCTION ClickLoop: Boolean;
{ Gives those pull down menus that special flavor }
{ Since we use a custom LDEF, we must roll our own here }
{ and damn the torpedos!!! }
 VAR
 ThePoint, TheCell, TheNewCell: Point;
 Contents: Str255;
 OffSet: Integer;
 BEGIN
 OffSet := 0;
 WHILE StillDown DO
 BEGIN
 GetMouse(ThePoint);
 IF NOT PtInRect(ThePoint, ThePathList^^.rView) THEN
 BEGIN
 { We are not in the menu }
 SetPt(TheCell, 0, 0);

 { Cell Selected? }
 IF LGetSelect(True, TheCell, ThePathList) THEN
 BEGIN
 LSetSelect(False, TheCell, ThePathList);
 SetPt(ThePathCell, 0, 0);
 END;

 { Should we scroll? }
 IF (ThePoint.h > ThePathList^^.rView.Left) AND (ThePoint.h < ThePathList^^.rView.Right) 
THEN
 BEGIN
 { Up or down? }
 IF (ThePoint.v >= ThePathList^^.rView.Top) THEN
 BEGIN
 SetPt(TheCell, 0, ((ThePathList^^.rView.Bottom - ThePathList^^.rView.Top 
+ 1) DIV ThePathList^^.CellSize.v) + Offset);
 IF TheCell.v < ThePathList^^.dataBounds.Bottom THEN
 BEGIN
 LScroll(0, 1, ThePathList);
 IF Offset < ThePathList^^.dataBounds.Bottom THEN
 Offset := Offset + 1;
 END;
 END
 ELSE
 BEGIN
 SetPt(TheCell, 0, ((ThePathList^^.rView.Top - 1) DIV ThePathList^^.CellSize.v) 
+ Offset);
 IF TheCell.v > 0 THEN
 BEGIN
 LScroll(0, -1, ThePathList);
 IF Offset > 0 THEN
 Offset := Offset - 1;
 END;
 END;
 END;
 END
 ELSE
 BEGIN
 { We are in the menu }
 SetPt(TheCell, 0, 0);
 IF LGetSelect(True, TheCell, ThePathList) THEN
 BEGIN
 SetPt(TheNewCell, 0, ((ThePoint.v - ThePathList^^.rView.Top) DIV ThePathList^^.CellSize.v) 
+ Offset);
 { Do we need to select a cell? }
 IF TheNewCell.v <> TheCell.v THEN
 BEGIN
 LSetSelect(False, TheCell, ThePathList);
 LSetSelect(True, TheNewCell, ThePathList);
 ThePathCell := TheNewCell;
 END;
 END
 ELSE
 BEGIN
 { Nothing turned on so turn something on }
 SetPt(TheCell, 0, ((ThePoint.v - ThePathList^^.rView.Top) DIV ThePathList^^.CellSize.v) 
+ Offset);
 LSetSelect(True, TheCell, ThePathList);
 ThePathCell := TheCell;
 END;
 END;
 END;

 { Scroll menu back }
 IF Offset > 0 THEN
 BEGIN
 LDoDraw(False, ThePathList);
 LScroll(0, -Offset, ThePathList);
 LDoDraw(True, ThePathList);
 END;

 ClickLoop := False;

 END;

FUNCTION ChangeDirectory (VRefNum: Integer; TheFolder: Str255): Integer;
{ Change the working directory }
 VAR
 ParamBlock: CInfoPBPtr;
 WDBlock: WDPBPtr;
 Err: OSErr;
 BEGIN
 ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec)));
 WDBlock := WDPBPtr(NewPtr(SizeOf(WDPBRec)));

 { Find out where we are }
 Err := NoErr;
 WITH WDBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := VRefNum;
 ioWDIndex := 0;
 ioWDProcID := 0;
 END;
 Err := PBGetWDInfo(WDBlock, False);

 { Open directory named TheFolder. }
 { You would think Apple would provide }
 { more higher level routines to do this }
 { kind of work. }
 ParamBlock^.ioDrParID := WDBlock^.ioWDDirID;
 WITH ParamBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := @TheFolder;
 ioVRefNum := VRefNum;
 ioDrDirID := 0;
 ioDirID := 0;
 ioFVersNum := 0;
 ioFDirIndex := 0;
 END;
 Err := PBGetCatInfo(ParamBlock, False);

 { Open working directory }
 WITH WDBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := VRefNum;
 ioWDDirID := ParamBlock^.ioDrDirID;
 ioWDProcID := 0;
 END;
 Err := PBOpenWD(WDBlock, False);

 IF Err <> NoErr THEN
 ChangeDirectory := 0
 ELSE
 ChangeDirectory := WDBlock^.ioVRefNum;

 DisposPtr(Ptr(ParamBlock));
 END;

FUNCTION FindParent (VRefNum: Integer; Levels: Integer): Integer;
{ From a given working directory, find working directory number for that 
directory. }
 VAR
 ParamBlock: CInfoPBPtr;
 WDBlock: WDPBPtr;
 Err: OSErr;
 i: Integer;
 TheName: Str255;
 BEGIN
 ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec)));
 WDBlock := WDPBPtr(NewPtr(SizeOf(WDPBRec)));

 Err := NoErr;
 WITH WDBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := VRefNum;
 ioWDIndex := 0;
 ioWDProcID := 0;
 END;
 Err := PBGetWDInfo(WDBlock, False);

 { Find directory ID }
 ParamBlock^.ioDrParID := WDBlock^.ioWDDirID;
 i := 1;
 WHILE (Err = NoErr) AND (i <= (Levels + 1)) DO
 BEGIN
 WITH ParamBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := VRefNum;
 ioDrDirID := 0;
 ioDirID := ioDrParID;  { We want the parent directory name }
 ioFVersNum := 0;
 ioFDirIndex := -1;  { Causes it to give information on ioDrDirID }
 END;
 Err := PBGetCatInfo(ParamBlock, False);
 i := i + 1;
 END;

 { Open working directory }
 WITH WDBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := VRefNum;
 ioWDDirID := ParamBlock^.ioDrDirID;
 ioWDProcID := 0;
 END;
 Err := PBOpenWD(WDBlock, False);

 IF Err <> NoErr THEN
 FindParent := 0
 ELSE
 FindParent := WDBlock^.ioVRefNum;

 DisposPtr(Ptr(ParamBlock));
 END;

FUNCTION GetVRefNum (WorkingDir: Integer): Integer;
{ Take a working directory and convert it to a volume number }
 VAR
  Ignore: Longint;
  VRefNum: Integer;
  Err: OSErr;
 BEGIN
 { GetWDInfo is a high level equivalent of the PB routine }
 { but not documented in IM}
  Err := GetWDInfo(WorkingDir, VRefNum, Ignore, Ignore);
  GetVRefNum := VRefNum;
 END;

FUNCTION GetCurWDRefNum: Integer;
{ Get the current system working directory }
 CONST
 CurDirStore = $398;
 VAR
 Pb: WDPBRec;
 DirID: Longint;
 Index: Integer;
 Err: OSErr;
 BEGIN
 BlockMove(Ptr(CurDirStore), @DirID, 4);
 Index := 1;
 REPEAT
 WITH Pb DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := 0;
 ioWDIndex := Index;
 ioWDPROCID := 0;
 ioWDVRefNum := 0;
 END;
 Err := PBGetWDInfo(@Pb, True);
 Index := Index + 1;
 UNTIL (Err <> NoErr) OR (DirID = PB.ioWDDirID);
 IF Err = NoErr THEN
 GetCurWDRefNum := Pb.ioVRefNum
 ELSE
 GetCurWDRefNum := 0;
 END;

PROCEDURE DrawFloppyDisk (Left, Top: Integer);
{ Draw floppy disk icon }
 BEGIN
 Moveto(Left + 5, Top + 2);
 Lineto(Left + 14, Top + 2);
 Lineto(Left + 16, Top + 4);
 Lineto(Left + 16, Top + 13);
 Lineto(Left + 5, Top + 13);

 Moveto(Left + 4, Top + 12);
 Lineto(Left + 4, Top + 3);

 Moveto(Left + 13, Top + 3);
 Lineto(Left + 13, Top + 5);

 Moveto(Left + 12, Top + 6);
 Lineto(Left + 8, Top + 6);

 Moveto(Left + 7, Top + 5);
 Lineto(Left + 7, Top + 3);

 Moveto(Left + 11, Top + 3);
 Lineto(Left + 11, Top + 4);

 Moveto(Left + 7, Top + 12);
 Lineto(Left + 7, Top + 10);

 Moveto(Left + 8, Top + 9);
 Lineto(Left + 12, Top + 9);

 Moveto(Left + 13, Top + 10);
 Lineto(Left + 13, Top + 12);
 END;

PROCEDURE DrawHardDrive (Left, Top: Integer);
{ Draw hard disk icon }
 BEGIN
 Moveto(Left + 3, Top + 6);
 Lineto(Left + 3, Top + 9);

 Moveto(Left + 4, Top + 10);
 Lineto(Left + 18, Top + 10);

 Moveto(Left + 19, Top + 9);
 Lineto(Left + 19, Top + 6);

 Moveto(Left + 18, Top + 5);
 Lineto(Left + 4, Top + 5);

 Moveto(Left + 5, Top + 8);
 Lineto(Left + 5, Top + 8);
 END;

PROCEDURE TrimVolumeName (Area: Rect; Offset: Integer; VAR TheVolume: 
Str255);
{ the volume name down to size and add a '...' }
 VAR
 TheLength: Integer;
 TrimmedVolume: Str255;
 BEGIN
 TheLength := (Area.Right - Area.Left) - Offset;
 IF Thelength >= StringWidth(TheVolume) THEN
 Exit(TrimVolumeName);
 TrimmedVolume := Concat(Omit(TheVolume, Length(TheVolume), 1), CHR($C9));
 WHILE StringWidth(TrimmedVolume) >= TheLength DO
 BEGIN
 TrimmedVolume := Concat(Omit(TrimmedVolume, Length(TrimmedVolume) - 
1, 2), CHR($C9));
 END;
 TheVolume := TrimmedVolume;
 END;

PROCEDURE CSFVolumeBox.Draw (VAR Area: Rect);
 Override;
{ Draw the icon and then the volume name }
 VAR
 TheVolume: Str255;
 VRefNum: Integer;
 Err: OSErr;
 BEGIN
 EraseRect(Area);
 Err := GetVol(@TheVolume, VRefNum);
 IF CSFWindow(ItsEnclosure).CheckDrives THEN
 BEGIN
 { Check floopy drives }
 IF (CSFWindow(ItsEnclosure).fDrive1 = GetVRefNum(VRefNum)) OR (CSFWindow(ItsEnclosure).fDrive2 
= GetVRefNum(VRefNum)) THEN
 DrawFloppyDisk(0, 0)
 ELSE
 DrawHardDrive(0, 0);
 END
 ELSE
 DrawHardDrive(0, 0);
 TrimVolumeName(Frame, 23, TheVolume);
 Moveto(23, 12);
 DrawString(TheVolume);
 END;

PROCEDURE CSFVolumeBox.DoClick (hitPt: Point; modifierKeys: integer; 
when: longint);
 Override;
 { Change directory if clicked in }
 VAR
 TheWindow: CSFWindow;
 Temp: Integer;
 BEGIN
 { Step up one directory level }
 TheWindow := CSFWindow(ItsEnclosure);
 Temp := FindParent(TheWindow.fCurrentWD, 1);
 IF Temp <> 0 THEN
 BEGIN
 TheWindow.fCurrentWD := Temp;
 TheWindow.FillDialog(TheWindow.fCurrentWD);
 TheWindow.FindPath(TheWindow.fCurrentWD);
 CSFWindow(ItsEnclosure).DoStatus;
 END;

 INHERITED DoClick(hitPt, modifierKeys, when);
 END;

PROCEDURE CSFEditText.IEditText (anEnclosure: CView; aSupervisor: CBureaucrat; 
aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; 
aLineWidth: integer);
 Override;
{ Initialize the text edit box }
 BEGIN
 INHERITED IEditText(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, 
aVEncl, aHSizing, aVSizing, aLineWidth);
 { Override settext to insert different text }
 SetText;
 END;

PROCEDURE CSFEditText.DoKeyDown (theChar: char; keyCode: Byte; macEvent: 
EventRecord);
 Override;
{ We have to intercept special keys to process them as clicks instead 
}
 BEGIN
 CASE keyCode OF
 $24, $34:  { return or enter }
 DoCommand(kSaveButton);
 $30:   { tab }
 DoCommand(kDriveButton);
 OTHERWISE
 INHERITED DoKeyDown(theChar, keyCode, macEvent);
 END;

 { Did we delete everything? }
 IF IsEmpty THEN
 BEGIN
 IF NOT fEmpty THEN
 BEGIN
 fEmpty := True;
 DoCommand(kEmptyText);
 END;
 END
 ELSE
 BEGIN
 IF fEmpty THEN
 BEGIN
 fEmpty := False;
 DoCommand(kNonEmptyText);
 END;
 END;
 END;

FUNCTION CSFEditText.IsEmpty: Boolean;
{ Is the party over? }
 VAR
 DataLength: Longint;
 BEGIN
 DataLength := macTE^^.teLength;
 IF DataLength = 0 THEN
 IsEmpty := True
 ELSE
 IsEmpty := False;
 END;

PROCEDURE CSFEditText.SetText;
{ Set the initial text in the edit box }
 BEGIN
 fEmpty := False;
 SetTextString('Untitled');
 DoCommand(kNonEmptyText);
 END;

PROCEDURE CSFEditText.Dawdle (VAR maxSleep: Longint);
 Override;
{ Is the edit box empty for any other reason, then notify the dialog 
}
 BEGIN
 INHERITED Dawdle(maxSleep);

 IF IsEmpty THEN
 BEGIN
 IF NOT fEmpty THEN
 BEGIN
 fEmpty := True;
 DoCommand(kEmptyText);
 END;
 END
 ELSE
 BEGIN
 IF fEmpty THEN
 BEGIN
 fEmpty := False;
 DoCommand(kNonEmptyText);
 END;
 END;
 END;

PROCEDURE CSFEditText.SelectText;
{ Highlite everything }
 BEGIN
 TESetSelect(0, Maxint, macTe);
 END;

FUNCTION CSFEditText.GetStr255: Str255;
{ Return a Pascal string of the first 255 characters }
 VAR
 Temp: Str255;
 DataLength: Longint;
 TheCharsHandle: CharsHandle;
 BEGIN
 Temp := '';

 DataLength := macTE^^.teLength;
 IF DataLength > 0 THEN
 BEGIN
 IF DataLength > 255 THEN
 DataLength := 255;
 BlockMove(Ptr(Longint(@DataLength) + 3), @Temp, 1);

 TheCharsHandle := GetTextHandle;
 HLock(Handle(TheCharsHandle));
 BlockMove(Ptr(TheCharsHandle^), Ptr(Longint(@Temp) + 1), DataLength);
 HUnLock(Handle(TheCharsHandle));
 END;

 GetStr255 := Temp;
 END;

PROCEDURE CSFWindow.ICSFWindow (TheDirector: CDirector);
{ Initialize the window. Do not override. }
 VAR
 TheSize, ViewRect, DataBounds, TheRect: Rect;
 CellSize: Point;
 Err: OSErr;
 TheText, TheName: Str255;
 TheLength, h, v, TheWidth, TheCenter, Ignore: Integer;
 BEGIN
 { Init the window }
 IWindow(9999, False, gDeskTop, TheDirector);
 Prepare;
 TextFont(SystemFont);
 Move(100, 100);
 SetTitle('Open');

 SetRect(TheSize, 0, 0, 70, kButtonHeight);

 { Create some buttons }
 New(fEject);
 fEject.IButton(KPushButton, Self, Self);
 fEject.SetClickCmd(kEjectButton);
 fEject.ChangeSize(TheSize, False);
 fEject.SetTitle('Eject');
 IF NOT CheckDrives THEN
 fEject.Deactivate;
 fEject.Show;

 New(fDrive);
 fDrive.IButton(KPushButton, Self, Self);
 fDrive.SetClickCmd(kDriveButton);
 fDrive.ChangeSize(TheSize, False);
 fDrive.SetTitle('Drive');
 IF CountDrives = 1 THEN
 fDrive.Deactivate;
 fDrive.Show;

 New(fCancel);
 fCancel.IButton(KPushButton, Self, Self);
 fCancel.SetClickCmd(kCancelButton);
 fCancel.ChangeSize(TheSize, False);
 fCancel.SetTitle('Cancel');
 fCancel.Show;

 { Create the main file box }
 SetfViewRect;
 SetRect(DataBounds, 0, 0, 1, 0);
 SetPt(CellSize, 1000, 16);
 ClipRect(GetMacPort^.PortRect);
 fFileList := LNew(fViewRect, DataBounds, CellSize, 13000, GetMacPort, 
True, False, False, True);
 fFileList^^.selFlags := lOnlyOne;
 SetRect(fViewRect, fViewRect.Left, fViewRect.Top, fViewRect.Right + 
kScrollBarWidth, fViewRect.Bottom);
 InsetRect(fViewRect, -1, -1);
 FrameRect(fViewRect);
 fCurrentWD := GetCurWDRefNum;

 { Fill the pull down menu }
 Err := GetVol(@TheName, Ignore);
 TheWidth := StringWidth(TheName) + 28;
 TheCenter := (fViewRect.Right - fViewRect.Left + 16) DIV 2;
 SetRect(fPathRect, TheCenter - (TheWidth DIV 2), fViewRect.Top - 23, 
TheCenter + (TheWidth DIV 2), fViewRect.Top - 7);
 SetRect(DataBounds, 0, 0, 1, 0);
 SetPt(CellSize, 1000, 16);
 ClipRect(GetMacPort^.PortRect);
 fPathList := LNew(fPathRect, DataBounds, CellSize, 13000, GetMacPort, 
True, False, False, False);
 fPathList^^.LClikLoop := @ClickLoop;
 ThePathList := fPathList;
 FindPath(fCurrentWD);
 FrameRect(fPathRect);
 DropShadow(fPathRect);

 { Here is where your initializations occur }
 MoreInitializations;

 New(fVolumeBox);
 fVolumeBox.IPane(Self, Self, (MacPort^.PortRect.Right - 3) - (fViewRect.Right 
+ 3), 16, fViewRect.Right + 3, fViewRect.Top, sizFIXEDLEFT, sizFIXEDTOP);
 fVolumeBox.SetWantsClicks(True);
 fVolumeBox.Show;

 fDriveIndex := 0;

 fGood := False;
 fName := '';
 fVName := '';

 { Show the window }
 Select;

 fInitTime := True;
 END;

PROCEDURE CSFWindow.MoreInitializations;
{ Override me! }
 BEGIN
 { Does nothing }
 END;

PROCEDURE CSFWindow.SetfViewRect;
{ Set the file box rect }
 BEGIN
 SetRect(fViewRect, 10, 30, 170, 158);
 END;

PROCEDURE CSFWindow.DoKeyDown (theChar: char; keyCode: Byte; macEvent: 
EventRecord);
 Override;
{ Intercept the tab key }
 BEGIN
 CASE keyCode OF
 $30:  { tab }
 DoCommand(kDriveButton);
 OTHERWISE
 INHERITED DoKeyDown(theChar, keyCode, macEvent);
 END;
 END;

PROCEDURE CSFWindow.DoCommand (TheCommand: Longint);
 Override;
{ Handle basic commands }
 BEGIN
 CASE (TheCommand) OF
 kCancelButton: 
 DoCancel;
 kEjectButton: 
 DoEject;
 kDriveButton: 
 DoDrive;
 cmdDiskEvent: 
 DoStatus;
 OTHERWISE
 INHERITED DoCommand(TheCommand);
 END;
 END;

PROCEDURE CSFWindow.Update;
 Override;
 VAR
 savePort: GrafPtr;{ The current port }
 updateRect: Rect; { Bounding box of update region }
 BEGIN
 GetPort(savePort);{ Save the original port }
 Prepare;

 BeginUpdate(macPort);    { Start the update process }
 { This restricts the visible area }
 {   to just the update region, }
 {   meaning that no drawing will }
 {   occur outside this region }

 ClipRect(macPort^.portRect); { Clip to the entire window      
 }

 { Your updates occur here }
 MoreUpdates;

 IF itsSubviews <> NIL THEN
 BEGIN    { Draw all subviews }

 updateRect := macPort^.visRgn^^.rgnBBox;
 itsSubviews.DoForEach1(Pane_Draw, @updateRect);
 END;

 EndUpdate(macPort); { End the update process      }
 SetPort(savePort);{ Restore the original port     }
 END;

PROCEDURE CSFWindow.MoreUpdates;
{ Override to do your updates }
 VAR
 TheRect: Rect;
 BEGIN
 { update the file box }
 LUpdate(macPort^.VisRgn, fFileList);
 FrameRect(fViewRect);

 { update the pull down menu }
 LUpdate(MacPort^.VisRgn, fPathList);
 FrameRect(fPathRect);
 DropShadow(fPathRect);
 END;

PROCEDURE CSFWindow.Free;
 Override;
{ Dispose of the buttons and stuff }
 BEGIN
 fEject.Free;
 fDrive.Free;
 fCancel.Free;
 LDispose(fFileList);
 LDispose(fPathList);
 INHERITED Free;
 END;

PROCEDURE CSFWindow.Activate;
 Override;
{ Set up globals and disable function keys }
 VAR
 TheCell: Cell;
 BEGIN
 INHERITED Activate;

 FKeyEnable(False);
 gGopher := Self;
 ThePathList := fPathList;
 FillDialog(fCurrentWD);

 { if theis a new window then select }
 IF fInitTime THEN
 BEGIN
 SetPt(TheCell, 0, 0);
 LSetSelect(True, TheCell, fFileList);
 fInitTime := False
 END;

 DoStatus;
 END;

PROCEDURE CSFWindow.Deactivate;
 Override;
{ Clean up after ourselves }
 BEGIN
 FKeyEnable(True);
 INHERITED Deactivate;
 END;

PROCEDURE CSFWindow.Close;
 Override;
{ The party is over }
 BEGIN
 FKeyEnable(True);
 INHERITED Close;
 END;

FUNCTION CSFWindow.CountDrives: Integer;
{ Count the number of mounted volumes }
 VAR
 Index, Count: Integer;
 Err: OSErr;
 PB: HParamBlockRec;
 BEGIN
 IF CheckDrives THEN
 ;
 Index := 0;
 Count := 0;
 Err := NoErr;
 WHILE Err <> nsvErr DO
 BEGIN
 Index := Index + 1;
 WITH PB DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVolIndex := Index;
 END;
 Err := PBHGetVInfo(@PB, False);
 IF (PB.ioVDrvInfo = 0) AND NOT (Err = nsvErr) THEN
 BEGIN
 Err := NoErr;
 Cycle;
 END;
 IF Err <> nsvErr THEN
 Count := Count + 1;
 END;
 CountDrives := Count;
 END;

FUNCTION CSFWindow.GetNextVol: Integer;
{ Find the next mounted volume }
 VAR
 Index: Integer;
 Err: OSErr;
 PB: HParamBlockRec;
 BEGIN
 IF CheckDrives THEN
 ;
 Index := fDriveIndex;
 Err := paramErr;
 WHILE Err <> NoErr DO
 BEGIN
 Index := Index + 1;
 WITH PB DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVolIndex := Index;
 END;
 Err := PBHGetVInfo(@PB, False);
 IF (PB.ioVDrvInfo = 0) AND NOT (Err = nsvErr) THEN
 BEGIN
 Err := nsvErr;
 Cycle;
 END;
 IF Err = nsvErr THEN
 Index := 0;
 END;
 fDriveIndex := Index;
 GetNextVol := PB.ioVRefNum;
 END;

FUNCTION CSFWindow.CheckDrives: Boolean;
{ Check the status of the floppy disk drives }
 VAR
 FreeBytes: Longint;
 Err, Ignore: OSErr;
 Index: Integer;
 Status: DrvSts;
 BEGIN
 CheckDrives := False;

 fDrive1 := 0;
 fDrive2 := 0;
 Err := DriveStatus(1, Status);
 IF (Status.Installed = 1) AND (Status.DiskInPlace <> 0) THEN
 Ignore := GetVInfo(1, NIL, fDrive1, FreeBytes);

 Err := DriveStatus(2, Status);
 IF (Status.Installed = 1) AND (Status.DiskInPlace <> 0) THEN
 Ignore := GetVInfo(2, NIL, fDrive2, FreeBytes);

 IF (fDrive1 <> 0) OR (fDrive2 <> 0) THEN
 CheckDrives := True;
 END;

PROCEDURE CSFWindow.DoEject;
{ Eject a floppy disk }
 VAR
 WorkingDir: Integer;
 b: boolean;
 BEGIN
 IF fDriveIndex <> 1 THEN
 BEGIN
 b := gError.CheckOSError(Eject(NIL, fCurrentWD));
 fCurrentWD := GetNextVol;
 FillDialog(fCurrentWD);
 FindPath(fCurrentWD);
 DoStatus;
 END;
 END;

PROCEDURE CSFWindow.DoDrive;
{ Change drives }
 BEGIN
 IF fDrive.IsActive THEN
 BEGIN
 fCurrentWD := GetNextVol;
 FillDialog(fCurrentWD);
 FindPath(fCurrentWD);
 DoStatus;
 END;
 END;

PROCEDURE CSFWindow.DoCancel;
{ Close the window }
{ Override this method to cancel your operations }
 BEGIN
 Close;
 END;

PROCEDURE CSFWindow.DoStatus;
{ Bring buttons upto date }
 VAR
 Err: OSErr;
 VRefNum: Integer;
 BEGIN
 { more than one volume mounted }
 IF CountDrives > 1 THEN
 fDrive.Activate
 ELSE
 fDrive.Deactivate;

 { Ejectable disks in place }
 IF CheckDrives THEN
 BEGIN
 IF (GetVRefNum(fCurrentWD) = fDrive1) OR (GetVRefNum(fCurrentWD) = fDrive2) 
THEN
 fEject.Activate
 ELSE
 fEject.Deactivate;
 END
 ELSE
 BEGIN
 fEject.Deactivate;
 END;

 fVolumeBox.Refresh;
 END;

PROCEDURE CSFWindow.DoClick (hitPt: Point; modifierKeys: integer; when: 
longint);
 Override;
{ Handle clicks in the file box and the puldown menu }
 VAR
 b: Boolean;
 TheCell: Cell;
 TheLength: Integer;
 TheDirectory, TheName: Str255;
 TheRect: Rect;
 TheSelection: Str255;
 Temp: Integer;
 Err: OSErr;
 BEGIN
 { Click in file box? }
 IF PtInRect(hitPt, fViewRect) THEN
 BEGIN
 Prepare;
 ClipRect(MacPort^.PortRect);
 B := LClick(hitPt, modifierKeys, fFileList);
 TheSelection := FindSelection;
 { Inactive }
 IF TheSelection[1] = '-' THEN
 BEGIN
 SetPt(TheCell, 0, 0);
 IF LGetSelect(True, TheCell, fFileList) THEN
 BEGIN
 LSetSelect(False, TheCell, fFileList);
 DoStatus;
 END;
 END
 { Open the file of directory }
 ELSE IF (gClicks > 1) THEN
 BEGIN
 IF TheSelection[1] = '+' THEN
 BEGIN
 IF TheSelection[2] = '@' THEN
 BEGIN
 { Directory }
 fCurrentWD := ChangeDirectory(fCurrentWD, Omit(TheSelection, 1, 2));
 FillDialog(fCurrentWD);
 FindPath(fCurrentWD);
 DoStatus;
 END
 ELSE
 BEGIN
 { File }
 fGood := True;
 fName := Omit(TheSelection, 1, 2);
 Err := GetVol(@fVName, Temp);
 DoCommand(kSelection);
 END;
 END;
 END;
 END;

 { Pull down menu }
 IF PtInRect(hitPt, fPathRect) THEN
 BEGIN
 Prepare;
 ClipRect(MacPort^.PortRect);
 LSize(fMenuWidth, fMenuHeight, fPathList);
 fPathRect := fPathList^^.rView;
 InsetRect(fPathRect, -1, -1);
 EraseRect(fPathRect);
 FrameRect(fPathRect);
 DropShadow(fPathRect);
 LUpdate(MacPort^.VisRgn, fPathList);
 B := LClick(hitPt, modifierKeys, fPathList);

 LSetSelect(False, ThePathCell, fPathList);

 IF ThePathCell.v > 0 THEN
 BEGIN
 { Move up directory tree }
 fCurrentWD := FindParent(fCurrentWD, ThePathCell.v);
 FillDialog(fCurrentWD);
 FindPath(fCurrentWD);
 END
 ELSE
 BEGIN
 SetPathRect;
 END;
 END;

 INHERITED DoClick(hitPt, modifierKeys, when);
 END;

FUNCTION CSFWindow.FileFilter (ParamBlock: CInfoPBPtr): Boolean;
{ Filter out unwanted files from showing in the file box }
 BEGIN
 { False means to show the file }
 FileFilter := False;
 END;

FUNCTION CSFWindow.ActiveFilter (ParamBlock: CInfoPBPtr): Boolean;
{ Activate the file--not grayed out }
 BEGIN
 ActiveFilter := True;
 END;

PROCEDURE CSFWindow.FillDialog (VRefNum: Integer);
{ Read the directory and fill the file box }
 VAR
 Err: OSErr;
 Count, Index: Integer;
 TheTitle: Str255;
 ParamBlock: CInfoPBPtr;
 TheName: Str255;
 TheCell: Cell;
 BEGIN
 Err := SetVol(NIL, VRefNum);
 ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec)));
 Index := 1;
 TheCell.h := 0;
 Err := NoErr;
 LDoDraw(False, fFileList);
 LDelRow(0, 0, fFileList);
 WHILE (Err = NoErr) DO
 BEGIN
 TheName := '';
 WITH ParamBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := @TheName;
 ioVRefNum := VRefNum;
 ioDirID := 0;
 ioDrDirID := 0;
 ioFVersNum := 0;
 ioFDirIndex := Index;
 END;
 Err := PBGetCatInfo(ParamBlock, False);
 IF (Err = fnfErr) THEN
 Leave;
 IF Err <> NoErr THEN
 BEGIN
 { Ka-Boom }
 Index := RedAlert(kSystemError);
 Leave;
 END;
 { Include file or directory? }
 IF FileFilter(ParamBlock) THEN
 BEGIN
 Cycle;
 END;
 { Is it a directory }
 IF IsDirectory(ParamBlock) THEN
 BEGIN
 TheName := Concat('@', TheName);
 END
 ELSE
 BEGIN
 IF ParamBlock^.ioFlFndrInfo.fdType = 'APPL' THEN
 TheName := Concat('#', TheName)
 ELSE
 TheName := Concat('!', TheName);
 END;
 { Grayed? }
 IF ActiveFilter(ParamBlock) THEN
 BEGIN
 { Activate }
 TheName := Concat('+', TheName);
 END
 ELSE
 BEGIN
 { Dectivate }
 TheName := Concat('-', TheName);
 END;
 { Stuff it }
 TheCell.v := LAddRow(1, Maxint, fFileList);
 LSetCell(Ptr(@TheName[1]), Length(TheName), TheCell, fFileList);
 Index := Index + 1;
 END;
 LDoDraw(True, fFileList);
 Prepare;
 ClipRect(GetMacPort^.PortRect);
 EraseRect(fFileList^^.rView);
 LUpdate(MacPort^.VisRgn, fFileList);
 DisposPtr(Ptr(ParamBlock));
 END;

PROCEDURE CSFWindow.SetPathRect;
{ Find the pull down menu rect }
 VAR
 TheString, TheDirectory: Str255;
 TheCell: Cell;
 TheLength: Integer;
 TheRect: Rect;
 BEGIN
 { Out with the old }
 TheRect := fPathRect;
 InsetRect(TheRect, -1, -1);
 EraseRect(TheRect);
 InvalRect(TheRect);

 SetPt(TheCell, 0, 0);
 IF LGetSelect(True, TheCell, fPathList) THEN
 ;
 TheDirectory := GetCellContents(TheCell, fPathList);
 TheLength := StringWidth(TheDirectory) + 28;
 LSize(TheLength, fPathList^^.CellSize.v, fPathList);
 fPathList^^.rView.Left := (((fViewRect.Right - fViewRect.Left + 16) 
DIV 2) + fViewRect.Left) - (TheLength DIV 2);
 fPathList^^.rView.Right := fPathList^^.rView.Left + TheLength;
 fPathRect := fPathList^^.rView;

 SetPt(TheCell, 0, 0);
 TheString := GetCellContents(TheCell, fPathList);
 TheString := Omit(TheString, 1, 2);
 TheLength := StringWidth(TheString);

 fPathRect := fPathList^^.rView;
 fPathRect.Right := fPathRect.Left + TheLength + 28;
 InsetRect(fPathRect, -1, -1);

 { In with the new }
 InvalRect(TheRect);
 TheRect := fPathRect;
 InsetRect(TheRect, -1, -1);
 InvalRect(TheRect);
 EraseRect(TheRect);
 Update;
 END;

PROCEDURE CSFWindow.FindPath (VRefNum: Integer);
{ Fill the pull down menu }
 VAR
 ParamBlock: CInfoPBPtr;
 TheName, LastName: Str255;
 Err: OSErr;
 TheCell: Cell;
 TheWidth, PathWidth, Ignore: Integer;
 FirstWidth: Boolean;
 BEGIN
 IF VRefNum = 0 THEN
 Err := GetVol(NIL, VRefNum);

 Err := SetVol(NIL, VRefNum);

 LastName := '';
 FirstWidth := True;

 fMenuWidth := 0;
 fMenuHeight := 0;

 { Clear the List }
 LDoDraw(False, fPathList);
 LDelRow(0, 0, fPathList);

 ParamBlock := CInfoPBPtr(NewPtr(SizeOf(CInfoPBRec)));

 WITH ParamBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := NIL;
 ioVRefNum := VRefNum;
 ioDirID := 0;
 ioFVersNum := 0;
 ioFDirIndex := 0;
 END;
 Err := PBGetCatInfo(ParamBlock, False);

 Err := NoErr;
 WHILE Err = NoErr DO
 BEGIN
 TheName := '';
 WITH ParamBlock^ DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := @TheName;
 ioVRefNum := VRefNum;
 ioDirID := 0;
 ioDrDirID := ioDrParID;  { We want the parent directory name }
 ioFVersNum := 0;
 ioFDirIndex := -1;  { Causes it to give information on ioDrDirID }
 END;
 Err := PBGetCatInfo(ParamBlock, False);
 IF Err = NoErr THEN
 BEGIN
 { Determine a length and compare it, if it is larger then store the 
value }
 TheWidth := StringWidth(TheName) + 28;
 IF FirstWidth THEN
 BEGIN
 FirstWidth := False;
 PathWidth := TheWidth;
 END;

 IF TheWidth > fMenuWidth THEN
 fMenuWidth := TheWidth;

 LastName := TheName;

 { Add a new row to the list }
 TheName := Concat('+$', TheName);
 TheCell.h := 0;
 TheCell.v := LAddRow(1, Maxint, fPathList);
 LSetCell(Ptr(@TheName[1]), Length(TheName), TheCell, fPathList);

 { Increment the height }
 fMenuHeight := fMenuHeight + 16;
 END
 ELSE
 BEGIN
 { Change the icon of the last item }
 IF LastName <> '' THEN
 BEGIN
 Ignore := GetVol(NIL, VRefNum);
 IF CheckDrives THEN
 BEGIN
 IF (fDrive1 = GetVRefNum(VRefNum)) OR (fDrive2 = GetVRefNum(VRefNum)) 
THEN
 TheName := Concat('+^', LastName)
 ELSE
 TheName := Concat('+%', LastName);
 END
 ELSE
 TheName := Concat('+%', LastName);
 LSetCell(Ptr(@TheName[1]), Length(TheName), TheCell, fPathList);
 END
 ELSE
 sysbeep(1);
 END;
 END;

 IF fMenuHeight >= (MacPort^.PortRect.Bottom - fPathRect.Top - 10) THEN
 fMenuHeight := ((MacPort^.PortRect.Bottom - fPathRect.Top - 10) DIV 
16) * 16;

 InsetRect(fPathRect, -1, -1);
 EraseRect(fPathRect);
 LSize(fMenuWidth, 16, fPathList);
 LDoDraw(True, fPathList);
 SetPathRect;
 FrameRect(fPathRect);
 DropShadow(fPathRect);

 DisposPtr(Ptr(ParamBlock));
 END;

FUNCTION CSFWindow.FindSelection: Str255;
{ Find the first selected item in the file box }
 VAR
 TheCell: Cell;
 BEGIN
 SetPt(TheCell, 0, 0);
 IF LGetSelect(True, TheCell, fFileList) THEN
 FindSelection := GetCellContents(TheCell, fFileList)
 ELSE
 FindSelection := '';
 END;

PROCEDURE CSFWindow.DoSelection;
{ Set up the SFReply }
 VAR
 TheReply: SFReply;
 FndrInfo: FInfo;
 Err: OSErr;
 BEGIN
 { Set up the reply }
 WITH TheReply DO
 BEGIN
 Good := fGood;
 Copy := False;
 Err := GetFInfo(Self.fName, fCurrentWD, FndrInfo);
 fType := FndrInfo.fdType;
 vRefNum := fCurrentWD;
 Version := 0;
 fName := Self.fName;
 END;

 FileSelected(TheReply);
 END;

PROCEDURE CSFWindow.FileSelected (TheReply: SFReply);
{ Override me!!!!!!!!!  This where you handle the reply. }
 BEGIN
 Sysbeep(1);
 END;

FUNCTION CSFWindow.RedAlert (AlertID: Integer): Integer;
{ Display error alerts }
 CONST
 kAlertOffset = 15;
 TYPE
 AlertTHndl = ^AlertTPtr;
 AlertTPtr = ^AlertTemplate;
 VAR
 TheAlert: AlertTHndl;
 TheAlertRect, TheRect, TheBounds, TheFrame: Rect;
 ThePoint: Point;
 BEGIN
 { Get the alert }
 TheAlert := AlertTHndl(GetResource('ALRT', AlertID));
 HNoPurge(Handle(TheAlert));

 { Move the alert }
 TheAlertRect := TheAlert^^.boundsRect;
 gDeskTop.GetBounds(TheBounds);
 TheFrame := MacPort^.PortRect;
 LocalToGlobal(TheFrame.TopLeft);
 LocalToGlobal(TheFrame.BotRight);
 IF SectRect(TheBounds, TheFrame, TheRect) THEN
 BEGIN
 ThePoint.v := TheRect.Bottom - TheAlertRect.Bottom - kAlertOffset;
 ThePoint.h := TheRect.Left + kAlertOffset;
 IF NOT PtInRect(ThePoint, TheBounds) THEN
 BEGIN
 IF ThePoint.v < TheBounds.Left THEN
 ThePoint.v := TheBounds.Left;
 IF ThePoint.h < TheBounds.Top THEN
 ThePoint.h := TheBounds.Top;
 END;
 SetRect(TheAlertRect, ThePoint.h, ThePoint.v, ThePoint.h + TheAlert^^.boundsRect.Right, 
ThePoint.v + TheAlert^^.boundsRect.Bottom);
 IF TheAlertRect.Right > TheBounds.Right THEN
 BEGIN
 TheAlertRect.Left := TheAlertRect.Left - (TheAlertRect.Right - TheBounds.Right);
 TheAlertRect.Right := TheAlertRect.Left + (TheAlertRect.Right - TheBounds.Right);
 END;
 IF TheAlertRect.Bottom > TheBounds.Bottom THEN
 BEGIN
 TheAlertRect.Top := TheAlertRect.Top - (TheAlertRect.Bottom - TheBounds.Bottom);
 TheAlertRect.Bottom := TheAlertRect.Top + (TheAlertRect.Bottom - TheBounds.Bottom);
 END;
 END
 ELSE
 BEGIN
 SetRect(TheAlertRect, TheAlertRect.Left + 100, TheAlertRect.Top + 100, 
TheAlertRect.Right + 100, TheAlertRect.Bottom + 100);
 END;

 { Display the alert }
 TheAlert^^.boundsRect := TheAlertRect;
 RedAlert := Alert(AlertID, NIL);
 HPurge(Handle(TheAlert));
 ReleaseResource(Handle(TheAlert));
 END;

PROCEDURE CSFGetWindow.MoreInitializations;
 Override;
{ Follow this example to do your initializations }
 VAR
 TheSize: Rect;

 BEGIN

 fEject.Offset(kGetButtonOffset, 76, True);
 fDrive.Offset(kGetButtonOffset, 101, True);
 fCancel.Offset(kGetButtonOffset, 171, True);

 SetRect(TheSize, 0, 0, 70, kButtonHeight);

 New(fOpen);
 fOpen.IButton(KPushButton, Self, Self);
 fOpen.SetClickCmd(kOpenButton);
 fOpen.ChangeSize(TheSize, False);
 fOpen.Offset(kGetButtonOffset, 146, False);
 fOpen.SetTitle('Open');
 fOpen.Deactivate;
 fOpen.Show;

 ChangeSize(363, 215);

 END;


PROCEDURE CSFGetWindow.DoKeyDown (theChar: char; keyCode: Byte; macEvent: 
EventRecord);
 Override;
{ Special key handling }
 BEGIN
 CASE keyCode OF
 $24, $34: 
 DoCommand(kOpenButton);
 OTHERWISE
 INHERITED DoKeyDown(theChar, keyCode, macEvent);
 END;
 END;

PROCEDURE CSFGetWindow.SetfViewRect;
 Override;
{ Resize the file box }
 BEGIN
 SetRect(fViewRect, 20, 47, 237 - kScrollBarWidth, 47 + (9 * 16));
 END;

PROCEDURE CSFGetWindow.DoCommand (TheCommand: Longint);
 Override;
{ Do the commands for this subclass }
 BEGIN
 CASE TheCommand OF
 kOpenButton: 
 DoOpen;
 kSelection: 
 DoSelection;
 OTHERWISE
 INHERITED DoCommand(TheCommand);
 END;
 END;

PROCEDURE CSFGetWindow.MoreUpdates;
 Override;
{ Add our updates }
 BEGIN
 INHERITED MoreUpdates;

 PenPat(Gray);
 Moveto(260, 132);
 Lineto(338, 132);
 PenNormal;
 END;

PROCEDURE CSFGetWindow.DoStatus;
 Override;
{ Add the open button to the status logic }
 VAR
 TheCell: Cell;
 BEGIN
 INHERITED DoStatus;

 SetPt(TheCell, 0, 0);
 IF LGetSelect(True, TheCell, fFileList) THEN
 BEGIN
 fOpen.Activate;
 END
 ELSE
 BEGIN
 fOpen.Deactivate;
 END;
 END;

PROCEDURE CSFGetWindow.DoClick (hitPt: Point; modifierKeys: integer; 
when: longint);
 Override;
{ Make sure we have the correct file selected }
 VAR
 TheCell: Cell;
 SaveDirectory: Integer;
 BEGIN
 SaveDirectory := fCurrentWD;

 INHERITED DoClick(hitPt, modifierKeys, when);

 IF (SaveDirectory <> fCurrentWD) AND (fFileList^^.dataBounds.Bottom 
> 0) THEN
 BEGIN
 Prepare;
 ClipRect(MacPort^.PortRect);
 SetPt(TheCell, 0, 0);
 LSetSelect(True, TheCell, fFileList);
 END;

 SetPt(TheCell, 0, 0);
 IF LGetSelect(True, TheCell, fFileList) THEN
 BEGIN
 fOpen.Activate;
 END
 ELSE
 BEGIN
 fOpen.Deactivate;
 END;
 END;

PROCEDURE CSFGetWindow.Free;
 Override;
{ Get rid of the open button }
 BEGIN
 fOpen.Free;

 INHERITED Free;
 END;

PROCEDURE CSFGetWindow.DoOpen;
{ Respond to the open button }
 VAR
 TheRect: Rect;
 TheSelection: Str255;
 TheCell: Cell;
 Temp: Integer;
 Err: OSErr;
 BEGIN
 IF fOpen.IsActive THEN
 BEGIN
 TheSelection := FindSelection;
 IF TheSelection[1] = '+' THEN
 BEGIN
 IF TheSelection[2] = '@' THEN
 BEGIN
 { Directory selected }
 fCurrentWD := ChangeDirectory(fCurrentWD, Omit(TheSelection, 1, 2));
 FillDialog(fCurrentWD);
 FindPath(fCurrentWD);
 TheRect := fPathRect;
 InsetRect(TheRect, -1, -1);
 InvalRect(TheRect);
 EraseRect(TheRect);
 Update;
 DoStatus;

 Prepare;
 ClipRect(MacPort^.PortRect);
 SetPt(TheCell, 0, 0);
 LSetSelect(True, TheCell, fFileList);
 IF LGetSelect(True, TheCell, fFileList) THEN
 fOpen.Activate;
 END
 ELSE
 BEGIN
 { File selected }
 fGood := True;
 fName := Omit(TheSelection, 1, 2);
 Err := GetVol(@fVName, Temp);
 DoCommand(kSelection);
 END;
 END;
 END;
 END;

PROCEDURE CSFSaveWindow.MoreInitializations;
 Override;
{ Move existing buttons and add the save button and edit box }
 VAR
 TheSize: Rect;
 BEGIN
 fEject.Offset(kSaveButtonOffset, 64, True);
 fDrive.Offset(kSaveButtonOffset, 90, True);
 fCancel.Offset(kSaveButtonOffset, 166, True);

 SetRect(TheSize, 0, 0, 70, kButtonHeight);

 New(fSave);
 fSave.IButton(KPushButton, Self, Self);
 fSave.SetClickCmd(kSaveButton);
 fSave.ChangeSize(TheSize, False);
 fSave.Offset(kSaveButtonOffset, 140, False);
 fSave.SetTitle('Save');
 fSave.Deactivate;
 fSave.Show;

 fPromptString := 'Save file as ';

 New(fFileName);
 fFileName.IEditText(Self, Self, fViewRect.Right - fViewRect.Left - 4, 
16, fViewRect.Left + 2, fViewRect.Bottom + 30, sizFIXEDLEFT, sizFIXEDTOP, 
-1);
 fFileName.SelectText;
 fFileName.Show;

 ChangeSize(319, 199);
 SetTitle('Save');
 END;

PROCEDURE CSFSaveWindow.SetfViewRect;
 Override;
{ Move the file box }
 BEGIN
 SetRect(fViewRect, 22, 37, 204 - kScrollBarWidth, 37 + (6 * 16));
 END;

FUNCTION CSFSaveWindow.ActiveFilter (ParamBlock: CInfoPBPtr): Boolean;
 Override;
{ Only activate directories }
 BEGIN
 IF ParamBlock^.ioFlFndrInfo.fdType = 'APPL' THEN
 BEGIN
 ActiveFilter := False;
 Exit(ActiveFilter);
 END;

 IF IsDirectory(ParamBlock) THEN
 ActiveFilter := True
 ELSE
 ActiveFilter := False;
 END;

PROCEDURE CSFSaveWindow.Activate;
 Override;
{ Set the gopher to the edit box }
 BEGIN
 INHERITED Activate;
 gGopher := fFileName;
 END;

PROCEDURE CSFSaveWindow.DoCommand (TheCommand: Longint);
 Override;
{ Handle the commands for this subclass }
 BEGIN
 CASE TheCommand OF
 kSaveButton: 
 DoSave;
 kSelection: 
 DoSelection;
 kEmptyText: 
 fSave.Deactivate;
 kNonEmptyText: 
 fSave.Activate;
 OTHERWISE
 INHERITED DoCommand(TheCommand);
 END;
 END;

PROCEDURE CSFSaveWindow.MoreUpdates;
 Override;
{ Update edit box }
 VAR
 TheRect: Rect;
 BEGIN
 INHERITED MoreUpdates;

 IF IsVisible THEN
 BEGIN
 TheRect := fFileName.Frame;
 fFileName.FrameToEnclR(TheRect);
 InSetRect(TheRect, -3, -3);
 FrameRect(TheRect);
 END;

 Moveto(fViewRect.Left, fViewRect.Bottom + 21);
 DrawString(fPromptString);
 END;

PROCEDURE CSFSaveWindow.Free;
 Override;
{ Dispose of the save button and edit box }
 BEGIN
 fSave.Free;
 fFileName.Free;

 INHERITED Free;
 END;

FUNCTION CSFSaveWindow.FileExists (vRefNum: Integer; TheName: Str255): 
Boolean;
{ Find out if the file is already on the disk }
 VAR
 FndrInfo: FInfo;
 Err: OSErr;
 Ignore: Integer;
 ParamBlock: CInfoPBRec;
 BEGIN
 Prepare;
 WITH ParamBlock DO
 BEGIN
 ioCompletion := NIL;
 ioNamePtr := @TheName;
 ioVRefNum := VRefNum;
 ioDrDirID := 0;
 ioDirID := 0;
 ioFVersNum := 0;
 ioFDirIndex := 0;
 END;
 Err := PBGetCatInfo(@ParamBlock, False);
 IF IsDirectory(@ParamBlock) THEN
 BEGIN
 Err := NoErr;
 END;

 CASE Err OF
 fnfErr: 
 BEGIN
 FileExists := False;
 END;
 NoErr: 
 BEGIN
 CASE Rename(TheName, vRefNum, TheName) OF
 fLckdErr, vLckdErr, wPrErr: 
 BEGIN
 Ignore := RedAlert(kLockedDisk);
 FileExists := True;
 Exit(FileExists);
 END;
 END;
 ParamText(TheName, '', '', '');
 IF RedAlert(kExistingFile) = 1 THEN
 FileExists := True
 ELSE
 FileExists := False;
 END;
 OTHERWISE
 BEGIN
 Ignore := RedAlert(kSystemError);
 FileExists := True;
 END;
 END;
 END;

PROCEDURE CSFSaveWindow.DoSave;
{ Respond to the save button }
 VAR
 Temp: Integer;
 Err: OSErr;
 BEGIN
 IF fSave.IsActive THEN
 BEGIN
 fGood := True;
 fName := fFileName.GetStr255;
 Err := GetVol(@fVName, Temp);
 IF NOT FileExists(Temp, fName) THEN
 BEGIN
 DoCommand(kSelection);
 FillDialog(fCurrentWD);
 END;
 END;
 END;

PROCEDURE CSFDialog.ICSFDialog;
{ Initialize and install our window subclass }
 BEGIN
 IDirector(gApplication);
 New(CSFWindow(ItsWindow));
 CSFWindow(ItsWindow).ICSFWindow(Self);

 FKeyEnable(False);
 END;

PROCEDURE CSFGetDialog.ICSFDialog;
 Override;
{ Initialize and install our window subclass }
 BEGIN
 IDirector(gApplication);
 New(CSFGetWindow(ItsWindow));
 CSFGetWindow(ItsWindow).ICSFWindow(Self);

 FKeyEnable(False);
 END;

PROCEDURE CSFSaveDialog.ICSFDialog;
 Override;
{ Initialize and install our window subclass }
 BEGIN
 IDirector(gApplication);
 New(CSFSaveWindow(ItsWindow));
 CSFSaveWindow(ItsWindow).ICSFWindow(Self);

 itsGopher := CSFSaveWindow(ItsWindow).fFileName;

 FKeyEnable(False);
 END;

PROCEDURE CSFSwitchboard.DoDiskEvent (macEvent: EventRecord);
 Override;
{ Intercept disk events }
 BEGIN
 INHERITED DoDiskEvent(macEvent);
 gGopher.DoCommand(cmdDiskEvent);
 END;

PROCEDURE CSFApplication.ICSFApplication (extraMasters: integer; aRainyDayFund, 
aCreditLimit: Size);
{ Install the new switchboard }
 CONST
 JUMPBUFFER_A1 = 5;{ Index of A1 in JumpBuffer }
 BEGIN
 MenuDisable := LongPtr($B54);{ Low-memory global  }

 nullStr := '';

 { We haven't reached the event loop yet.  }
 { Flag A1 (jump addr) so we don't try to jump there.  }

 eventLoopJump[JUMPBUFFER_A1] := 0;

 InitToolbox;

 InitMemory(extraMasters, aRainyDayFund, aCreditLimit);

 { Instance Variables }

 IBureaucrat(NIL);

 { Install CSF switchboard }
 new(CSFSwitchboard(itsSwitchboard));
 itsSwitchboard.ISwitchboard;

 new(itsDirectors);
 itsDirectors.ICluster;
 new(itsIdleChores);
 itsIdleChores.IList;
 new(itsUrgentChores);
 itsUrgentChores.ICluster;
 urgentsToDo := FALSE;
 running := TRUE;

 { Global Variables }

 gSignature := '????';
 gHasWNE := WNEIsImplemented;
 gSleepTime := 0;{ We want an early first Idle }
 new(gError);

 { Cursors }

 gIBeamCursor := GetCursor(iBeamCursor);
 HNoPurge(Handle(gIBeamCursor));
 gWatchCursor := GetCursor(watchCursor);
 HNoPurge(Handle(gWatchCursor));

 gUtilRgn := NewRgn;

 MakeDesktop;
 MakeClipboard;
 MakeDecorator;
 SetUpFileParameters;
 SetUpMenus;

 gGopher := SELF;
 gLastViewHit := NIL;
 gLastMouseUp.when := 0;
 gClicks := 0;
 END;
END.

Listing: StarterIntf.p

UNIT StarterIntf;
INTERFACE
USES
 TCL, CSFDialogs;
CONST
 CSFOpenCmd = 9998;
 CSFSaveCmd = 9999;
...
TYPE
 CStarterApp = OBJECT(CSFApplication)
...
IMPLEMENTATION
END.

Listing: CStarterApp.p

UNIT CStarterApp;
INTERFACE
USES
 TCL, CSFDialogs, StarterIntf;
IMPLEMENTATION
PROCEDURE CStarterApp.IStarterApp;
 BEGIN
 ICSFApplication(4, 20480, 2048);
 END;
...
PROCEDURE CStarterApp.DoCommand (theCommand: longint);
 VAR
 aCSFGetDialog: CSFGetDialog;
 aCSFSaveDialog: CSFSaveDialog;
 BEGIN
 CASE theCommand OF
 CSFOpenCmd: 
 BEGIN
 New(aCSFGetDialog);
 aCSFGetDialog.ICSFDialog
 END;

 CSFSaveCmd: 
 BEGIN
 New(aCSFSaveDialog);
 aCSFSaveDialog.ICSFDialog
 END;

 OTHERWISE 
 { Invoke inherited method  }
 { to handle other commands }
 INHERITED DoCommand(theCommand);  
 END;
 END;

PROCEDURE CStarterApp.UpdateMenus;
 BEGIN
 INHERITED UpdateMenus;   { Enable standard commands}

 gBartender.EnableCmd(CSFOpenCmd);
 gBartender.EnableCmd(CSFSaveCmd);
 END;
...
END.

Listing: CStarterDoc.p

UNIT CStarterDoc;
INTERFACE
USES
 TCL, CSFDialogs, StarterIntf;
IMPLEMENTATION
...
END.

Listing: CStarterPane.p

UNIT CStarterPane;
INTERFACE
USES
 TCL, CSFDialogs, StarterIntf;
IMPLEMENTATION
...
END.

Listing: Starter.p

PROGRAM Starter;
{$I-}
USES
 TCL, CSFDialogs, StarterIntf;
BEGIN
...
END.

Listing: CSFLDEF.p

{ Written by Brendan Murphy }
{ Version 1.0 }

{ The first two bytes of cell data represent display info }
{ Byte 1: '+' is active, '-' is inactive }
{ Byte 2:  Defined below }
 { '!':   File }
 { '@': Closed Folder }
 {'#':   Application }
 {'$':   Open Folder }
 {'%':   Hard Drive }
 {'^':   Floppy Disk }
UNIT SimpleListLDEF;
{ List definition for pop-up menu }
INTERFACE
PROCEDURE Main (message: Integer; select: Boolean; VAR TheRect: Rect; 
theCell: Cell; dataOffSet: Integer; dataLen: Integer; theList: ListHandle);
IMPLEMENTATION
PROCEDURE Main (message: Integer; select: Boolean; VAR theRect: Rect; 
theCell: Cell; dataOffSet: Integer; dataLen: Integer; theList: ListHandle);
 PROCEDURE DrawOpenFolder;
  BEGIN
   WITH TheRect DO
    BEGIN
     Moveto(Left + 17, Top + 11);
     Lineto(Left + 17, Top + 11);
     Moveto(Left + 16, Top + 10);
     Lineto(Left + 16, Top + 9);
     Moveto(Left + 15, Top + 8);
     Lineto(Left + 15, Top + 7);

     Moveto(Left + 14, Top + 6);
     Lineto(Left + 4, Top + 6);

     Moveto(Left + 4, Top + 7);
     Lineto(Left + 4, Top + 7);
     Moveto(Left + 5, Top + 8);
     Lineto(Left + 5, Top + 9);
     Moveto(Left + 6, Top + 10);
     Lineto(Left + 6, Top + 11);

     Moveto(Left + 7, Top + 12);
     Lineto(Left + 18, Top + 12);

     Lineto(Left + 18, Top + 5);

     Moveto(Left + 17, Top + 4);
     Lineto(Left + 11, Top + 4);

     Moveto(Left + 10, Top + 3);
     Lineto(Left + 7, Top + 3);

     Moveto(Left + 6, Top + 4);
     Lineto(Left + 6, Top + 5);
    END;
  END;

 PROCEDURE DrawClosedFolder;
  BEGIN
   WITH TheRect DO
    BEGIN
     Moveto(Left + 6, Top + 4);
     Lineto(Left + 6, Top + 11);
     Lineto(Left + 18, Top + 11);
     Lineto(Left + 18, Top + 5);
     Moveto(Left + 17, Top + 4);
     Lineto(Left + 11, Top + 4);
     Moveto(Left + 10, Top + 3);
     Lineto(Left + 7, Top + 3);
    END;
  END;

 PROCEDURE DrawFile;
  BEGIN
   WITH TheRect DO
    BEGIN
     Moveto(Left + 8, Top + 12);
     Lineto(Left + 8, Top + 2);
     Lineto(Left + 14, Top + 2);
     Lineto(Left + 16, Top + 4);
     Lineto(Left + 16, Top + 12);
     Lineto(Left + 8, Top + 12);
     Moveto(Left + 14, Top + 3);
     Lineto(Left + 14, Top + 4);
     Lineto(Left + 15, Top + 4);
    END;
  END;

 PROCEDURE DrawHardDrive;
  BEGIN
   WITH TheRect DO
    BEGIN
     Moveto(Left + 3, Top + 6);
     Lineto(Left + 3, Top + 9);

     Moveto(Left + 4, Top + 10);
     Lineto(Left + 18, Top + 10);

     Moveto(Left + 19, Top + 9);
     Lineto(Left + 19, Top + 6);

     Moveto(Left + 18, Top + 5);
     Lineto(Left + 4, Top + 5);

     Moveto(Left + 5, Top + 8);
     Lineto(Left + 5, Top + 8);
    END;
  END;

 PROCEDURE DrawApplication;
  BEGIN
   WITH TheRect DO
    BEGIN
     Moveto(Left + 15, Top + 10);
     Lineto(Left + 14, Top + 10);
     Lineto(Left + 12, Top + 12);
     Lineto(Left + 7, Top + 7);
     Lineto(Left + 12, Top + 2);
     Lineto(Left + 17, Top + 7);
     Lineto(Left + 16, Top + 8);
     Lineto(Left + 14, Top + 6);
     Lineto(Left + 13, Top + 6);
     Lineto(Left + 11, Top + 8);
     Lineto(Left + 14, Top + 8);
     Lineto(Left + 13, Top + 9);
     Lineto(Left + 14, Top + 10);
     Lineto(Left + 15, Top + 10);

     Pensize(2, 1);
     Moveto(Left + 16, Top + 9);
     Lineto(Left + 16, Top + 11);
     PenNormal;
    END;
  END;

 PROCEDURE DrawFloppyDisk;
  BEGIN
   WITH TheRect DO
    BEGIN
     Moveto(Left + 5, Top + 2);
     Lineto(Left + 14, Top + 2);
     Lineto(Left + 16, Top + 4);
     Lineto(Left + 16, Top + 13);
     Lineto(Left + 5, Top + 13);

     Moveto(Left + 4, Top + 12);
     Lineto(Left + 4, Top + 3);

     Moveto(Left + 13, Top + 3);
     Lineto(Left + 13, Top + 5);

     Moveto(Left + 12, Top + 6);
     Lineto(Left + 8, Top + 6);

     Moveto(Left + 7, Top + 5);
     Lineto(Left + 7, Top + 3);

     Moveto(Left + 11, Top + 3);
     Lineto(Left + 11, Top + 4);

     Moveto(Left + 7, Top + 12);
     Lineto(Left + 7, Top + 10);

     Moveto(Left + 8, Top + 9);
     Lineto(Left + 12, Top + 9);

     Moveto(Left + 13, Top + 10);
     Lineto(Left + 13, Top + 12);
    END;
  END;

 PROCEDURE TrimName (Area: Rect; Offset: Integer; VAR TheVolume: Str255);
 { Trim the name and add '...' if needed }
  VAR
   TheLength: Integer;
   TrimmedName: Str255;
  BEGIN
   TheLength := (Area.Right - Area.Left) - Offset;
   IF Thelength >= StringWidth(TheVolume) THEN
    Exit(TrimName);
   TrimmedName := Concat(Omit(TheVolume, Length(TheVolume), 1), CHR($C9));
   WHILE StringWidth(TrimmedName) >= TheLength DO
    BEGIN
     TrimmedName := Concat(Omit(TrimmedName, Length(TrimmedName) - 1, 
2), CHR($C9));
    END;
   TheVolume := TrimmedName;
  END;

 PROCEDURE Initialize;
 { Add your initializations here }
  BEGIN
  END;

 PROCEDURE Close;
 { Reverse what ever you did for initialization here }
  BEGIN
  END;

 PROCEDURE DrawCell;
  VAR
   TheData: Str255;
   DataLength: Integer;
   P: Ptr;
   Frame: Rect;
   ThePattern: Pattern;
   Grayed: Boolean;
  BEGIN
 { Get the cell data }
   DataLength := 255;
   LGetCell(Ptr(Longint(@TheData) + 1), DataLength, TheCell, TheList);
   P := @TheData;
   P^ := Ptr(Longint(@DataLength) + 1)^;

 { Clear the cell }
   SetRect(Frame, TheRect.left + 5, TheRect.Top + 2, TheRect.left + 17, 
TheRect.Bottom - 2);
   EraseRect(TheRect);

 { Draw the icon }
 { The first two characters are info bytes }
   CASE (TheData[2]) OF
    '!':  { File }
     DrawFile;
    '@':  { Closed Folder }
     DrawClosedFolder;
    '#':  { Application }
     DrawApplication;
    '$':  { Open Folder }
     DrawOpenFolder;
    '%':  { Hard Drive }
     DrawHardDrive;
    '^':  { Floppy Disk }
     DrawFloppyDisk;
    OTHERWISE
     DrawFile;
   END;

 { Trim cell data draw it }
   MoveTo(TheRect.left + 24, TheRect.bottom - 4);
   Grayed := TheData[1] = '-';
   TheData := Omit(TheData, 1, 2);
   TrimName(TheRect, 24, TheData);
   DrawString(TheData);

 { If inactive then gray out }
   IF Grayed THEN
    BEGIN
     GetIndPattern(ThePattern, sysPatListID, 4);
     PenPat(ThePattern);
     PenMode(PatBic);
     PaintRect(TheRect);
     Pennormal;
    END
   ELSE
    BEGIN
     IF Select THEN
      InvertRect(TheRect);
    END;
  END;

 PROCEDURE DoHilite;
  VAR
   TheData: Str255;
   DataLength: Integer;
   P: Ptr;
  BEGIN
 { Get the cell data }
   DataLength := 255;
   LGetCell(Ptr(Longint(@TheData) + 1), DataLength, TheCell, TheList);
   P := @TheData;
   P^ := Ptr(Longint(@DataLength) + 1)^;

 { If active then highlite }
   IF TheData[1] = '+' THEN
    InvertRect(theRect);

  END;

 BEGIN
 { Dispatch on message type }
  CASE message OF
   lInitMsg: 
    Initialize;
   lDrawMsg: 
    DrawCell;
   lHiliteMsg: 
    DoHilite;
   lCloseMsg: 
    Close;
  END;

 END;

END.

Listing: CSFResources.r

#include "Types.r"
#include "SysTypes.r"

resource 'CNTL' (1, "Radio Button", locked, preload) {
 {0, 0, 0, 0},
 0,
 visible,
 1,
 0,
 radioButProc,
 0,
 ""
};

resource 'CNTL' (2, "Check Box", locked, preload) {
 {0, 0, 0, 0},
 0,
 visible,
 1,
 0,
 checkBoxProc,
 0,
 ""
};

resource 'CNTL' (3, "Push Button", locked, preload) {
 {0, 0, 0, 0},
 0,
 visible,
 1,
 0,
 pushButProc,
 0,
 ""
};

resource 'WIND' (9999, "OSF Window") {
 {0, 0, 200, 320},
 documentProc,
 invisible,
 goAway,
 0x0,
 ""
};

resource 'MENU' (2, "File", preload) {
 2,
 textMenuProc,
 0x7FFFF803,
 enabled,
 "File",
 { /* array: 13 elements */
 /* [1] */
 "New#2", noIcon, "N", noMark, plain;
 /* [2] */
 "Modeless Open #9998", noIcon, noKey, noMark, plain;
 /* [3] */
 "Modeless Save #9999", noIcon, noKey, noMark, plain;
 /* [4] */
 "-", noIcon, noKey, noMark, plain;
 /* [5] */
 "Close#4", noIcon, "W", noMark, plain;
 /* [6] */
 "Save#5", noIcon, "S", noMark, plain;
 /* [7] */
 "Save As #6", noIcon, noKey, noMark, plain;
 /* [8] */
 "Revert to Saved#7", noIcon, noKey, noMark, plain;
 /* [9] */
 "-", noIcon, noKey, noMark, plain;
 /* [10] */
 "Page Setup #8", noIcon, noKey, noMark, plain;
 /* [11] */
 "Print #9", noIcon, noKey, noMark, plain;
 /* [12] */
 "-", noIcon, noKey, noMark, plain;
 /* [13] */
 "Quit#1", noIcon, "Q", noMark, plain
 }
};