Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyOOMenus.p

Text File | 1997-01-17 | 6.4 KB | 250 lines | [TEXT/CWIE]

unit MyOOMenus;

interface

    uses
        Types, MyFMenus;

    procedure StartupOOMenus;
    procedure DisplayMenuBar;
    procedure DoDefaultMenu (themenu, theitem: integer);
    function SetOOMenuBar: boolean;
    procedure EnableHandleQuitBoth (creator: OSType; both_index, justus_index: integer);

implementation

    uses
        Traps, Balloons, Devices, TextUtils, Processes, Files, Menus, AppleEvents, Quickdraw, Events, Windows,
        MyTypes, MySystemGlobals, MyMenus, MyStrings, MyVersionResource, MyEvents,
        BaseGlobals, MyFMenus, MyOOMainLoop, AERegistry, MyAEUtils, AEObjects, MyStartup, MyProcesses;

{$ifc do_debug}
    var
        startup_check: integer;
{$endc}

    var
        creatorType: OSType;
        both, justus: integer;
        quit_both_menu, quit_both: Boolean;

    procedure SetQuit (themenu, theitem: integer);
        var
            process: ProcessSerialNumber;
            s: Str255;
            fs: FSSpec;
    begin
        quit_both_menu := last_event_had_option & FindProcess(creatorType, application, process, fs);
        if quit_both_menu then begin
            GetIndString(s, global_strh_id, both);
        end else begin
            GetIndString(s, global_strh_id, justus);
        end;
        SetMenuItemText(GetMenuHandle(themenu), theitem, s);
    end;

    function SetOOMenuBar: boolean;
    begin
        AssertDidStartup( startup_check );
        SetOOMenuBar := FrontObject.SetMenuBar;
    end;

    function HandleEditMenu (var event, reply: AppleEvent; refcon: longint): OSErr;
    begin
{$unused(event, reply)}
        FrontObject.DoEditMenu(refcon);
        HandleEditMenu := noErr;
    end;

    procedure DoDefaultMenu (themenu, theitem: integer);
        var
            save: GrafPtr;
            DAName: Str255;
            oe: OSErr;
    begin
        AssertDidStartup( startup_check );
        if themenu = M_Apple then begin
            GetPort(save);
            GetMenuItemText(GetMenuHandle(M_Apple), theitem, DAName);
            oe := OpenDeskAcc(DAName);
            SetPort(save);
        end else if themenu = M_Edit then begin
            if has_AppleEvents then begin
                case theitem of
                    EMundo:
                        SendSelfSimpleEvent(kAECoreSuite, kAEUndo);
                    EMcut:
                        SendSelfSimpleEvent(kAECoreSuite, kAECut);
                    EMcopy:
                        SendSelfSimpleEvent(kAECoreSuite, kAECopy);
                    EMpaste:
                        SendSelfSimpleEvent(kAECoreSuite, kAEPaste);
                    EMclear:
                        SendSelfSimpleEvent(kAECoreSuite, kAEDelete);
                    EMselectall:
                        SendSelfSimpleEvent(kAECoreSuite, kAESelect); { hmmm }
                    otherwise begin
                        FrontObject.DoEditMenu(theitem);
                    end;
                end;
            end else begin
                FrontObject.DoEditMenu(theitem);
            end;
        end;
    end;

    procedure DoClose;
    begin
        DoCloseAll(last_event_had_option);
    end;

    procedure SetCloseMenu (themenu, theitem: integer);
        var
            fw: WindowPtr;
            er: EventRecord;
            dummy: boolean;
    begin
        fw := FrontWindow;
        if fw = nil then begin
            SetIDItemEnable(themenu, theitem, (fw <> nil) & WindowPeek(fw)^.goAwayFlag & (GetWType(fw) <> WT_NotMine));
        end else begin
            SetIDItemEnable(themenu, theitem, WindowPeek(fw)^.goAwayFlag);
        end;
        dummy := OSEventAvail(everyEvent, er);
        last_event_had_option := EventHasOptionKey( er );
        if ord(GS_OptionClose) > 0 then begin
            if last_event_had_option then begin
                SetIDItem(themenu, theitem, GetGlobalStr( GS_OptionClose ));
            end else begin
                SetIDItem(themenu, theitem, GetGlobalStr( GS_NormalClose ));
            end;
        end;
    end;

    procedure SetEditMenus (menu, item: integer);
    begin
{$unused(menu)}
        FrontObject.SetEditMenuItem(item);
    end;

    procedure SendSelfQuitEvent;
        var
            event, reply: AppleEvent;
            err, junk: OSErr;
            target: AEDesc;
    begin
        AECreate(reply);
        err := CreateSelfTarget(target);
        err := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, target, kAutoGenerateReturnID, kAnyTransactionID, event);
        AEDestroy(target);
        junk := PutBooleanToAERecord(event, keyOdocOption, quit_both_menu);
        if err = noErr then begin
            junk := AESend(event, reply, kAENoReply + kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeout, nil, nil);
        end;
        AEDestroy(event);
        AEDestroy(reply);
    end;

    procedure DoQuit;
    begin
        quit_both := quit_both_menu;
        if has_AppleEvents then begin
            SendSelfQuitEvent;
        end else begin
            quitNow := true;
        end;
    end;

    procedure DisplayMenuBar;
        var
            dummyb: boolean;
    begin
        dummyb := SetOOMenuBar;
        DrawMenuBar;
    end;

    function InitOOMenus(var msg: integer): OSStatus;
        var
            junk: OSErr;
            HandleEditMenuProc : UniversalProcPtr;
    begin
{$unused(msg)}
        DidStartup( startup_check );
        quitNow := false;
        quit_both_menu := false;
        quit_both := false;

        MH_Apple := GetFMenu(M_Apple);
        AppendResMenu(MH_Apple, 'DRVR');
        InsertMenu(MH_Apple, 0);

        MH_File := GetFMenu(M_File);
        InsertMenu(MH_File, 0);
        MH_Edit := GetFMenu(M_Edit);
        InsertMenu(MH_Edit, 0);

{$IFC 0}
        M_HM_Help_I := -1;
        hstr := GetGlobalString(help_menu_text);
        if has_HelpManager and (hstr <> '') then begin
            GetVersion(vers);
            SPrintS3(hstr, hstr, vers.name, '', '');
            oe := HMGetHelpMenuHandle(mh);
            if (oe = noErr) and (mh <> nil) then begin
                AppendMenu(mh, hstr);
                M_HM_Help_I := CountMItems(mh);
                AddFCommand(kHMHelpMenuID, M_HM_Help_I, Chelp);
            end;
        end;
{$ENDC}

        if has_AppleEvents then begin
            HandleEditMenuProc := NewAEEventHandlerProc(HandleEditMenu);
            junk := AEInstallEventHandler(kAECoreSuite, kAEUndo, HandleEditMenuProc, EMundo, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAECut, HandleEditMenuProc, EMcut, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAECopy, HandleEditMenuProc, EMcopy, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAEPaste, HandleEditMenuProc, EMpaste, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAEDelete, HandleEditMenuProc, EMclear, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAESelect, HandleEditMenuProc, EMselectall, false);
        end;

        SetFBoth(Cclose, DoClose, SetCloseMenu);
        SetFCommand(Cquit, DoQuit);
        SetFSetMenu(Cundo, SetEditMenus);
        SetFSetMenu(Ccut, SetEditMenus);
        SetFSetMenu(Ccopy, SetEditMenus);
        SetFSetMenu(Cpaste, SetEditMenus);
        SetFSetMenu(Cclear, SetEditMenus);
        SetFSetMenu(Cselectall, SetEditMenus);
        SetFMenus;
        InitOOMenus := noErr;
    end;

    procedure EnableHandleQuitBoth (creator: OSType; both_index, justus_index: integer);
    begin
        creatorType := creator;
        both := both_index;
        justus := justus_index;
        SetFSetMenu(Cquit, SetQuit);
    end;

    procedure FinishOOMenus;
    begin
        if quit_both then begin
            QuitApplication(creatorType, application);
        end;
    end;

    procedure StartupOOMenus;
    begin
        StartupFMenus;
        StartupMainLoop;
        SetStartup(InitOOMenus, nil, 0, FinishOOMenus);
    end;

end.
    var
        editEnabled: boolean;

        editEnabled := true;