MODULE EditListClass;

IMPORT
  e := Exec,
  I := Intuition,
  rc := RootClass,
  m := Mui,
  ms := MuiSimple,
  sc := MUIGroup,
  u := Utility,
  y := SYSTEM;

TYPE

(*/// -------------------------- "RECORD ClassDesc" -------------------------- *)
  Class = UNTRACED POINTER TO ClassDesc;
  ClassDesc = RECORD( sc.ClassDesc );
		list    : m.Object;
		string  : m.Object;
		group   : m.Object;
		menu    : m.Object;
		setHook : u.HookPtr;
		getHook : u.HookPtr;
	      END;

(*\\\*)

  pSetString  = STRUCT( msg : I.Msg ) END;
  pGetString  = STRUCT( msg : I.Msg ) END;

  menu = ARRAY 5 OF e.STRPTR;

CONST
  tagBase = u.user + (74*65536);

  aNewText       *= tagBase+1;
  aRemoveText    *= tagBase+2;
  aUpText        *= tagBase+3;
  aDownText      *= tagBase+4;


  mNew           *= tagBase+5;
  mRemove        *= tagBase+6;
  mUp            *= tagBase+7;
  mDown                *= tagBase+8;
  mSetString           = tagBase+10;
  mGetString           = tagBase+15;

  aSetStringHook       *= tagBase+11;
  vSetStringHookString *= tagBase+12;
  aGetStringHook       *= tagBase+13;
  vGetStringHookString *= tagBase+14;

  aNewMenuText       *= tagBase+15;
  aRemoveMenuText    *= tagBase+16;
  aUpMenuText        *= tagBase+17;
  aDownMenuText      *= tagBase+18;
  aHelpMenuText      *= tagBase+19;

VAR
  class -: I.IClassPtr;

(*/// ---------------------- "PROCEDURE ClassDesc.Up()" ---------------------- *)

  PROCEDURE ( VAR c : ClassDesc ) Up( VAR msg : I.Msg  ):e.APTR;
    VAR act : LONGINT;
    BEGIN
      ms.Get( c.list, m.aListActive, act );
      IF act # m.vListActiveOff THEN
	m.DoMethod( c.list, m.mListMove, m.vListMoveActive, m.vListMovePrevious );
	ms.Set( c.list, m.aListActive, m.vListActiveUp );
      END;
      RETURN NIL;
    END Up;

(*\\\*)
(*/// --------------------- "PROCEDURE ClassDesc.Down()" --------------------- *)

  PROCEDURE ( VAR c : ClassDesc ) Down( VAR msg : I.Msg  ):e.APTR;
    VAR act : LONGINT;
    BEGIN                 
      ms.Get( c.list, m.aListActive, act );
      IF act # m.vListActiveOff THEN
	m.DoMethod( c.list, m.mListMove, m.vListMoveActive, m.vListMoveNext );
	ms.Set( c.list, m.aListActive, m.vListActiveDown );
      END;
      RETURN NIL;
    END Down;

(*\\\*)
(*/// ------------------ "PROCEDURE ClassDesc.SetString()" ------------------- *)

  PROCEDURE ( VAR c : ClassDesc ) SetString( VAR msg : pSetString ):e.APTR;
    VAR str : e.STRPTR;
	pos, cnt  : LONGINT;
	ret : e.APTR;
    BEGIN
      ret := NIL;
      m.DoMethod( c.list, m.mKillNotify, m.aListActive );
      IF y.VAL( LONGINT, c.setHook ) = vSetStringHookString THEN
	ms.Get( c.string, m.aStringContents, str );
	IF (str # NIL) & (str[0]# 0X) THEN
	  ms.Set( c.list, m.aListQuiet, e.true );
	  ms.Get( c.list, m.aListActive, pos );
	  ms.Get( c.list, m.aListEntries, cnt );
	  IF pos # m.vListActiveOff THEN
	    m.DoMethod( c.list, m.mListRemove, m.vListRemoveActive );
	    IF (pos = 0) OR (pos = m.vListActiveOff) THEN
	      m.DoMethod( c.list, m.mListInsertSingle, str, m.vListInsertTop );
	    ELSIF (cnt-pos) = 1 THEN;
	      m.DoMethod( c.list, m.mListInsertSingle, str, m.vListInsertBottom );
	    ELSE
	      m.DoMethod( c.list, m.mListInsertSingle, str, pos );
	    END;
	    ms.Set( c.list, m.aListActive, pos );
	  END;
	  ms.Set( c.list, m.aListQuiet, e.false );
	END;
      ELSIF c.setHook # NIL THEN
	ret :=  u.CallHookPkt( c.setHook, c.list, c.string );
      END;
      m.DoMethod( c.list, m.mNotify, m.aListActive, m.vEveryTime, c.group, 1, mGetString );
      RETURN ret;
    END SetString;

(*\\\*)
(*/// ------------------ "PROCEDURE ClassDesc.GetString()" ------------------- *)

  PROCEDURE ( VAR c : ClassDesc ) GetString( VAR msg : pGetString ):e.APTR;
    VAR str : e.STRPTR;
    BEGIN
      IF y.VAL( LONGINT, c.getHook ) = vGetStringHookString THEN
	m.DoMethod( c.list, m.mListGetEntry, m.vListGetEntryActive, y.ADR( str ) );
	IF (str # NIL) THEN
	  ms.Set( c.string, m.aStringContents, str );
	END;
      ELSIF c.getHook # NIL THEN
	RETURN u.CallHookPkt( c.setHook, c.list, c.string );
      END;
      RETURN NIL;
    END GetString;

(*\\\*)
(*/// ------------------- "PROCEDURE ClassDesc.Dispose()" -------------------- *)

  PROCEDURE ( VAR c : ClassDesc ) Dispose*( VAR msg : I.Msg ):e.APTR;
    BEGIN
      IF c.menu # NIL THEN m.DisposeObject( c.menu ) END;
      RETURN c.Dispose^( msg );
    END Dispose;

(*\\\*)
(*/// --------------------- "PROCEDURE ClassDesc.New()" ---------------------- *)

  PROCEDURE ( VAR c : ClassDesc ) New*( VAR msg : I.OpSet ):e.APTR;
    VAR new, remove, up, down : m.Object;
	str : e.LSTRPTR;
	nr, ud : m.Object;
	lgroup : m.Object;
	tags : u.Tags2;
	butGroup : m.Object;
	list : m.Object;
	menu : m.Object;
	newm, removem, upm, downm, helpm : m.Object;

    PROCEDURE GetTagString( tl : u.TagListPtr; attr : u.TagID): e.LSTRPTR;
      BEGIN
	RETURN u.GetTagDataP( attr, NIL, tl );
      END GetTagString;

    BEGIN
      new := NIL; remove := NIL; up := NIL; down := NIL; nr := NIL; ud := NIL;
      c.setHook := y.VAL( u.HookPtr, u.GetTagData( aSetStringHook, vSetStringHookString, msg.attrList ));
      c.getHook := y.VAL( u.HookPtr, u.GetTagData( aGetStringHook, vGetStringHookString, msg.attrList ));
      list := ms.ListObject( m.aListConstructHook, u.GetTagData( m.aListConstructHook, m.vListConstructHookString, msg.attrList ),
			     m.aListDestructHook, u.GetTagData( m.aListDestructHook, m.vListDestructHookString, msg.attrList ),
			     u.end );

      c.list := ms.ListviewObject( m.aListviewList, list,
				   m.aFrame, m.vFrameInputList,
				   u.end );

      helpm   := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aHelpMenuText), NIL,0, aHelpMenuText );

      str := GetTagString( msg.attrList, aNewText);
      IF str # NIL THEN
	new := ms.SimpleButton( str^ );
      END;

      str := GetTagString( msg.attrList, aRemoveText);
      IF str # NIL THEN
	remove := ms.SimpleButton( str^ );
      END;

      str := GetTagString( msg.attrList, aUpText);
      IF str # NIL THEN
	up := ms.SimpleButton( str^ );
      END;

      str := GetTagString( msg.attrList, aDownText);
      IF str # NIL THEN
	down := ms.SimpleButton( str^ );
      END;

      IF new # NIL THEN
	nr := ms.HGroup( m.aGroupSpacing, 1,
			 m.aGroupSameWidth, e.true,
			 m.aGroupChild, new,
			  m.aGroupChild, remove,
			 u.end );
	newm    := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aNewMenuText), NIL,0,aNewMenuText);
	removem := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aRemoveMenuText), NIL,0,aRemoveMenuText);


      END;
      IF up # NIL THEN
	ud := ms.HGroup( m.aGroupSpacing, 1,
			 m.aGroupSameWidth, e.true,
			 m.aGroupChild, up,
			 m.aGroupChild, down,
			 u.end );
	upm     := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aUpMenuText), NIL,0,aUpMenuText);
	downm   := m.MakeObject( m.oMenuitem, GetTagString( msg.attrList, aDownMenuText), NIL,0,aUpMenuText);
      END;
      IF (nr # NIL) & (ud # NIL) THEN
	butGroup := ms.VGroup( m.aGroupSpacing, 1,
			       m.aGroupSameWidth, e.true,
			       m.aGroupChild, nr,
			       m.aGroupChild, ud,
			       u.done );

	menu := ms.MenuObject( m.aFamilyChild, newm,
			       m.aFamilyChild, removem,
			       m.aFamilyChild, upm,
			       m.aFamilyChild, downm,
			       m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
			       m.aFamilyChild, helpm,
			       m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
			       u.done  );
      ELSIF (nr # NIL ) THEN
	butGroup := nr;
	menu := ms.MenuObject( m.aFamilyChild, newm,
			       m.aFamilyChild, removem,
			       m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
			       m.aFamilyChild, helpm,
			       m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
			       u.done  );
      ELSIF (ud # NIL ) THEN;
	butGroup := ud;
	menu := ms.MenuObject( m.aFamilyChild, upm,
			       m.aFamilyChild, downm,
			       m.aFamilyChild, m.MakeObject( m.oMenuitem, -1, NIL,0,0),
			       m.aFamilyChild, helpm,
			       m.aMenuTitle, GetTagString( msg.attrList, m.aFrameTitle ),
			       u.done  );
      ELSE;
	butGroup := NIL;
      END;
      c.string := ms.StringObject( m.aStringAttachedList, c.list,
				   m.aFrame, m.vFrameString,
				   u.done );
      IF butGroup # NIL THEN
	lgroup := ms.VGroup( m.aGroupSpacing,1,
			     m.aGroupChild, c.list,
			     m.aGroupChild, butGroup,
			     m.aGroupChild, c.string,
			     m.aContextMenu,c.menu,
			     u.end );
      ELSE
	lgroup := ms.VGroup( m.aGroupSpacing,1,
			     m.aGroupChild, c.list,
			     m.aGroupChild, c.string,
			     m.aContextMenu, c.menu,
			     u.end );
      END;

      c.menu := ms.MenustripObject( m.aFamilyChild, menu,
				    u.done );

      ms.Set( c.list, m.aContextMenu, c.menu );
      tags[0].tag := m.aGroupChild;
      tags[0].data := lgroup;
      tags[1].tag := u.more;
      tags[1].data := msg.attrList;
      msg.attrList := y.ADR(tags);  
      c.group := c.New^( msg );
      IF c.group # NIL THEN
	c.CopyClass( c.group );
	ms.Set( c.group, m.aShortHelp, u.GetTagData( m.aShortHelp, NIL, msg.attrList ) );

	m.DoMethod( c.string, m.mNotify, m.aStringAcknowledge, m.vEveryTime, c.group, 1, mSetString );
	m.DoMethod( c.list, m.mNotify, m.aListActive, m.vEveryTime, c.group, 1, mGetString );
	IF up # NIL THEN
	  m.DoMethod( up, m.mNotify, m.aPressed, e.false, c.group, 1, mUp );
	  m.DoMethod( upm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.group, 1, mUp );
	END;
	IF down # NIL THEN
	  m.DoMethod( down, m.mNotify, m.aPressed, e.false, c.group, 1, mDown );
	  m.DoMethod( downm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.group, 1, mDown );
	END;
	IF new # NIL THEN
	  m.DoMethod( new, m.mNotify, m.aPressed, e.false, c.list, 3, m.mListInsertSingle, y.ADR( "leer" ), m.vListInsertBottom );
	  m.DoMethod( newm, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.list, 3, m.mListInsertSingle, y.ADR( "leer" ), m.vListInsertBottom  );
	END;
	IF remove # NIL THEN
	  m.DoMethod( remove, m.mNotify, m.aPressed, e.false, c.list, 2, m.mListRemove, m.vListRemoveActive );
	  m.DoMethod( removem, m.mNotify, m.aMenuitemTrigger, m.vEveryTime, c.list, 2, m.mListRemove, m.vListRemoveActive );
	END;
      END;
      RETURN c.group;
    END New;

(*\\\*)
(*/// ------------------------ "PROCEDURE Dispatch()" ------------------------ *)

  PROCEDURE Dispatch * ( cl : I.IClassPtr; obj : I.ObjectPtr; msg : I.MsgPtr ):e.APTR;
    VAR c : Class;
    BEGIN
      IF msg.methodID # I.new THEN
	c := rc.BoopsiToObj( cl, obj )(Class);
      END;               
      CASE msg.methodID OF
	| mSetString : RETURN c.SetString( msg^(pSetString) );
	| mGetString : RETURN c.GetString( msg^(pGetString) );
	| mUp        : RETURN c.Up( msg^ );
	| mDown      : RETURN c.Down( msg^ );
      ELSE
	RETURN sc.Dispatch( cl, obj, msg );
      END;         
    END Dispatch;     

(*\\\*)

BEGIN
  class := rc.InitPrivFromClass( sc.class, Dispatch, SIZE( ClassDesc ), y.TYPEDESC( ClassDesc ) );
  IF class = NIL THEN HALT(205) END;
CLOSE
  IF class # NIL THEN IF I.FreeClass( class ) THEN END END;
END EditListClass.