------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- button.sa: Button widget
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>

class TK_BUTTON_CFG < $TK_WIDGET_CFG is
   include TK_WIDGET_CFG_INCL
	 text->text,
	 padx->padx, pady->pady,
	 height->height,width->width,
	 justify_left->justify_left,justify_right->justify_right,
	 justify_center->justify_center,
	 relief_none->relief_none,relief_raised->relief_raised,
	 relief_sunken->relief_sunken,
	 relief_flat->relief_flat,relief_ridge->relief_ridge,
	 relief_groove->relief_groove,
	 font->font,
	 normal->normal,disable->disable,active->active,
	 background->background,
	 foreground->foreground,
	 borderwidth->borderwidth,
	 wraplength->wraplength,	 
	 highlightcolor->highlightcolor,
	 highlightthickness->highlightthickness,
	 activeforeground->activeforeground,
	 activebackground->activebackground,
	 disabledforeground->disabledforeground;
   -- bitmap->bitmap, image->image,	 cursor->cursor,
    
   underline(char_index: INT) is config("underline",char_index.str) end;
   underline(char_index: INT): SAME is underline(char_index); return self end;
   std: SAME is return new.relief_raised end;
    
end;
-------------------------------------------------------------------
class TK_BUTTON < $TK_WIDGET is
   include TK_WIDGET_INCL{TK_BUTTON_CFG};
    
   --  Redefined from WIDGET_INCL
   const tk_widget_type: STR := "button";

   private default_init(c: TK_BUTTON_CFG) is
      eval(widget_name+" configure -command ",
	   quote("sather "+ path_name+" 0"));
   end;
   
   private default_packing: TK_PACK is return TK_PACK::top end;
   private default_config: TK_BUTTON_CFG is  return TK_BUTTON_CFG::std; end; 
    
   -- Button specific widget interface
   attr command: ROUT;
   command(c: ROUT): SAME is command(c); return self end;
   -- Older (obsolete) version of bind_press_button
   
   bind_press_button(c:ROUT) is command := c; end;
   -- Bind a command to the button press
   
   flash is eval(actual_widget_name,"flash");  end;
    
   invoke is eval(actual_widget_name,"invoke");  end;
    
   act_on(id: INT,args: ARRAY{STR}) is
      -- Private to the widget implementation. Translate a callback integer
      -- into a call on the routine
      if ~void(command) then command.call;  end;
   end;
    
end; -- class TK_BUTTON
-------------------------------------------------------------------



