home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d3xx / d386 / xlispstat.lha / XLispStat / src3.lzh / Mac / macmenus.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-07-30  |  13.3 KB  |  471 lines
  1. /* macmenus - Low Level Menu Objects for Macintosh                     */
  2. /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
  3. /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
  4. /* You may give out copies of this software; for conditions see the    */
  5. /* file COPYING included with this distribution.                       */
  6.  
  7. /***********************************************************************/
  8. /**                                                                   **/
  9. /**                    General Includes and Definitions               **/
  10. /**                                                                   **/
  11. /***********************************************************************/
  12.  
  13. #ifdef MPWC
  14. # include <Quickdraw.h>
  15. # include <Windows.h>
  16. # include <Menus.h>
  17. # include <Events.h>
  18. # include <Dialogs.h>
  19. # include <Desk.h>
  20. # include <ToolUtils.h>
  21. # include <OSEvents.h>
  22. # define SPRINTF_ADJUST 0  /* needed because of THINK_C bug? */
  23. #else
  24. # include <QuickDraw.h>
  25. # include <WindowMgr.h>
  26. # include <MenuMgr.h>
  27. # include <EventMgr.h>
  28. # define SPRINTF_ADJUST 1  /* needed because of THINK_C bug? */
  29. # define ModalFilterProcPtr ProcPtr
  30. #endif MPWC
  31.  
  32. #define IVIEW_MENU MenuHandle
  33. #define IVIEW_WINDOW WindowPtr
  34. #define nil 0L
  35.  
  36. #include "xlisp.h"
  37. #include "version.h"
  38.  
  39. /* external variables */
  40. extern LVAL s_true, s_title, s_items, s_enabled, s_id, s_menu_list, s_key,
  41.   s_mark, s_style, s_action, s_menu, s_menu_proto, s_apple_menu_proto,
  42.   s_menu_item_proto, sk_select, sk_update, sk_do_action, s_bold, s_italic,
  43.   s_underline, s_outline, s_shadow, s_condense, s_extend, sk_enabled,
  44.   s_hardware_address, sk_allocate, sk_dispose;
  45.  
  46. extern char buf[];
  47.  
  48. /* external functions */
  49. extern LVAL peekarg(), slot_value(), xsmenu_isnew(), xsmenu_select();
  50. extern IVIEW_MENU get_menu_address();
  51. extern IVIEW_WINDOW GETWINDOWADDRESS();
  52.  
  53. /***********************************************************************/
  54. /**                                                                   **/
  55. /**                       MENU-PROTO Definitions                      **/
  56. /**                                                                   **/
  57. /***********************************************************************/
  58.  
  59. # define get_menu_id(m) ((int) getfixnum(slot_value(m, s_id)))
  60.  
  61. FORWARD Style get_item_style();
  62.  
  63. /***********************************************************************/
  64. /**                                                                   **/
  65. /**                     MENU-ITEM-PROTO Definitions                   **/
  66. /**                                                                   **/
  67. /***********************************************************************/
  68.  
  69. FORWARD char *get_item_string();
  70.  
  71. /***********************************************************************/
  72. /**                                                                   **/
  73. /**                        Support Function                           **/
  74. /**                                                                   **/
  75. /***********************************************************************/
  76.  
  77. LOCAL LVAL GetMenuList()
  78. {
  79.   return(slot_value(getvalue(s_menu_proto), s_menu_list));
  80. }
  81.  
  82. /* find the position of the item in the menu */
  83. static get_item_position(menu, item)
  84.     LVAL menu, item;
  85. {
  86.   int i;
  87.   LVAL items;
  88.   
  89.   for (items = slot_value(menu, s_items), i = 1;
  90.        consp(items) && car(items) != item; i++, items = cdr(items))
  91.     ;
  92.   if (item != car(items)) xlfail("item not in the menu");
  93.   return(i);
  94. }
  95.  
  96. /***********************************************************************/
  97. /**                                                                   **/
  98. /**                            Menu Functions                         **/
  99. /**                                                                   **/
  100. /***********************************************************************/
  101.  
  102. StMObInstalled(m)
  103.     LVAL m;
  104. {
  105.   return(StMObAllocated(m) && GetMHandle(get_menu_id(m)) != NIL);
  106. }
  107.  
  108. /* find menu object with given hardware address */
  109. LVAL get_menu_by_hardware(m)
  110.     IVIEW_MENU m;
  111. {
  112.   LVAL menu = NIL, next;
  113.   
  114.   for (next = GetMenuList();
  115.        menu == NIL && consp(next); next = cdr(next)) 
  116.     if (StMObAllocated(car(next)) && m == get_menu_address(car(next)))
  117.       menu = car(next);
  118.   
  119.   if (menu == NIL) xlfail("can't find menu with this handle");
  120.   return(menu);
  121. }
  122.  
  123. /* find lisp menu with a specified macintosh menuID */
  124. static LVAL get_menu_by_id(m)
  125.     int m;
  126. {
  127.   return(get_menu_by_hardware(GetMHandle(m)));
  128. }
  129.  
  130. /* menu select function for SkelMenu. Sends :SELECT message to the menu. */
  131. static LispMenuSelect(i, m)
  132.     int i, m;
  133. {
  134.   /* Unhilite the menu bar */
  135.   HiliteMenu(0);
  136.   
  137.   send_message1(get_menu_by_id(m), sk_select, i);
  138. }
  139.  
  140. /* send an installed menu the :UPDATE message */
  141. static LispMenuUpdate(m)
  142.     int m;
  143. {
  144.   send_message(get_menu_by_id(m), sk_update);
  145. }
  146.  
  147. /* allocate a macintosh internal menu */
  148. static id_in_use(id)
  149.     int id;
  150. {
  151.   LVAL next;
  152.   
  153.   for (next = GetMenuList(); consp(next); next = cdr(next)) {
  154.     if (id == get_menu_id(car(next))) return(TRUE);
  155.   }
  156.   return(FALSE);
  157. }
  158.   
  159. static unique_id()
  160. {
  161.   static int id = 2000;
  162.   
  163.   if (id > 32000) id = 2000;
  164.   id++;
  165.   
  166.   while (id_in_use(id)) id++;
  167.   return(id);
  168. }
  169.  
  170. StMObAllocateMach(menu)
  171.     LVAL menu;
  172. {
  173.   MenuHandle theMenu;
  174.   LVAL title;
  175.   int menuID;
  176.   
  177.   title = slot_value(menu, s_title);
  178.   
  179.   menuID = unique_id();
  180.   
  181.   CtoPstr((char *) getstring(title));
  182.   theMenu = NewMenu(menuID, getstring(title));
  183.   PtoCstr((char *) getstring(title));
  184.   if (theMenu == NULL) xlfail("menu allocation failed");
  185.   set_menu_address(theMenu, menu);
  186.   set_slot_value(menu, s_id, cvfixnum((FIXTYPE) menuID));
  187.   
  188.   if (kind_of_p(menu, getvalue(s_apple_menu_proto)))
  189.     AddResMenu (theMenu, 'DRVR');
  190. }
  191.  
  192. /* dispose of a macintosh menu */
  193. StMObDisposeMach(menu)
  194.     LVAL menu;
  195. {
  196.   if (StMObAllocated(menu)) SkelRmveMenu(get_menu_address(menu));
  197.   if (StMObAllocated(menu)) DisposeMenu(get_menu_address(menu));
  198. }
  199.  
  200. /* add items to a macintosh internal menu */
  201. StMObAppendItems(menu, items)
  202.     LVAL menu, items;
  203. {
  204.   LVAL item;
  205.   char *s;
  206.   int i;
  207.   MenuHandle theMenu;
  208.   
  209.   if (StMObAllocated(menu)) {
  210.     theMenu = get_menu_address(menu);
  211.     i = llength(slot_value(menu, s_items)) - llength(items);
  212.     if (i < 0) xlfail("append list should not exceed item list");
  213.     
  214.     for (; consp(items); items = cdr(items), i++) {
  215.       item = car(items);
  216.       s = get_item_string(item);
  217.       CtoPstr(s);
  218.       InsMenuItem(theMenu, s, i);
  219.       PtoCstr(s);
  220.       SetItemStyle(theMenu, i, get_item_style(item));
  221.     }
  222.   }
  223. }
  224.  
  225. /* remove item from a macintosh menu */
  226. StMObDeleteItem(menu, item)
  227.     LVAL menu, item;
  228. {
  229.   if (StMObAllocated(menu)) 
  230.     DelMenuItem(get_menu_address(menu), get_item_position(menu, item));
  231. }
  232.  
  233. /* install a macintosh menu */
  234. StMObInstall(menu)
  235.     LVAL menu;
  236. {
  237.   if (! StMObInstalled(menu)) {
  238.     if (! StMObAllocated(menu)) StMObAllocate(menu);
  239.     SkelMenu(get_menu_address(menu), LispMenuSelect, NULL);
  240.     SkelMenuUpdateProc(get_menu_address(menu), LispMenuUpdate);
  241.   }
  242. }
  243.  
  244. /* remove a macintosh menu */
  245. StMObRemove(menu)
  246.     LVAL menu;
  247. {
  248.   if (StMObAllocated(menu)) SkelRmveMenu(get_menu_address(menu));
  249.   if (StMObAllocated(menu)) StMObDispose(menu);
  250. }
  251.  
  252. /* enable or disable a macintosh menu */
  253. StMObEnable(menu, enable)
  254.     LVAL menu;
  255.     int enable;
  256. {
  257.   if (StMObAllocated(menu)) {
  258.     if (enable) EnableItem(get_menu_address(menu), 0);
  259.     else DisableItem(get_menu_address(menu), 0);
  260.     if (StMObInstalled(menu)) DrawMenuBar();
  261.   }
  262.   set_slot_value(menu, s_enabled, (enable) ? s_true : NIL);
  263. }
  264.  
  265. StMObPopup(menu, left, top, window)
  266.     LVAL menu, window;
  267.     int left, top;
  268. {
  269.   IVIEW_MENU theMenu;
  270.   IVIEW_WINDOW w;
  271.   int item, menuID;
  272.   GrafPtr SavePort;
  273.   Point pt;
  274.   
  275.   StMObAllocate(menu);
  276.   theMenu = get_menu_address(menu);
  277.   menuID = get_menu_id(menu);
  278.   if (window != NIL && (w = GETWINDOWADDRESS(window)) != nil) {
  279.     GetPort(&SavePort);
  280.     SetPort(w);
  281.     pt.h = left; pt.v = top;
  282.     LocalToGlobal(&pt);
  283.     left = pt.h; top = pt.v;
  284.     SetPort(SavePort);
  285.   }
  286.   if (! StillDown()) {
  287.     while (! Button()) ;
  288.     FlushEvents(mDownMask | mUpMask, 0);
  289.   }
  290.   InsertMenu(theMenu, -1);
  291.   item = LoWord(PopUpMenuSelect(theMenu, top, left, 1));
  292.   DeleteMenu(menuID);
  293.   StMObDispose(menu);
  294.   return(item);
  295. }
  296.   
  297. /***********************************************************************/
  298. /**                                                                   **/
  299. /**                         Menu Item Functions                       **/
  300. /**                                                                   **/
  301. /***********************************************************************/
  302.  
  303. /* Get a string for use by AppendMenu. Style info is not encoded. */
  304. static char *get_item_string(item)
  305.     LVAL item;
  306. {
  307.   LVAL title, key, mark, enabled;
  308.   static char *s;
  309.     
  310.   if (! menu_item_p(item)) xlerror("not a menu item", item);
  311.   
  312.   title = slot_value(item, s_title);
  313.   if (! stringp(title)) xlerror("title is not a string", title);
  314.   key = slot_value(item, s_key);
  315.   mark = slot_value(item, s_mark);
  316.   enabled = slot_value(item, s_enabled);
  317.   
  318.   s = buf;
  319.   if (enabled == NIL)
  320.     s += sprintf(s, "(") - SPRINTF_ADJUST;
  321.   if (charp(key))
  322.     s += sprintf(s, "/%c", getchcode(key)) - SPRINTF_ADJUST;
  323.   if (mark == s_true)
  324.     s += sprintf(s, "!%c", 0x12) - SPRINTF_ADJUST;
  325.   else if (charp(mark))
  326.     s += sprintf(s, "!%c", getchcode(key)) - SPRINTF_ADJUST;
  327.   sprintf(s, "%s", getstring(title));
  328.   return(buf);
  329. }
  330.  
  331. /* Convert style symbol to Style value */
  332. static Style style_value(sym)
  333.     LVAL sym;
  334. {
  335.   if (sym == NIL) return(0);
  336.   else if (! symbolp(sym)) xlerror("not a symbol", sym);
  337.   else if (sym == s_bold) return(bold);
  338.   else if (sym == s_italic) return(italic);
  339.   else if (sym == s_underline) return(underline);
  340.   else if (sym == s_outline) return(outline);
  341.   else if (sym == s_shadow) return(shadow);
  342.   else if (sym == s_condense) return(condense);
  343.   else if (sym == s_extend) return(extend);
  344.   else xlerror("unknown style symbol", sym);
  345. }
  346.  
  347. /* compute the style value for a style symbol or list using bit-or */
  348. static Style get_item_style(item)
  349.     LVAL item;
  350. {
  351.   LVAL style;
  352.   Style s;
  353.   
  354.   style = slot_value(item, s_style);
  355.   if (consp(style)) {
  356.     for (s = 0; consp(style); style = cdr(style))
  357.       s = s | style_value(car(style));
  358.     return(s);
  359.   }
  360.   else return (style_value(style));
  361. }
  362.     
  363. /* adjust internal implementation of allocated menu to new instance value */ 
  364. StMObSetItemProp(item, which)
  365.     LVAL item;
  366.     int which;
  367. {
  368.   char *s, ch;
  369.   MenuHandle theMenu;
  370.   LVAL menu;
  371.   int i;
  372.   
  373.   menu = slot_value(item, s_menu);
  374.   if (menu != NIL && StMObAllocated(menu)) {
  375.     theMenu = get_menu_address(menu);
  376.     i = get_item_position(menu, item);
  377.     switch (which) {
  378.     case 'T': {
  379.                 LVAL title = slot_value(item, s_title);
  380.                 if (! stringp(title))
  381.                   xlerror("title is not a string", title);
  382.                 s = (char *) getstring(title); 
  383.                 CtoPstr(s);
  384.                 SetItem(theMenu, i, s);
  385.                 PtoCstr(s);
  386.                 break;
  387.               }
  388.     case 'K': DelMenuItem(theMenu, i);
  389.               s = get_item_string(item);
  390.               CtoPstr(s);
  391.               InsMenuItem(theMenu, s, i - 1);
  392.               PtoCstr(s);
  393.               SetItemStyle(theMenu, i, get_item_style(item));
  394.               break;
  395.     case 'M': {
  396.                 LVAL mark = slot_value(item, s_mark);
  397.                 CheckItem(theMenu, i, FALSE);
  398.                 if (mark == s_true) ch = 0x12;
  399.                 else if (charp(mark)) ch = getchcode(mark);
  400.                 else break; 
  401.                 SetItemMark(theMenu, i, ch);
  402.                 break;
  403.               }
  404.     case 'S': SetItemStyle(theMenu, i, get_item_style(item)); break;
  405.     case 'A': break;
  406.     case 'E': if (slot_value(item, s_enabled) != NIL) 
  407.                 EnableItem(theMenu, i);
  408.               else DisableItem(theMenu, i);
  409.               break;
  410.     default:  xlfail("unknown item instance variable");
  411.     }
  412.   }
  413. }
  414.  
  415. /***********************************************************************/
  416. /***********************************************************************/
  417. /**                                                                   **/
  418. /**                    APPLE-MENU-PROTO Methods                       **/
  419. /**                                                                   **/
  420. /***********************************************************************/
  421. /***********************************************************************/
  422.  
  423. LVAL xsapple_menu_isnew() { return(xsmenu_isnew()); }
  424.  
  425. LVAL xsapple_menu_select()
  426. {
  427.   LVAL menu = peekarg(0), item = peekarg(1);
  428.   int i, n;
  429.   GrafPtr SavePort;
  430.   
  431.   if (! menu_p(menu)) xlerror("not a menu", menu);
  432.   if (! fixp(item)) xlerror("not an integer", item);
  433.  
  434.   i = getfixnum(item);
  435.   n = llength(slot_value(menu, s_items));
  436.   
  437.   if (i <= n) return(xsmenu_select());
  438.   else {
  439.     menu = xlgetarg();
  440.     i = getfixnum(xlgetarg());
  441.     xllastarg();
  442.     
  443.     if (StMObAllocated(menu)) {
  444.       GetPort (&SavePort);
  445.       GetItem (get_menu_address(menu), i, buf);  /* get DA name */
  446.       OpenDeskAcc(buf);                          /* open it     */
  447.       SetPort (SavePort);
  448.     }
  449.     return(NIL);
  450.   }
  451. }
  452.  
  453. /* about alert for the */
  454. # define    aboutAlrt        1000
  455. #ifdef MPWC
  456. #define COMPILER "\pMPW C, V3.0"
  457. #else
  458. #define COMPILER "\pLightspeedª C, V3.0"
  459. #endif MPWC
  460. LVAL xsabout_xlisp_stat() 
  461. {
  462.   char *vers = XLISPSTAT_VERSION;
  463.   
  464.   xllastarg();
  465.   CtoPstr(vers);
  466.   ParamText(vers, COMPILER, "\p", "\p");
  467.   Alert (aboutAlrt, (ModalFilterProcPtr) NULL);
  468.   PtoCstr(vers);
  469.   return(NIL);
  470. }
  471.