TweetFollow Us on Twitter

SFDialongs
Volume Number:7
Issue Number:8
Column Tag:MacOOPs!

Related Info: Dialog Manager Standard File

Modeless SFDialongs

By Brendan Murphy, Palatine, IL

[Brendan has been programming on the Macintosh since 1986. He is a graduate of the University of Minnesota Institute of Technology. He is currently employed full time by Motorola as a software engineer working on cellular switching software and he is also employed part time by the US Bureau of Mines (Twin Cities Research Center) as a Macintosh programmer creating Hydrologic applications. His expertise is in OOD and OOP with emphasis on MacApp and TCL.]

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
 }
};

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Dash 3.0.2 - Instant search and offline...
Dash is an API Documentation Browser and Code Snippet Manager. Dash helps you store snippets of code, as well as instantly search and browse documentation for almost any API you might use (for a full... Read more
FontExplorer X Pro 5.0 - Font management...
FontExplorer X Pro is optimized for professional use; it's the solution that gives you the power you need to manage all your fonts. Now you can more easily manage, activate and organize your... Read more
Typinator 6.6 - Speedy and reliable text...
Typinator turbo-charges your typing productivity. Type a little. Typinator does the rest. We've all faced projects that require repetitive typing tasks. With Typinator, you can store commonly used... Read more
Arq 4.12.1 - Online backup to Google Dri...
Arq is super-easy online backup for the Mac. Back up to your own Google Drive storage (15GB free storage), your own Amazon Glacier ($.01/GB per month storage) or S3, or any SFTP server. Arq backs up... Read more
Gutenprint 5.2.11-pre1 - Quality drivers...
Gutenprint is a suite of printer drivers that may be used with most common UNIX print spooling systems, including CUPS, lpr, LPRng, or others. Gutenprint currently supports over 2000 printer models.... Read more
Dropbox 3.6.8 - Cloud backup and synchro...
Dropbox is an application that creates a special Finder folder that automatically syncs online and between your computers. It allows you to both backup files and keep them up-to-date between systems... Read more
Evernote 6.0.15 - Create searchable note...
Evernote allows you to easily capture information in any environment using whatever device or platform you find most convenient, and makes this information accessible and searchable at anytime, from... Read more
MacUpdate Desktop 6.0.7 - Search and ins...
MacUpdate Desktop 6 brings seamless 1-click installs and version updates to your Mac. With a free MacUpdate account and MacUpdate Desktop 6, Mac users can now install almost any Mac app on macupdate.... Read more
Freeway Pro 7.0.4 - Drag-and-drop Web de...
Freeway Pro lets you design and build sophisticated responsive websites code free. With its user-oriented drag-and-drop interface, Freeway Pro helps you piece together the website of your dreams. Add... Read more
VueScan 9.5.18 - Scanner software with a...
VueScan is a scanning program that works with most high-quality flatbed and film scanners to produce scans that have excellent color fidelity and color balance. VueScan is easy to use, and has... Read more

This Week at 148Apps:June 22-26, 2015
June's Summer Journey Continues With 148Apps How do you know what apps are worth your time and money? Just look to the review team at 148Apps. We sort through the chaos and find the apps you're looking for. The ones we love become Editor’s Choice,... | Read more »
LEGO® Minifigures Online (Games)
LEGO® Minifigures Online 1.0.1 Device: iOS iPhone Category: Games Price: $4.99, Version: 1.0.1 (iTunes) Description: | Read more »
World of Tanks Blitz celebrates its firs...
Today marks the first anniversary of the launch of World of Tanks Blitz, the mobile version of the PC tank battler, World of Tanks. World of Tanks Blitz launched on iOS and Android on June 26th last year and to celebrate, Wargaming is giving all... | Read more »
Heroes and Castles 2 Has its Own Standal...
Heroes and Castles 2 is a third-person castle defense game from the same team behind Block Fortress and Bug Heroes. It's cool, it's fun, and now it has its very own free version. [Read more] | Read more »
Formula Cartoon All-Stars Lets You Race...
Ever want to pit your favorite characters from shows like Steven Universe, Adventure Time, and Regular Show against each other in a not quite death race? Well once upon a time you could, but Formula All Stars Touch N' Go doesn't exist anymore. Hope... | Read more »
Retype - Typography Photo Editor (Photo...
Retype - Typography Photo Editor 1.0 Device: iOS Universal Category: Photography Price: $2.99, Version: 1.0 (iTunes) Description: Retype is built out of passion for great typography and it's all about adding text to photo with style... | Read more »
Hungry Shark Evolution Celebrates Shark...
Shark Week is almost here, as is Independence Day, so naturally Hungry Shark Evolution is going to get in on the action. Yes, even the fireworks. [Read more] | Read more »
The New Trivia Crack Will Feature a Musi...
It's official: iHeartMedia (you may know them from iHeartRadio) will be in charge of providing music-related questions for Trivia Crack's upcoming sequel. Also Trivia Crack is getting a sequel. [Read more] | Read more »
Toca Life: City (Education)
Toca Life: City 1.0 Device: iOS Universal Category: Education Price: $2.99, Version: 1.0 (iTunes) Description: Welcome to Toca Life: City, a metropolis filled with everyday fun! Customize characters, explore exciting locations and... | Read more »
Ironkill's Big New Update is Big an...
The other popular robot fighting game on the App Store, Ironkill, has received a pretty substantial update today. We're talking new bots, new rewards, graphical tweaks; the works. [Read more] | Read more »

Price Scanner via MacPrices.net

MacBook Airs on sale for up to $75 off MSRP
Save up to $75 on the purchase of a new 2015 13″ or 11″ 1.6GHz MacBook Air at the following resellers. Shipping is free with each model: 11" 128GB MSRP $899 11" 256GB... Read more
Apple’s Education discount saves up to $300 o...
Purchase a new Mac or iPad at The Apple Store for Education and take up to $300 off MSRP. All teachers, students, and staff of any educational institution qualify for the discount. Shipping is free,... Read more
Save up to $600 with Apple refurbished Mac Pr...
The Apple Store has Apple Certified Refurbished Mac Pros available for up to $600 off the cost of new models. An Apple one-year warranty is included with each Mac Pro, and shipping is free. The... Read more
Mac Pros on sale for up to $260 off MSRP
B&H Photo has Mac Pros on sale for up to $260 off MSRP. Shipping is free, and B&H charges sales tax in NY only: - 3.7GHz 4-core Mac Pro: $2799, $200 off MSRP - 3.5GHz 6-core Mac Pro: $3719.99... Read more
Save up to $400 on 2014 15-inch Retina MacBoo...
B&H Photo has previous-generation 2014 15″ Retina MacBook Pros on sale for up to $400 off original MSRP. Shipping is free, and B&H charges NY sales tax only: - 15″ 2.2GHz Retina MacBook Pro... Read more
15-inch Retina MacBook Pros on sale for up to...
B&H Photo has new 2015 15″ Retina MacBook Pros on sale for up to $125 off MSRP including free shipping plus NY sales tax only: - 15″ 2.2GHz Retina MacBook Pro: $1899.99 $100 off - 15″ 2.5GHz... Read more
College Student Deals: Additional $100 off Ma...
Take an additional $100 off all MacBooks and iMacs at Best Buy Online with their College Students Deals Savings, valid through July 11, 2015. Anyone with a valid .EDU email address can take advantage... Read more
Apple refurbished Time Capsules available for...
The Apple Store has certified refurbished Time Capsules available for $100 off MSRP. Apple’s one-year warranty is included with each Time Capsule, and shipping is free: - 2TB Time Capsule: $199, $100... Read more
Newsweek Launches iPhone App
The venerable weekly news magazine Newsweek, owned by IBT Media, has announced the launch of its first iPhone app. The new app is available through Apple’s App Store and will allow consumers to read... Read more
New Initiative Covering 80 Million Homes Will...
Today, Internet service providers, equipment suppliers and retail equipment manufacturers joined the Consumer Electronics Association (CEA) and the National Cable & Telecommunications Association... Read more

Jobs Board

Architect / Senior Software Engineer, *Apple...
**Job Summary** Apple Pay is already changing our pay-habit in a deeper and fundamental level. We are looking for a software engineer with a passion for large scale inte Read more
Project Manager, *Apple* Retail New Store O...
**Job Summary** An Apple Retail New Store Openings & Remodels Project Manager is responsible for successfully managing the openings, remodels, and small works of Read more
*Apple* Solutions Consultant - Retail Sales...
**Job Summary** As an Apple Solutions Consultant (ASC) you are the link between our customers and our products. Your role is to drive the Apple business in a retail Read more
Program Manger, WW *Apple* Direct Fulfillme...
**Job Summary** We are seeking a business analyst to work within our Worldwide Apple Direct Fulfillment Operations team. This role will work closely with related program Read more
Hardware Design Validation Engineer - *Apple...
**Job Summary** The Apple Watch team is looking for a Hardware Design Validation Engineer. This person will be part of the Apple Watch hardware team with Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.