home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 5 / amigaformatcd05.iso / mui / developer / oberon / examples / editlistclass.mod < prev    next >
Text File  |  1996-08-13  |  11KB  |  341 lines
  1. MODULE EditListClass;
  2.  
  3. IMPORT
  4.   e := Exec,
  5.   I := Intuition,
  6.   rc := RootClass,
  7.   m := Mui,
  8.   ms := MuiSimple,
  9.   sc := MUIGroup,
  10.   u := Utility,
  11.   y := SYSTEM;
  12.  
  13. TYPE
  14.  
  15. (*/// -------------------------- "RECORD ClassDesc" -------------------------- *)
  16.   Class = UNTRACED POINTER TO ClassDesc;
  17.   ClassDesc = RECORD( sc.ClassDesc );
  18.         list    : m.Object;
  19.         string  : m.Object;
  20.         group   : m.Object;
  21.         menu    : m.Object;
  22.         setHook : u.HookPtr;
  23.         getHook : u.HookPtr;
  24.           END;
  25.  
  26. (*\\\*)
  27.  
  28.   pSetString  = STRUCT( msg : I.Msg ) END;
  29.   pGetString  = STRUCT( msg : I.Msg ) END;
  30.  
  31.   menu = ARRAY 5 OF e.STRPTR;
  32.  
  33. CONST
  34.   tagBase = u.user + (74*65536);
  35.  
  36.   aNewText       *= tagBase+1;
  37.   aRemoveText    *= tagBase+2;
  38.   aUpText        *= tagBase+3;
  39.   aDownText      *= tagBase+4;
  40.  
  41.  
  42.   mNew           *= tagBase+5;
  43.   mRemove        *= tagBase+6;
  44.   mUp            *= tagBase+7;
  45.   mDown                *= tagBase+8;
  46.   mSetString           = tagBase+10;
  47.   mGetString           = tagBase+15;
  48.  
  49.   aSetStringHook       *= tagBase+11;
  50.   vSetStringHookString *= tagBase+12;
  51.   aGetStringHook       *= tagBase+13;
  52.   vGetStringHookString *= tagBase+14;
  53.  
  54.   aNewMenuText       *= tagBase+15;
  55.   aRemoveMenuText    *= tagBase+16;
  56.   aUpMenuText        *= tagBase+17;
  57.   aDownMenuText      *= tagBase+18;
  58.   aHelpMenuText      *= tagBase+19;
  59.  
  60. VAR
  61.   class -: I.IClassPtr;
  62.  
  63. (*/// ---------------------- "PROCEDURE ClassDesc.Up()" ---------------------- *)
  64.  
  65.   PROCEDURE ( VAR c : ClassDesc ) Up( VAR msg : I.Msg  ):e.APTR;
  66.     VAR act : LONGINT;
  67.     BEGIN
  68.       ms.Get( c.list, m.aListActive, act );
  69.       IF act # m.vListActiveOff THEN
  70.     m.DoMethod( c.list, m.mListMove, m.vListMoveActive, m.vListMovePrevious );
  71.     ms.Set( c.list, m.aListActive, m.vListActiveUp );
  72.       END;
  73.       RETURN NIL;
  74.     END Up;
  75.  
  76. (*\\\*)
  77. (*/// --------------------- "PROCEDURE ClassDesc.Down()" --------------------- *)
  78.  
  79.   PROCEDURE ( VAR c : ClassDesc ) Down( VAR msg : I.Msg  ):e.APTR;
  80.     VAR act : LONGINT;
  81.     BEGIN                 
  82.       ms.Get( c.list, m.aListActive, act );
  83.       IF act # m.vListActiveOff THEN
  84.     m.DoMethod( c.list, m.mListMove, m.vListMoveActive, m.vListMoveNext );
  85.     ms.Set( c.list, m.aListActive, m.vListActiveDown );
  86.       END;
  87.       RETURN NIL;
  88.     END Down;
  89.  
  90. (*\\\*)
  91. (*/// ------------------ "PROCEDURE ClassDesc.SetString()" ------------------- *)
  92.  
  93.   PROCEDURE ( VAR c : ClassDesc ) SetString( VAR msg : pSetString ):e.APTR;
  94.     VAR str : e.STRPTR;
  95.     pos, cnt  : LONGINT;
  96.     ret : e.APTR;
  97.     BEGIN
  98.       ret := NIL;
  99.       m.DoMethod( c.list, m.mKillNotify, m.aListActive );
  100.       IF y.VAL( LONGINT, c.setHook ) = vSetStringHookString THEN
  101.     ms.Get( c.string, m.aStringContents, str );
  102.     IF (str # NIL) & (str[0]# 0X) THEN
  103.       ms.Set( c.list, m.aListQuiet, e.true );
  104.       ms.Get( c.list, m.aListActive, pos );
  105.       ms.Get( c.list, m.aListEntries, cnt );
  106.       IF pos # m.vListActiveOff THEN
  107.         m.DoMethod( c.list, m.mListRemove, m.vListRemoveActive );
  108.         IF (pos = 0) OR (pos = m.vListActiveOff) THEN
  109.           m.DoMethod( c.list, m.mListInsertSingle, str, m.vListInsertTop );
  110.         ELSIF (cnt-pos) = 1 THEN;
  111.           m.DoMethod( c.list, m.mListInsertSingle, str, m.vListInsertBottom );
  112.         ELSE
  113.           m.DoMethod( c.list, m.mListInsertSingle, str, pos );
  114.         END;
  115.         ms.Set( c.list, m.aListActive, pos );
  116.       END;
  117.       ms.Set( c.list, m.aListQuiet, e.false );
  118.     END;
  119.       ELSIF c.setHook # NIL THEN
  120.     ret :=  u.CallHookPkt( c.setHook, c.list, c.string );
  121.       END;
  122.       m.DoMethod( c.list, m.mNotify, m.aListActive, m.vEveryTime, c.group, 1, mGetString );
  123.       RETURN ret;
  124.     END SetString;
  125.  
  126. (*\\\*)
  127. (*/// ------------------ "PROCEDURE ClassDesc.GetString()" ------------------- *)
  128.  
  129.   PROCEDURE ( VAR c : ClassDesc ) GetString( VAR msg : pGetString ):e.APTR;
  130.     VAR str : e.STRPTR;
  131.     BEGIN
  132.       IF y.VAL( LONGINT, c.getHook ) = vGetStringHookString THEN
  133.     m.DoMethod( c.list, m.mListGetEntry, m.vListGetEntryActive, y.ADR( str ) );
  134.     IF (str # NIL) THEN
  135.       ms.Set( c.string, m.aStringContents, str );
  136.     END;
  137.       ELSIF c.getHook # NIL THEN
  138.     RETURN u.CallHookPkt( c.setHook, c.list, c.string );
  139.       END;
  140.       RETURN NIL;
  141.     END GetString;
  142.  
  143. (*\\\*)
  144. (*/// ------------------- "PROCEDURE ClassDesc.Dispose()" -------------------- *)
  145.  
  146.   PROCEDURE ( VAR c : ClassDesc ) Dispose*( VAR msg : I.Msg ):e.APTR;
  147.     BEGIN
  148.       IF c.menu # NIL THEN m.DisposeObject( c.menu ) END;
  149.       RETURN c.Dispose^( msg );
  150.     END Dispose;
  151.  
  152. (*\\\*)
  153. (*/// --------------------- "PROCEDURE ClassDesc.New()" ---------------------- *)
  154.  
  155.   PROCEDURE ( VAR c : ClassDesc ) New*( VAR msg : I.OpSet ):e.APTR;
  156.     VAR new, remove, up, down : m.Object;
  157.     str : e.LSTRPTR;
  158.     nr, ud : m.Object;
  159.     lgroup : m.Object;
  160.     tags : u.Tags2;
  161.     butGroup : m.Object;
  162.     list : m.Object;
  163.     menu : m.Object;
  164.     newm, removem, upm, downm, helpm : m.Object;
  165.  
  166.     PROCEDURE GetTagString( tl : u.TagListPtr; attr : u.TagID): e.LSTRPTR;
  167.       BEGIN
  168.     RETURN u.GetTagDataP( attr, NIL, tl );
  169.       END GetTagString;
  170.  
  171.     BEGIN
  172.       new := NIL; remove := NIL; up := NIL; down := NIL; nr := NIL; ud := NIL;
  173.       c.setHook := y.VAL( u.HookPtr, u.GetTagData( aSetStringHook, vSetStringHookString, msg.attrList ));
  174.       c.getHook := y.VAL( u.HookPtr, u.GetTagData( aGetStringHook, vGetStringHookString, msg.attrList ));
  175.       list := ms.ListObject( m.aListConstructHook, u.GetTagData( m.aListConstructHook, m.vListConstructHookString, msg.attrList ),
  176.                  m.aListDestructHook, u.GetTagData( m.aListDestructHook, m.vListDestructHookString, msg.attrList ),
  177.                  u.end );
  178.  
  179.       c.list := ms.ListviewObject( m.aListviewList, list,
  180.                    m.aFrame, m.vFrameInputList,
  181.                    u.end );
  182.  
  183.       helpm   := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aHelpMenuText), NIL,0, aHelpMenuText );
  184.  
  185.       str := GetTagString( msg.attrList, aNewText);
  186.       IF str # NIL THEN
  187.     new := ms.SimpleButton( str^ );
  188.       END;
  189.  
  190.       str := GetTagString( msg.attrList, aRemoveText);
  191.       IF str # NIL THEN
  192.     remove := ms.SimpleButton( str^ );
  193.       END;
  194.  
  195.       str := GetTagString( msg.attrList, aUpText);
  196.       IF str # NIL THEN
  197.     up := ms.SimpleButton( str^ );
  198.       END;
  199.  
  200.       str := GetTagString( msg.attrList, aDownText);
  201.       IF str # NIL THEN
  202.     down := ms.SimpleButton( str^ );
  203.       END;
  204.  
  205.       IF new # NIL THEN
  206.     nr := ms.HGroup( m.aGroupSpacing, 1,
  207.              m.aGroupSameWidth, e.true,
  208.              m.aGroupChild, new,
  209.               m.aGroupChild, remove,
  210.              u.end );
  211.     newm    := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aNewMenuText), NIL,0,aNewMenuText);
  212.     removem := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aRemoveMenuText), NIL,0,aRemoveMenuText);
  213.  
  214.  
  215.       END;
  216.       IF up # NIL THEN
  217.     ud := ms.HGroup( m.aGroupSpacing, 1,
  218.              m.aGroupSameWidth, e.true,
  219.              m.aGroupChild, up,
  220.              m.aGroupChild, down,
  221.              u.end );
  222.     upm     := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aUpMenuText), NIL,0,aUpMenuText);
  223.     downm   := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aDownMenuText), NIL,0,aUpMenuText);
  224.       END;
  225.       IF (nr # NIL) & (ud # NIL) THEN
  226.     butGroup := ms.VGroup( m.aGroupSpacing, 1,
  227.                    m.aGroupSameWidth, e.true,
  228.                    m.aGroupChild, nr,
  229.                    m.aGroupChild, ud,
  230.                    u.done );
  231.  
  232.     menu := ms.MenuObject( m.aFamilyChild, newm,
  233.                    m.aFamilyChild, removem,
  234.                    m.aFamilyChild, upm,
  235.                    m.aFamilyChild, downm,
  236.                    m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
  237.                    m.aFamilyChild, helpm,
  238.                    m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
  239.                    u.done  );
  240.       ELSIF (nr # NIL ) THEN
  241.     butGroup := nr;
  242.     menu := ms.MenuObject( m.aFamilyChild, newm,
  243.                    m.aFamilyChild, removem,
  244.                    m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
  245.                    m.aFamilyChild, helpm,
  246.                    m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
  247.                    u.done  );
  248.       ELSIF (ud # NIL ) THEN;
  249.     butGroup := ud;
  250.     menu := ms.MenuObject( m.aFamilyChild, upm,
  251.                    m.aFamilyChild, downm,
  252.                    m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
  253.                    m.aFamilyChild, helpm,
  254.                    m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
  255.                    u.done  );
  256.       ELSE;
  257.     butGroup := NIL;
  258.       END;
  259.       c.string := ms.StringObject( m.aStringAttachedList, c.list,
  260.                    m.aFrame, m.vFrameString,
  261.                    u.done );
  262.       IF butGroup # NIL THEN
  263.     lgroup := ms.VGroup( m.aGroupSpacing,1,
  264.                  m.aGroupChild, c.list,
  265.                  m.aGroupChild, butGroup,
  266.                  m.aGroupChild, c.string,
  267.                  m.aContextMenu,c.menu,
  268.                  u.end );
  269.       ELSE
  270.     lgroup := ms.VGroup( m.aGroupSpacing,1,
  271.                  m.aGroupChild, c.list,
  272.                  m.aGroupChild, c.string,
  273.                  m.aContextMenu, c.menu,
  274.                  u.end );
  275.       END;
  276.  
  277.       c.menu := ms.MenustripObject( m.aFamilyChild, menu,
  278.                     u.done );
  279.  
  280.       ms.Set( c.list, m.aContextMenu, c.menu );
  281.       tags[0].tag := m.aGroupChild;
  282.       tags[0].data := lgroup;
  283.       tags[1].tag := u.more;
  284.       tags[1].data := msg.attrList;
  285.       msg.attrList := y.ADR(tags);  
  286.       c.group := c.New^( msg );
  287.       IF c.group # NIL THEN
  288.     c.CopyClass( c.group );
  289.     ms.Set( c.group, m.aShortHelp, u.GetTagData( m.aShortHelp, NIL, msg.attrList ) );
  290.  
  291.     m.DoMethod( c.string, m.mNotify, m.aStringAcknowledge, m.vEveryTime, c.group, 1, mSetString );
  292.     m.DoMethod( c.list, m.mNotify, m.aListActive, m.vEveryTime, c.group, 1, mGetString );
  293.     IF up # NIL THEN
  294.       m.DoMethod( up, m.mNotify, m.aPressed, e.false, c.group, 1, mUp );
  295.       m.DoMethod( upm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.group, 1, mUp );
  296.     END;
  297.     IF down # NIL THEN
  298.       m.DoMethod( down, m.mNotify, m.aPressed, e.false, c.group, 1, mDown );
  299.       m.DoMethod( downm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.group, 1, mDown );
  300.     END;
  301.     IF new # NIL THEN
  302.       m.DoMethod( new, m.mNotify, m.aPressed, e.false, c.list, 3, m.mListInsertSingle, y.ADR( "leer" ), m.vListInsertBottom );
  303.       m.DoMethod( newm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.list, 3, m.mListInsertSingle, y.ADR( "leer" ), m.vListInsertBottom  );
  304.     END;
  305.     IF remove # NIL THEN
  306.       m.DoMethod( remove, m.mNotify, m.aPressed, e.false, c.list, 2, m.mListRemove, m.vListRemoveActive );
  307.       m.DoMethod( removem, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.list, 2, m.mListRemove, m.vListRemoveActive );
  308.     END;
  309.       END;
  310.       RETURN c.group;
  311.     END New;
  312.  
  313. (*\\\*)
  314. (*/// ------------------------ "PROCEDURE Dispatch()" ------------------------ *)
  315.  
  316.   PROCEDURE Dispatch * ( cl : I.IClassPtr; obj : I.ObjectPtr; msg : I.MsgPtr ):e.APTR;
  317.     VAR c : Class;
  318.     BEGIN
  319.       IF msg.methodID # I.new THEN
  320.     c := rc.BoopsiToObj( cl, obj )(Class);
  321.       END;               
  322.       CASE msg.methodID OF
  323.     | mSetString : RETURN c.SetString( msg^(pSetString) );
  324.     | mGetString : RETURN c.GetString( msg^(pGetString) );
  325.     | mUp        : RETURN c.Up( msg^ );
  326.     | mDown      : RETURN c.Down( msg^ );
  327.       ELSE
  328.     RETURN sc.Dispatch( cl, obj, msg );
  329.       END;         
  330.     END Dispatch;     
  331.  
  332. (*\\\*)
  333.  
  334. BEGIN
  335.   class := rc.InitPrivFromClass( sc.class, Dispatch, SIZE( ClassDesc ), y.TYPEDESC( ClassDesc ) );
  336.   IF class = NIL THEN HALT(205) END;
  337. CLOSE
  338.   IF class # NIL THEN IF I.FreeClass( class ) THEN END END;
  339. END EditListClass.
  340.  
  341.