home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-02-19 | 8.3 KB | 385 lines | [TEXT/MPS ] |
- Unit MenuStuffCommon;
- {
- Definitions and utilties common to the MPW menu-manipulation tools.
-
- First working version by LDO 1989 January 4.
- Modified 1989 January 6 to add general menu-traversal routines,
- and modify search routines to use them.
- Modified 1989 January 9 to add quoting routine.
- Modified 1989 January 23 to simplify quoting routine.
- Modified 1989 April 17 to add new special character for MPW 3.0.
- Modified 1990 February 19 to ignore case and diacritical marks in
- string comparisons, to be consistent with AddMenu and DeleteMenu.
- }
-
- Interface
-
- Uses
- MemTypes,
- QuickDraw,
- OSIntf,
- ToolIntf;
-
- Type
- MenuListHeader =
- Record
- LastMenu : Integer;
- LastRight : Integer;
- mbProcID : Integer
- End {Record};
- MenuListPtr = ^MenuListHeader;
- MenuListHandle = ^MenuListPtr;
- MenuRec =
- Record
- MenuOH : MenuHandle;
- MenuLeft : Integer
- End {Record};
- HMenuRec =
- Record
- MenuHOH : MenuHandle;
- Reserved : Integer
- End {Record};
-
- {
- Closures
- }
-
- Function CurrentA6 : LongInt;
- { returns the current value of the stack frame register. }
-
- Inline
- $2E8E; { move.l a6, (sp) }
-
- {
- Menu-handling utilities
- }
-
- Procedure TraverseMenus
- (
- Handler : ProcPtr;
- HandlerArg : univ LongInt
- );
- { traverses the top-level menu list, invoking the
- handler procedure with each menu found. The handler
- should be declared like this:
-
- Procedure Handler
- (
- TheMenu : MenuHandle;
- var KeepGoing : Boolean;
- HandlerArg : univ LongInt
- );
-
- where TheMenu is the next menu in the list, and KeepGoing
- is initially True, but may be set to False by the
- handler to stop the traversal of the menu list.
- HandlerArg may be interpreted in any way the handler
- wishes. }
-
- Procedure TraverseSubMenus
- (
- Handler : ProcPtr;
- HandlerArg : univ LongInt
- );
- { traverses the hierarchical/pop-up section of the
- menu list, invoking the handler procedure with
- each menu found. See the description of TraverseMenus
- to see how to declare the Handler. }
-
- Function FindMenu
- (
- MenuName : Str255
- ) : MenuHandle;
- { returns a handle to the menu in the current menu bar
- with the specified name, or Nil if not found. }
-
- Function FindSubMenu
- (
- MenuName : Str255
- ) : MenuHandle;
- { returns a handle to the menu in the hierarchical portion of
- the current menu list with the specified name, or Nil if not found. }
-
- Function FindItem
- (
- InMenu : MenuHandle;
- WithName : Str255
- ) : Integer;
- { returns the number of the item in the given menu with the
- given name, or 0 if not found. }
-
- {
- Argument quoting
- }
-
- Function Quote
- (
- Arg : Str255
- ) : Str255;
- { returns Arg suitably quoted as necessary to avoid interpretation
- of any of the Shell's special characters. }
-
- Implementation
-
- Type
- MenuHandlePtr = ^MenuHandle;
- IntPtr = ^Integer;
-
- {
- Menu-handling utilities
- }
-
- Function GetMenuList : MenuListHandle;
- { returns the value of MenuList global. }
-
- Inline
- $2EB8, $0A1C; {move.l $0A1C, (sp)}
-
- Procedure CallHandler
- (
- TheMenu : MenuHandle;
- var KeepGoing : Boolean;
- HandlerArg : univ LongInt;
- Handler : ProcPtr
- );
- { invokes the handler with the specified arguments. }
-
- Inline
- $205F, {move.l (sp)+, a0}
- $4E90; {jsr (a0)}
-
- Procedure TraverseMenus
- (
- Handler : ProcPtr;
- HandlerArg : univ LongInt
- );
- { traverses the top-level menu list, invoking the
- handler procedure with each menu found. }
-
- Var
- TheMenuList : MenuListHandle;
- ThisOffset : Integer;
- ThisMenu : MenuHandle;
- KeepGoing : Boolean;
-
- Begin
- TheMenuList := GetMenuList;
- ThisOffset := SizeOf(MenuListHeader);
- KeepGoing := True;
- Repeat {until left}
- If ThisOffset > TheMenuList^^.LastMenu then
- Leave;
- ThisMenu := MenuHandlePtr(Ord4(TheMenuList^) + ThisOffset)^;
- CallHandler(ThisMenu, KeepGoing, HandlerArg, Handler);
- If not KeepGoing then
- Leave;
- ThisOffset := ThisOffset + SizeOf(MenuRec)
- Until
- False
- End {TraverseMenus};
-
- Procedure TraverseSubMenus
- (
- Handler : ProcPtr;
- HandlerArg : univ LongInt
- );
- { traverses the hierarchical/pop-up section of the
- menu list, invoking the handler procedure with
- each menu found. }
-
- Var
- TheMenuList : MenuListHandle;
- LastHMenu, ThisOffset : Integer;
- ThisMenu : MenuHandle;
- KeepGoing : Boolean;
-
- Begin
- TheMenuList := GetMenuList;
- ThisOffset := TheMenuList^^.LastMenu + SizeOf(MenuRec);
- LastHMenu := ThisOffset + IntPtr(LongInt(TheMenuList^) + ThisOffset)^;
- ThisOffset := ThisOffset + 6; { point to first hierarchical menu }
- KeepGoing := True;
- Repeat {until left}
- If ThisOffset > LastHMenu then
- Leave;
- ThisMenu := MenuHandlePtr(Ord4(TheMenuList^) + ThisOffset)^;
- CallHandler(ThisMenu, KeepGoing, HandlerArg, Handler);
- If not KeepGoing then
- Leave;
- ThisOffset := ThisOffset + SizeOf(HMenuRec)
- Until
- False
- End {TraverseSubMenus};
-
- Function FindMenu
- (
- MenuName : Str255
- ) : MenuHandle;
- { returns a handle to the menu in the current menu bar
- with the specified name, or Nil if not found. }
-
- Procedure FindHandler
- (
- TheMenu : MenuHandle;
- var KeepGoing : Boolean
- );
- { checks menu name against that desired. }
-
- Begin
- If EqualString(TheMenu^^.MenuData, MenuName, False, False) then
- Begin
- FindMenu := TheMenu;
- KeepGoing := False
- End {If}
- End {FindHandler};
-
- Begin {FindMenu}
- FindMenu := Nil; { initial assumption }
- TraverseMenus(@FindHandler, CurrentA6)
- End {FindMenu};
-
- Function FindSubMenu
- (
- MenuName : Str255
- ) : MenuHandle;
- { returns a handle to the menu in the hierarchical portion of
- the current menu list with the specified name, or Nil if not found. }
-
- Procedure FindHandler
- (
- TheMenu : MenuHandle;
- var KeepGoing : Boolean
- );
- { checks menu name against that desired. }
-
- Begin
- If EqualString(TheMenu^^.MenuData, MenuName, False, False) then
- Begin
- FindSubMenu := TheMenu;
- KeepGoing := False
- End {If}
- End {FindHandler};
-
- Begin {FindSubMenu}
- FindSubMenu := Nil; { initial assumption }
- TraverseSubMenus(@FindHandler, CurrentA6)
- End {FindSubMenu};
-
- Function FindItem
- (
- InMenu : MenuHandle;
- WithName : Str255
- ) : Integer;
- { returns the number of the item in the given menu with the
- given name, or 0 if not found. }
-
- Var
- ThisItem, NrItems : Integer;
- ThisName : Str255;
-
- Begin
- NrItems := CountMItems(InMenu);
- ThisItem := 0;
- Repeat {until left}
- If ThisItem = NrItems then
- Begin
- FindItem := 0; { not found }
- Leave;
- End {If};
- ThisItem := ThisItem + 1;
- GetItem(InMenu, ThisItem, ThisName);
- If EqualString(ThisName, WithName, False, False) then
- Begin
- FindItem := ThisItem; { found }
- Leave
- End {If}
- Until
- False
- End {FindItem};
-
- {
- Argument quoting
- }
-
- Function AnyPresent
- (
- Chars, InString : Str255
- ) : Boolean;
- { returns True iff any of the characters in Chars are
- present in InString. }
-
- Var
- ThisPos : Integer;
-
- Begin
- ThisPos := Length(Chars);
- Repeat {until left}
- If ThisPos = 0 then
- Begin
- AnyPresent := False;
- Leave
- End {If};
- If Pos(Chars[ThisPos], InString) <> 0 then
- Begin
- AnyPresent := True;
- Leave
- End {If};
- ThisPos := ThisPos - 1
- Until
- False
- End {AnyPresent};
-
- Function Quote
- (
- Arg : Str255
- ) : Str255;
- { returns Arg suitably quoted as necessary to avoid interpretation
- of any of the Shell's special characters. }
-
- Const
- SingleQuote = '''';
- QuoteNext = '╢';
- SpecialChars = ';|&()╔#╢"/\{}`?┼[]*+╟╚<>│╖ ';
-
- Var
- QuotePos : Integer;
- Result : Str255;
-
- Function SimpleQuote
- (
- Arg : Str255
- ) : Str255;
- { quotes Arg if it contains any special characters. Assumes
- no single quotes are present. }
-
- Begin
- If AnyPresent(Concat(SpecialChars, Chr(9), Chr(13)), Arg) then
- SimpleQuote := Concat(SingleQuote, Arg, SingleQuote)
- else
- SimpleQuote := Arg
- End {SimpleQuote};
-
- Begin {Quote}
- Result := '';
- Repeat {until left}
- QuotePos := Pos(SingleQuote, Arg);
- If QuotePos = 0 then
- Begin
- Result := Concat(Result, SimpleQuote(Arg));
- Leave
- End {If};
- Result := Concat
- (
- Result,
- SimpleQuote(Copy(Arg, 1, QuotePos - 1)),
- QuoteNext,
- SingleQuote
- );
- Delete(Arg, 1, QuotePos)
- Until
- False;
- Quote := Result
- End {Quote};
-
- End {MenuStuffCommon}.
-