/* macmenus - Low Level Menu Objects for Macintosh                     */
/* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
/* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
/* You may give out copies of this software; for conditions see the    */
/* file COPYING included with this distribution.                       */
 
/***********************************************************************/
/**                                                                   **/
/**                    General Includes and Definitions               **/
/**                                                                   **/
/***********************************************************************/

#include "xlisp.h"
#include "xlstat.h"
#include "xlgraph.h"
#include "version.h"

#define IVIEW_MENU MenuHandle
#define IVIEW_WINDOW WindowPtr

/* external variables */
extern LVAL s_true, s_title, s_items, s_enabled, s_id, s_menu_list, s_key,
  s_mark, s_style, s_action, s_menu, s_menu_proto, s_apple_menu_proto,
  s_menu_item_proto, sk_select, sk_update, sk_do_action, s_bold, s_italic,
  s_underline, s_outline, s_shadow, s_condense, s_extend, sk_enabled,
  s_hardware_address, sk_allocate, sk_dispose;
extern int hasAppleEvents;

/* forward declarations */
LOCAL char *get_item_string _((LVAL item));
LOCAL Style get_item_style _((LVAL item));
LOCAL pascal void LispMenuSelect _((short i, short m));


/***********************************************************************/
/**                                                                   **/
/**                       MENU-PROTO Definitions                      **/
/**                                                                   **/
/***********************************************************************/

# define get_menu_id(m) ((int) getfixnum(slot_value(m, s_id)))

LOCAL Style get_item_style();

/***********************************************************************/
/**                                                                   **/
/**                     MENU-ITEM-PROTO Definitions                   **/
/**                                                                   **/
/***********************************************************************/

LOCAL char *get_item_string();

/***********************************************************************/
/**                                                                   **/
/**                        Support Function                           **/
/**                                                                   **/
/***********************************************************************/

LOCAL LVAL GetMenuList(void)
{
  return(slot_value(getvalue(s_menu_proto), s_menu_list));
}

/* find the position of the item in the menu */
LOCAL int get_item_position(LVAL menu, LVAL item)
{
  int i;
  LVAL items;
  
  for (items = slot_value(menu, s_items), i = 1;
       consp(items) && car(items) != item; i++, items = cdr(items))
    ;
  if (item != car(items)) xlfail("item not in the menu");
  return(i);
}

/***********************************************************************/
/**                                                                   **/
/**                            Menu Functions                         **/
/**                                                                   **/
/***********************************************************************/

int StMObInstalled(LVAL m)
{
  return(StMObAllocated(m) && GetMenuHandle(get_menu_id(m)) != nil);
}

/* find menu object with given hardware address */
LVAL get_menu_by_hardware(IVIEW_MENU m)
{
  LVAL menu = NIL, next;
  
  for (next = GetMenuList();
       menu == NIL && consp(next); next = cdr(next)) 
    if (StMObAllocated(car(next)) && m == (IVIEW_MENU) get_menu_address(car(next)))
      menu = car(next);
  
  if (menu == NIL) xlfail("can't find menu with this handle");
  return(menu);
}

/* find lisp menu with a specified macintosh menuID */
LOCAL LVAL get_menu_by_id(int m)
{
  return(get_menu_by_hardware(GetMenuHandle(m)));
}

/* menu select function for SkelMenu. Sends :SELECT message to the menu. */
LOCAL pascal void LispMenuSelect(short i, short m)
{
  /* Unhilite the menu bar */
  HiliteMenu(0);
  
  send_message1(get_menu_by_id(m), sk_select, i);
}

/* send an installed menu the :UPDATE message */
extern pascal void UpdateLispMenus(void)
{
  LVAL list;
  for (list = GetMenuList(); consp(list); list = cdr(list))
    send_message(car(list), sk_update);
}

/* allocate a macintosh internal menu */
LOCAL id_in_use(int id)
{
  LVAL next;
  
  for (next = GetMenuList(); consp(next); next = cdr(next)) {
    if (id == get_menu_id(car(next))) return(TRUE);
  }
  return(FALSE);
}
  
LOCAL unique_id(void)
{
  static int id = 2000;
  
  if (id > 32000) id = 2000;
  id++;
  
  while (id_in_use(id)) id++;
  return(id);
}

VOID StMObAllocateMach(LVAL menu)
{
  MenuHandle theMenu;
  LVAL title;
  int menuID;
  
  title = slot_value(menu, s_title);
  
  menuID = unique_id();
  
  CtoPstr(getstring(title));
  theMenu = NewMenu(menuID, (StringPtr) getstring(title));
  PtoCstr((StringPtr) getstring(title));
  if (theMenu == NULL) xlfail("menu allocation failed");
  set_menu_address((CPTR) theMenu, menu);
  set_slot_value(menu, s_id, cvfixnum((FIXTYPE) menuID));
  
  if (kind_of_p(menu, getvalue(s_apple_menu_proto))) {
    if (! hasAppleEvents) InsertMenuItem(theMenu, "\p(-", 0);
    AppendResMenu (theMenu, 'DRVR');
  }
}

/* dispose of a macintosh menu */
VOID StMObDisposeMach(LVAL menu)
{
  if (StMObAllocated(menu)) SkelRmveMenu((MenuHandle) get_menu_address(menu));
  if (StMObAllocated(menu)) DisposeMenu((MenuHandle) get_menu_address(menu));
}

/* add items to a macintosh internal menu */
VOID StMObAppendItems(LVAL menu, LVAL items)
{
  LVAL item;
  char *s;
  int i;
  MenuHandle theMenu;
  
  if (StMObAllocated(menu)) {
    theMenu = (MenuHandle) get_menu_address(menu);
    i = llength(slot_value(menu, s_items)) - llength(items);
    if (i < 0) xlfail("append list should not exceed item list");
    
    for (; consp(items); items = cdr(items), i++) {
      item = car(items);
      s = get_item_string(item);
      CtoPstr(s);
      InsertMenuItem(theMenu, (StringPtr) s, i);
      PtoCstr((StringPtr) s);
      SetItemStyle(theMenu, i, get_item_style(item));
    }
  }
}

/* remove item from a macintosh menu */
VOID StMObDeleteItem(LVAL menu, LVAL item)
{
  if (StMObAllocated(menu)) 
    DeleteMenuItem((MenuHandle) get_menu_address(menu), get_item_position(menu, item));
}

/* install a macintosh menu */
VOID StMObInstall(LVAL menu)
{
  if (! StMObInstalled(menu)) {
    if (! StMObAllocated(menu)) StMObAllocate(menu);
    if (! SkelMenu((MenuHandle) get_menu_address(menu), LispMenuSelect, nil, false, true))
      xlfail("menu installation failed");;
  }
}

/* remove a macintosh menu */
VOID StMObRemove(LVAL menu)
{
  if (StMObAllocated(menu)) SkelRmveMenu((MenuHandle) get_menu_address(menu));
  if (StMObAllocated(menu)) StMObDispose(menu);
}

/* enable or disable a macintosh menu */
VOID StMObEnable(LVAL menu, int enable)
{
  if (StMObAllocated(menu)) {
    if (enable) EnableItem((MenuHandle) get_menu_address(menu), 0);
    else DisableItem((MenuHandle) get_menu_address(menu), 0);
    if (StMObInstalled(menu)) DrawMenuBar();
  }
  set_slot_value(menu, s_enabled, (enable) ? s_true : NIL);
}

int StMObPopup(LVAL menu, int left, int top, LVAL window)
{
  IVIEW_MENU theMenu;
  IVIEW_WINDOW w;
  int item, menuID;
  GrafPtr SavePort;
  Point pt;
  
  StMObAllocate(menu);
  theMenu = (IVIEW_MENU) get_menu_address(menu);
  menuID = get_menu_id(menu);
  if (window != NIL && (w = (IVIEW_WINDOW) GETWINDOWADDRESS(window)) != nil) {
    GetPort(&SavePort);
    SetPort(w);
    pt.h = left; pt.v = top;
    LocalToGlobal(&pt);
    left = pt.h; top = pt.v;
    SetPort(SavePort);
  }
  if (! StillDown()) {
    while (! Button()) ;
    FlushEvents(mDownMask | mUpMask, 0);
  }
  InsertMenu(theMenu, -1);
  item = LoWord(PopUpMenuSelect(theMenu, top, left, 1));
  DeleteMenu(menuID);
  StMObDispose(menu);
  return(item);
}
  
/***********************************************************************/
/**                                                                   **/
/**                         Menu Item Functions                       **/
/**                                                                   **/
/***********************************************************************/

/* Get a string for use by AppendMenu. Style info is not encoded. */
LOCAL char *get_item_string(LVAL item)
{
  LVAL title, key, mark, enabled;
  static char *s;
    
  if (! menu_item_p(item)) xlerror("not a menu item", item);
  
  title = slot_value(item, s_title);
  if (! stringp(title)) xlerror("title is not a string", title);
  key = slot_value(item, s_key);
  mark = slot_value(item, s_mark);
  enabled = slot_value(item, s_enabled);
  
  s = buf;
  if (enabled == NIL)
    s += sprintf(s, "(");
  if (charp(key))
    s += sprintf(s, "/%c", getchcode(key));
  if (mark == s_true)
    s += sprintf(s, "!%c", 0x12);
  else if (charp(mark))
    s += sprintf(s, "!%c", getchcode(key));
  sprintf(s, "%s", getstring(title));
  return(buf);
}

/* Convert style symbol to Style value */
static Style style_value(LVAL sym)
{
  if (sym == NIL) return(0);
  else if (! symbolp(sym)) xlerror("not a symbol", sym);
  else if (sym == s_bold) return(bold);
  else if (sym == s_italic) return(italic);
  else if (sym == s_underline) return(underline);
  else if (sym == s_outline) return(outline);
  else if (sym == s_shadow) return(shadow);
  else if (sym == s_condense) return(condense);
  else if (sym == s_extend) return(extend);
  else xlerror("unknown style symbol", sym);
  return 0; /* not reached */
}

/* compute the style value for a style symbol or list using bit-or */
LOCAL Style get_item_style(LVAL item)
{
  LVAL style;
  Style s;
  
  style = slot_value(item, s_style);
  if (consp(style)) {
    for (s = 0; consp(style); style = cdr(style))
      s = s | style_value(car(style));
    return(s);
  }
  else return (style_value(style));
}
	
/* adjust internal implementation of allocated menu to new instance value */ 
VOID StMObSetItemProp(LVAL item, int which)
{
  char *s, ch;
  MenuHandle theMenu;
  LVAL menu;
  int i;
  
  menu = slot_value(item, s_menu);
  if (menu != NIL && StMObAllocated(menu)) {
    theMenu = (MenuHandle) get_menu_address(menu);
    i = get_item_position(menu, item);
    switch (which) {
    case 'T': {
                LVAL title = slot_value(item, s_title);
                if (! stringp(title))
                  xlerror("title is not a string", title);
                s = (char *) getstring(title); 
                CtoPstr(s);
                SetMenuItemText(theMenu, i, (StringPtr) s);
                PtoCstr((StringPtr) s);
                break;
              }
    case 'K': DeleteMenuItem(theMenu, i);
              s = get_item_string(item);
              CtoPstr(s);
              InsertMenuItem(theMenu, (StringPtr) s, i - 1);
              PtoCstr((StringPtr) s);
              SetItemStyle(theMenu, i, get_item_style(item));
              break;
    case 'M': {
                LVAL mark = slot_value(item, s_mark);
                CheckItem(theMenu, i, FALSE);
                if (mark == s_true) ch = 0x12;
                else if (charp(mark)) ch = getchcode(mark);
                else break; 
                SetItemMark(theMenu, i, ch);
                break;
              }
    case 'S': SetItemStyle(theMenu, i, get_item_style(item)); break;
    case 'A': break;
    case 'E': if (slot_value(item, s_enabled) != NIL) 
                EnableItem(theMenu, i);
              else DisableItem(theMenu, i);
              break;
    default:  xlfail("unknown item instance variable");
    }
  }
}

/***********************************************************************/
/***********************************************************************/
/**                                                                   **/
/**                    APPLE-MENU-PROTO Methods                       **/
/**                                                                   **/
/***********************************************************************/
/***********************************************************************/

LVAL xsapple_menu_isnew(void) { return(xsmenu_isnew()); }

LVAL xsapple_menu_select(void)
{
  LVAL menu = peekarg(0), item = peekarg(1);
  int i, n;
  GrafPtr SavePort;
  
  if (! menu_p(menu)) xlerror("not a menu", menu);
  if (! fixp(item)) xlerror("not an integer", item);

  i = getfixnum(item);
  n = llength(slot_value(menu, s_items));
  
  if (i <= n) return(xsmenu_select());
  else {
    menu = xlgetarg();
    i = getfixnum(xlgetarg());
    xllastarg();
    
    if (StMObAllocated(menu)) {
      GetPort (&SavePort);
      GetMenuItemText ((MenuHandle) get_menu_address(menu), i, (StringPtr) buf);  /* get DA name */
      OpenDeskAcc((StringPtr) buf);                          /* open it     */
      SetPort (SavePort);
    }
    return(NIL);
  }
}

/* about alert for the */
# define	aboutAlrt		1000
#ifdef applec
#define COMPILER "\pMPW C, V3.2"
#endif /* applec */
#ifdef THINK_C
#define COMPILER "\pThink C, V7.0"
#endif /* THINK_C */
#ifdef __MWERKS__
#define COMPILER "\pMetroWerks CodeWarrior"
#endif /* __MWERKS__ */
LVAL xsabout_xlisp_stat(void) 
{
  xllastarg();
  sprintf(buf, "Release %d.%d.%d%s.",
	  XLS_MAJOR_RELEASE, XLS_MINOR_RELEASE, XLS_SUBMINOR_RELEASE,
	  XLS_RELEASE_STATUS);
  CtoPstr(buf);
  ParamText((StringPtr) buf, COMPILER, "\p", "\p");
  Alert (aboutAlrt, nil);
  return(NIL);
}