Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/xTextFileWindow.p

Text File | 1993-12-11 | 12.2 KB | 422 lines | [TEXT/PJMM]

unit xFileTextWindow;

{ This unit defines a subclass, xFileTextWindow, of xWindow that implements the }
{ file operations necessary for saving and reading short (up to 16000 characters) }
{ text files.  It also defines a number of procedures for dealing with commands from }
{ the File Menu. }

{ NOTE: To use this unit (or at least, to use the procedure UpdateFileMenu), you must }
{ change the resource file from generic.rsrc to TextPrint.rsrs in the Run Options }
{ dialog box. }


interface

uses
    xWindow, xTextWindow;

type
    xFileTextWindow = object(xTextWindow)

            fromFile: boolean;   { Was the text in this window read from a file? }
            fileName: string;      { If so, these two variables hold the data necessary }
            fileVRef: integer;       { to re-open that file when the window contents are saved. }

            nextTextWin: xFileTextWindow;  { This unit keeps a list of text windows that }
              { have been opened.  This is a reference to the next window in that list. }

            procedure openInRect (title: string;
                                        left, top, right, bottom: integer);
            override;
           { Open the window and initialize its instance variables. }
            procedure doSave (var done: boolean);
           { Save the contents of the window in a file; done will be false if an error }
           { occurs or if the user cancels the operation, and will be false otherwise. }
           { If the window was originally read from a file, the data is saved to the }
           { same file without further user action; otherwise, doSaveAs is called. }
            procedure doSaveAs (var done: boolean);
           { Similar to doSave, except that the user is asked to specify a file to be }
           { created. }
            procedure doClose;
            override;
           { Close the window and dispose of its data strutures; if the data in the }
           { window has been altered since it was loaded or saved, the user is given }
           { a chance to save it before closing, and can choose to abort the close }
           { operation at that time. }
        end;

procedure InitTextFileWindows;
    { MUST be called when the program starts up, if anything else from this unit is }
    { to be used. }

procedure doSaveCommand;
    { Respond to the Save command from the file menu. }

procedure doSaveAsCommand;
    { Respond to the Save As command from teh file menu. }

procedure doNewCommand;
    { Respond to the New command from the file Menu. }

procedure doOpenCommand;
    { Respond to the Open command from the File Menu. }

procedure doCloseCommand;
    { Respond to the Close command from the File Menu. }

procedure UpdateFileMenu (fileMenu: menuHandle);
    { Update the file menu as appropriate depending on whether the front window is }
    { an xTextFileWindow, and whether it has been modified or not.  IMPORTANT NOTE: }
    { It is assumed that the first five entries in the File Menu are New, Open, Save, }
    { Save As, and  Close, in that order. }

procedure CloseAllBeforeQuitting (var done: boolean);
    { This procedure should be called in response to the quit command.  It will give }
    { the user a chance to save any unsaved data before quitting.  The user can also }
    { choose to cancel.  If the user cancels or if an error occurs while saving a file, }
    { Done will be set to false; otherwise it will be true (and the program should end. }


implementation

var
    newCt: integer;  { number of untitiled windows that have been opened. }
    firstWin: xFileTextWindow;  { linked list of open windows. }

type
    response = (answerYes, answerNo, answerCancel);

procedure InitTextFileWindows;
    begin
        newCt := 0;
        firstWin := nil;
    end;

{ NOTE: the next two procedures require the presense of certain ALRT and DITL }
{ resources in the resource file for this project. }

function YesNoCancel (message: string): Response;
    var
        bttn: integer;
    begin
        ParamText(message, '', '', '');
        bttn := CautionAlert(131, nil);
        case bttn of
            1:
                YesNoCancel := answerYes;
            2:
                YesNoCancel := answerNo;
            3:
                YesNoCancel := answerCancel;
        end;
    end;

function YesNo (message: string): Response;
    var
        bttn: integer;
    begin
        ParamText(message, '', '', '');
        bttn := CautionAlert(130, nil);
        case bttn of
            1:
                YesNo := answerYes;
            2:
                YesNo := answerNo;
        end;
    end;

procedure xFileTextWindow.openInRect (title: string;
                                left, top, right, bottom: integer);
    begin
        inherited openInRect(title, left, top, right, bottom);
        fromFile := false;
        nextTextWin := firstWin;
        firstWin := self;
        maxChars := 15000;
    end;

procedure xFileTextWindow.doSave (var done: boolean);
    var
        err: OSErr;
        refNum: integer;
        chars: CharsHandle;
        count: longint;
    begin
        if (not fromFile) | trimmed then
            doSaveAs(done)
        else begin
                done := false;
                err := FSOpen(fileName, fileVRef, refNum);
                if err <> noErr then begin
                        TellUser(StringOf('Some error has occured while trying to open file ', fileName, '.  (Macintosh err number ', err : 1, '.)'));
                        EXIT(doSave);
                    end;
                chars := GetText;
                count := GetHandleSize(Handle(chars));
                HLock(handle(chars));
                err := FSWrite(refNum, count, Ptr(chars^));
                HUnLock(handle(chars));
                if err <> noErr then begin
                        TellUser(StringOf('Some error has occured while trying to write to file ', fileName, '.  (Macintosh err number ', err : 1, '.)'));
                        err := FSClose(refNum);
                        EXIT(doSave);
                    end;
                err := FSClose(refNum);
                done := true;
                declareClean;
            end;
    end;

procedure xFileTextWindow.doSaveAs (var done: boolean);
    var
        count: longint;
        refNum: integer;
        theSFReply: SFReply;
        err: OSErr;
        pt: point;
        name: str255;
        chars: CharsHandle;
    begin
        done := false;
        if trimmed then
            TellUser('Note that, because of the large amount of text in this window, data from the beginning has been lost.');
        pt.h := 50;
        pt.v := 80;
        name := GetTitle;
        SFPutFile(pt, 'Save as: ', name, nil, theSFReply);
        if not theSFReply.good then
            EXIT(doSaveAs);
        err := Create(theSFReply.fName, theSFReply.vRefNum, 'ttxt', 'TEXT');
        if err = dupFNErr then begin
                err := FSDelete(theSFReply.fName, theSFReply.vRefNum);
                if err <> noErr then begin
                        TellUser(StringOf('Some error has occured while trying to delete old file.  (Macintosh err number ', err : 1, '.)'));
                        EXIT(doSaveAs);
                    end;
                err := Create(theSFReply.fName, theSFReply.vRefNum, 'ttxt', 'TEXT');
            end;
        if err <> noErr then begin
                TellUser(StringOf('Some error has occured while trying to create file ', fileName, '.  (Macintosh err number ', err : 1, '.)'));
                EXIT(doSaveAs);
            end;
        err := FSOpen(theSFReply.fName, theSFReply.vRefNum, refNum);
        if err <> noErr then begin
                TellUser(StringOf('Some error has occured while trying to open file ', fileName, '.  (Macintosh err number ', err : 1, '.)'));
                EXIT(doSaveAs);
            end;
        chars := GetText;
        count := GetHandleSize(Handle(chars));
        HLock(handle(chars));
        err := FSWrite(refNum, count, Ptr(chars^));
        HUnLock(handle(chars));
        if err <> noErr then begin
                TellUser(StringOf('Some error has occured while trying to write to file ', fileName, '.  (Macintosh err number ', err : 1, '.)'));
                err := FSClose(refNum);
                EXIT(doSaveAs);
            end;
        err := FSClose(refNum);
        done := true;
        fileName := theSFReply.fName;
        fileVRef := theSFReply.vRefNum;
        fromFile := true;
        declareClean;
    end;

procedure xFileTextWindow.doclose;
    var
        runner: xFileTextWindow;
        ans: response;
        done: boolean;
    begin
        if dirty then begin
                ans := YesNoCancel(StringOf('Do you want to save ', GetTitle, ' before closing its window?'));
                if ans = answerCancel then
                    EXIT(doClose);
                if ans = answerYes then begin
                        doSave(done);
                        if not done then
                            EXIT(doClose);
                    end;
            end;
        if firstWin = self then
            firstWin := firstWin.nextTextWin
        else begin
                runner := firstWin;
                while (runner <> nil) & (runner.nextTextWin <> self) do
                    runner := runner.nextTextWin;
                if runner <> nil then
                    runner.nextTextWin := runner.nextTextWin.nextTextWin;
            end;
        inherited doclose;
    end;

procedure doNewCommand;
    var
        win: xFileTextWindow;
    begin
        new(win);
        newCt := newCt + 1;
        win.open(StringOf('Untitled ', newCt : 1));
    end;

procedure doOpenCommand;
    var
        err: OSErr;
        count: longint;
        fileRef: integer;
        theSFReply: SFReply;
        win: xFileTextWindow;
        chars: CharsHandle;
        tooBig: boolean;
        theTypeList: SFTypeList;
        pt: point;
        ans: response;
    begin
        pt.h := 50;
        pt.v := 80;
        theTypeList[0] := 'TEXT';
        SFGetFile(pt, 'File to open:', nil, 1, theTypeList, nil, theSFReply);
        if not theSFReply.good then
            Exit(DoOpenCommand);
        err := FSOpen(theSFReply.fName, theSFReply.vRefNum, fileRef);
        if err <> noErr then begin
                TellUser(StringOf('Some error has occured while trying to open file.   (Macintosh error ', err : 1, ')'));
                Exit(DoOpenCommand);
            end;
        err := GetEOF(fileRef, count);
        if err <> noErr then begin
                TellUser(StringOf('Some error has occured while trying to access file.   (Macintosh error ', err : 1, ')'));
                Exit(DoOpenCommand);
            end;
        tooBig := false;
        if count > 16000 then begin
                count := 16000;
                tooBig := true;
            end;
        chars := CharsHandle(NewHandle(count));
        if memError <> noErr then begin
                TellUser('There is not enough memory to load that file; try closing some other windows.');
                Exit(DoOpenCommand);
            end;
        if toobig then begin
                ans := YesNo('The file is too big for this program.  Do you want to read the first 16000 characters?');
                if ans = answerNo then begin
                        DisposHandle(Handle(chars));
                        err := FSClose(fileRef);
                        EXIT(doOpenCommand);
                    end;
            end;
        HLock(Handle(chars));
        err := FSRead(fileRef, count, Ptr(chars^));
        HUnlock(Handle(chars));
        if err <> noErr then begin
                err := FSClose(fileRef);
                DisposHandle(Handle(chars));
                TellUser(StringOf('An error has occured while trying to read the file.  (Macintosh error ', err : 1, ')'));
                Exit(DoOpenCommand);
            end;
        err := FSClose(fileRef);
        new(win);
        if toobig then begin
                newCt := newCt + 1;
                win.open(StringOf('Untitled ', newCt : 1));
            end
        else
            win.open(theSFReply.fName);
        win.InstallText(chars);
        if not tooBig then begin
                win.fromFile := true;
                win.fileName := theSFReply.fName;
                win.fileVRef := theSFReply.vRefNum;
            end;
    end;

procedure doSaveCommand;
    var
        win: WindowPtr;
        xWin: xWindow;
        dummy: boolean;
    begin
        win := frontWindow;
        if (win <> nil) & (WindowPeek(win)^.refCon <> 0) then begin
                xwin := xWindow(WindowPeek(win)^.refCon);
                if member(xWin, xFileTextWindow) then
                    xFileTextWindow(xWin).doSave(dummy);
            end;
    end;

procedure doSaveAsCommand;
    var
        win: WindowPtr;
        xWin: xWindow;
        dummy: boolean;
    begin
        win := frontWindow;
        if (win <> nil) & (WindowPeek(win)^.refCon <> 0) then begin
                xwin := xWindow(WindowPeek(win)^.refCon);
                if member(xWin, xFileTextWindow) then
                    xFileTextWindow(xWin).doSaveAs(dummy);
            end;
    end;

procedure doCloseCommand;
    var
        win: WindowPtr;
        xWin: xWindow;
    begin
        win := FrontWindow;
        if (win <> nil) & (WindowPeek(win)^.refCon <> 0) then begin
                xWin := xWindow(windowPeek(win)^.refCon);
                xWin.doClose;
            end;
    end;

procedure UpdateFileMenu (fileMenu: menuHandle);
    var
        win: WindowPtr;
        xWin: xWindow;
        i: integer;
    begin
        win := FrontWindow;
        for i := 3 to 5 do
            DisableItem(fileMenu, i);
        if (win <> nil) & (WindowPeek(win)^.refCon <> 0) then begin
                xWin := xWindow(WindowPeek(win)^.refCon);
                if member(xWin, xFileTextWindow) then
                    with xFileTextWindow(xWin) do begin
                            EnableItem(filemenu, 5);
                            EnableItem(filemenu, 4);
                            if changed then
                                EnableItem(fileMenu, 3);
                        end;
            end;
    end;

procedure CloseAllBeforeQuitting (var done: boolean);
    var
        runner, runner2: xFileTextWindow;
        ans: response;
    begin
        done := true;
        runner := FirstWin;
        while runner <> nil do begin
                with runner do
                    if dirty then begin
                            ans := YesNoCancel(StringOf('Do you want to save ', GetTitle, ' before quitting?'));
                            if ans = answerCancel then begin
                                    done := false;
                                    EXIT(CloseAllBeforeQuitting);
                                end;
                            if ans = answerYes then begin
                                    doSave(done);
                                    if not done then
                                        EXIT(CloseAllBeforeQuitting);
                                end;
                            declareClean; { to avoid asking user about closing in procedure doClose }
                            doClose
                        end;
                runner := runner.nextTextWin;
            end;
    end;

end.