home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / emacs-18.59src.lha / emacs-18.59 / src / amiga_screen.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-10-31  |  37.1 KB  |  1,393 lines
  1. #include "config.h"
  2. #undef NULL
  3. #include "lisp.h"
  4. #include "termchar.h"
  5. #include "dispextern.h"
  6.  
  7. #include <stdio.h>
  8. #include <string.h>
  9. #include <stddef.h>
  10. #include <internal/devices.h>
  11. #include <internal/vars.h>
  12.  
  13. #define min(x,y) ((x) > (y) ? (y) : (x))
  14. #define max(x,y) ((x) < (y) ? (y) : (x))
  15.  
  16. #undef LONGBITS
  17.  
  18. #include <exec/types.h>
  19. #include <exec/interrupts.h>
  20. #include <devices/input.h>
  21. #include <devices/inputevent.h>
  22. #include <intuition/intuitionbase.h>
  23. #include <intuition/intuition.h>
  24. #include <devices/conunit.h>
  25. #include <devices/inputevent.h>
  26. #include <graphics/gfxbase.h>
  27. #include <graphics/gfxmacros.h>
  28. #include <utility/hooks.h>
  29. #include <workbench/startup.h>
  30. #include <workbench/workbench.h>
  31.  
  32. #include <proto/exec.h>
  33. #include <proto/dos.h>
  34. #include <proto/intuition.h>
  35. #include <proto/graphics.h>
  36. #include <proto/console.h>
  37. #include <proto/diskfont.h>
  38. #include <proto/wb.h>
  39.  
  40. /* this is defined for those unlucky enough
  41.  * not to have the 3.0 headers  -ch3/16/93. */
  42. #ifndef WA_NewLookMenus
  43. #define WA_NewLookMenus (WA_Dummy + 0x30)
  44. #endif
  45.  
  46. #include "amiga.h"
  47.  
  48. #define SHIFT_MASK (IEQUALIFIER_LSHIFT | IEQUALIFIER_RSHIFT)
  49. #define CONTROL_MASK IEQUALIFIER_CONTROL
  50. #define META_MASK IEQUALIFIER_LALT
  51.  
  52. struct GfxBase *GfxBase;
  53. struct IntuitionBase *IntuitionBase;
  54. struct Library *DiskfontBase, *KeymapBase, *WorkbenchBase;
  55.  
  56. static char intkey_code, intkey_qualifier;
  57. static struct IOStdReq *input_req;
  58. static struct Interrupt int_handler_hook;
  59. static int hooked;
  60.  
  61. static struct MsgPort *wbport;
  62. static struct AppWindow *emacs_app_win;
  63. static struct AppIcon *emacs_icon;
  64.  
  65. struct Library *ConsoleDevice;
  66. static struct TextFont *font;
  67. static int font_opened;
  68. /* The reset string resets the console, turns off scrolling and sets up
  69.    the foreground & background colors. */
  70. #define CONSOLE_RESET "\x1b""c\x9b>1l\x9b""3%d;4%d;>%dm"
  71. static char reset_string[20]; /* Must be big enough for
  72.               printf(CONSOLE_RESET, foreground, background, background);
  73.               (0 <= foreground, background <= 7) */
  74.  
  75. /* These are the pen numbers for emacs window's base colors */
  76. int foreground = 1, background = 0;
  77.  
  78. /* Current window, and its main characteristics */
  79. struct Window *emacs_win;
  80. WORD emacs_x = 0, emacs_y = 0, emacs_w = 640, emacs_h = 200;
  81. char *emacs_screen_name;
  82. char emacs_screen_name_storage[MAXPUBSCREENNAME+1];
  83. int emacs_backdrop = 0;        /* Use backdrop window ? */
  84.  
  85. /* Current window size: */
  86. #define EMACS_X() (emacs_win ? emacs_win->LeftEdge : emacs_x)
  87. #define EMACS_Y() (emacs_win ? emacs_win->TopEdge : emacs_y)
  88. #define EMACS_W() (emacs_win ? emacs_win->Width : emacs_w)
  89. #define EMACS_H() (emacs_win ? emacs_win->Height : emacs_h)
  90.  
  91. /* used for setting the color of standout text  -ch3/16/93. */
  92. int inverse_fill_pen = 8, inverse_text_pen = 8;
  93.  
  94. /* IO request for all console io. */
  95. static struct IOStdReq *emacs_console;
  96.  
  97. /* a storage area for the name of the screen last opened on */
  98.  
  99. #define emacs_icon_width 57
  100. #define emacs_icon_height 55
  101. #define emacs_icon_num_planes 1
  102. #define emacs_icon_words_per_plane 220
  103.  
  104. UWORD chip emacs_icon_data[1][55][4] = {
  105.   {
  106.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  107.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  108.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0fe0,0x6000,
  109.     0x0000,0x0000,0x0060,0x6000,0x0000,0x0000,0x0fff,0xe000,
  110.     0x0000,0x0000,0x1800,0x2000,0x0000,0x0000,0x13ff,0xa000,
  111.     0x0000,0x0000,0x1400,0xa000,0x0000,0x0000,0x3600,0xa000,
  112.     0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x0c00,0xa000,
  113.     0x0000,0x0000,0x1e00,0xa000,0x0000,0x0000,0x0c00,0xa000,
  114.     0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x2100,0xa000,
  115.     0x0000,0x0000,0x3300,0xa000,0x0000,0x0000,0x0c00,0xa000,
  116.     0x003f,0xffff,0xffff,0xb000,0x001f,0xffff,0xffff,0x8000,
  117.     0x004e,0x0000,0x0001,0xf000,0x00c6,0x00f0,0x0001,0x8000,
  118.     0x00c6,0x0100,0x0001,0x8000,0x0006,0x0103,0x9201,0x8000,
  119.     0x0006,0x013a,0x5201,0x8000,0x00c6,0x010a,0x5201,0x8000,
  120.     0x00c6,0x010a,0x5601,0x8000,0x0086,0x00f2,0x4a01,0x8000,
  121.     0x0006,0x0000,0x0001,0x8000,0x0046,0x0000,0x0001,0x8000,
  122.     0x00c6,0x7c00,0x0001,0x8000,0x00c6,0x4000,0x0001,0x8000,
  123.     0x0006,0x41d8,0xc319,0x8000,0x0006,0x7925,0x24a1,0x8000,
  124.     0x00c6,0x4125,0x2419,0x8000,0x01c6,0x4125,0x2485,0x8000,
  125.     0x0086,0x7d24,0xd319,0x8000,0x0007,0x0000,0x0003,0x8000,
  126.     0x0003,0xffe3,0xffff,0x0000,0x0081,0xfff7,0xfffe,0x0000,
  127.     0x01c0,0x0036,0x0000,0x0000,0x0180,0x0014,0x0f80,0x0000,
  128.     0x0000,0x0014,0x1040,0x0000,0x0000,0x0014,0x2720,0x0000,
  129.     0x0000,0x0012,0x28a0,0x0000,0x0080,0x000a,0x48a0,0x0000,
  130.     0x01c0,0x0009,0x90a0,0x0000,0x0180,0x0004,0x20a0,0x0000,
  131.     0x0000,0x0003,0xc0a0,0x0000,0x0000,0x0000,0x00a0,0x0000,
  132.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  133.     0x0000,0x0000,0x0000,0x0000
  134.   },
  135. };
  136.  
  137. struct Image far emacs_icon_image = {
  138.   0, 0,
  139.   emacs_icon_width, emacs_icon_height, emacs_icon_num_planes,
  140.   (UWORD *)emacs_icon_data,
  141.   3, 0,
  142.   0
  143. };
  144.  
  145. static struct DiskObject far emacs_icon_object = {
  146.   0, 0,
  147.   { 0, 0, 0, emacs_icon_width, emacs_icon_height, 0, 0, 0, (APTR)&emacs_icon_image },
  148.   0, 0, 0,
  149.   NO_ICON_POSITION, NO_ICON_POSITION
  150. };
  151.  
  152. static struct Hook background_hook;
  153.  
  154. #define EVENTSIZE 32
  155.  
  156. static struct event {
  157.   ULONG class;
  158.   UWORD code, qual;
  159.   WORD x, y;
  160. } events[EVENTSIZE];
  161. static int event_num, event_in, event_out;
  162.  
  163. static struct wbevent {
  164.   struct wbevent *next;
  165.   char file[1];
  166. } *wbevents;
  167.  
  168. Lisp_Object Vamiga_mouse_pos;
  169. Lisp_Object Vamiga_mouse_item;
  170. extern Lisp_Object MouseMap;
  171. int amiga_remap_bsdel;
  172. int amiga_remap_numeric_keypad;
  173. int amiga_mouse_initialized;
  174. int amiga_wb_initialized;
  175. int emacs_iconified;
  176.  
  177. static int amiga_pos_x(int x)
  178. {
  179.   return (x - emacs_win->BorderLeft) / emacs_win->RPort->Font->tf_XSize;
  180. }
  181.  
  182. static int amiga_pos_y(int y)
  183. {
  184.   return (y - emacs_win->BorderTop) / emacs_win->RPort->Font->tf_YSize;
  185. }
  186.  
  187. static void amiga_change_size(void)
  188. {
  189.   int new_height = amiga_pos_y(emacs_win->Height - emacs_win->BorderBottom);
  190.   int new_width = amiga_pos_x(emacs_win->Width - emacs_win->BorderRight);
  191.  
  192.   /* Hack to force redisplay */
  193.   if (screen_height == new_height) screen_height--;
  194.   /* I consider that refreshes are possible during a select, which is
  195.      true for the current state of emacs */
  196.   change_screen_size(new_height, new_width, 0, !selecting && !waiting_for_input, 1);
  197. }
  198.  
  199. /* Get terminal size from system.
  200.    Store number of lines into *heightp and width into *widthp.
  201.    If zero or a negative number is stored, the value is not valid.  */
  202.  
  203. void get_window_size (widthp, heightp)
  204.      int *widthp, *heightp;
  205. {
  206.   if (emacs_win)
  207.     {
  208.       *heightp = amiga_pos_y(emacs_win->Height - emacs_win->BorderBottom);
  209.       *widthp = amiga_pos_x(emacs_win->Width - emacs_win->BorderRight);
  210.     }
  211.   else
  212.     {
  213.       *heightp = 0;
  214.       *widthp = 0;
  215.     }
  216. }
  217.  
  218. static int set_min_size(struct Window *win, struct TextFont *font,
  219.             WORD *minw, WORD *minh)
  220. {
  221.   *minw = 11 * font->tf_XSize + win->BorderLeft + win->BorderRight;
  222.   *minh = 4 * font->tf_YSize + win->BorderTop + win->BorderBottom;
  223.  
  224.   return (int)WindowLimits(win, *minw, *minh, 0, 0);
  225. }
  226.  
  227. struct fill
  228. {
  229.   struct Layer *layer;
  230.   struct Rectangle bounds;
  231.   WORD offsetx, offsety;
  232. };
  233.  
  234. /* __interrupt disables stack checking.   -ch3/19/93. */
  235. static ULONG __asm __saveds __interrupt
  236. fill_background(register __a2 struct RastPort *obj,
  237.         register __a1 struct fill *msg)
  238. {
  239.   struct Layer *l;
  240.  
  241.   SetAPen(obj, background);
  242.   SetDrMd(obj, JAM1);
  243.   SetAfPt(obj, 0, 0);
  244.   SetWrMsk(obj, 0xff);
  245.   /* Gross hack starts here */
  246.   l = obj->Layer;
  247.   obj->Layer = 0;
  248.   /* Stops */
  249.   RectFill(obj, msg->bounds.MinX, msg->bounds.MinY,
  250.        msg->bounds.MaxX, msg->bounds.MaxY);
  251.   /* Starts again */
  252.   obj->Layer = l;
  253.   /* And finally dies */
  254.  
  255.   return 0;
  256. }
  257.  
  258. static void clear_window(void)
  259. {
  260.   SetAPen(emacs_win->RPort, background);
  261.   RectFill(emacs_win->RPort, emacs_win->BorderLeft, emacs_win->BorderTop,
  262.        emacs_win->Width - emacs_win->BorderRight - 1,
  263.        emacs_win->Height - emacs_win->BorderBottom - 1);
  264. }
  265.  
  266. static int make_reset_string(void)
  267. {
  268.   sprintf(reset_string, CONSOLE_RESET, foreground, background, background);
  269. }
  270.  
  271. void reset_window(void)
  272. {
  273.   make_reset_string();
  274.   if (emacs_win)
  275.     {
  276.       screen_puts (reset_string, strlen(reset_string));
  277.       clear_window();
  278.       amiga_change_size ();
  279.     }
  280. }
  281.  
  282. static void close_app_win(void)
  283. {
  284.   if (emacs_app_win)
  285.     {
  286.       struct AppMessage *msg;
  287.  
  288.       RemoveAppWindow(emacs_app_win); /* What can I do if it fails ?! */
  289.       while (msg = (struct AppMessage *)GetMsg(wbport)) ReplyMsg(msg);
  290.     }
  291. }
  292.  
  293. static int close_emacs_window(void)
  294. {
  295.   close_app_win();
  296.   inputsig &= ~(1L << emacs_win->UserPort->mp_SigBit);
  297.   _device_close(emacs_console);
  298.   if(emacs_win)
  299.     {
  300.       /* put title back the way it should be   -ch3/19/93. */
  301.       ShowTitle(emacs_win->WScreen, !emacs_backdrop);
  302.     }
  303.   CloseWindow(emacs_win);
  304.   emacs_console = 0;
  305.   emacs_win = 0;
  306.   ConsoleDevice = 0;
  307. }
  308.  
  309. /* We need this function becuase we do not always have the string
  310.  * for the screen we opened on. for example LockPubScreen(NULL);
  311.  * This function will get the name by looping through all public
  312.  * screens looking for the one that matches ours. -ch3/20/93 */
  313.  
  314. char *get_screen_name(struct Screen *this, char *namebuf)
  315. {
  316.   struct PubScreenNode *pubscreens =
  317.     (struct PubScreenNode *)LockPubScreenList()->lh_Head;
  318.  
  319.   while (pubscreens->psn_Node.ln_Succ)
  320.     {
  321.       if (pubscreens->psn_Screen == this)
  322.     {
  323.       strcpy(namebuf, pubscreens->psn_Node.ln_Name);
  324.       UnlockPubScreenList();
  325.       return namebuf;
  326.     }
  327.       pubscreens = (struct PubScreenNode *)pubscreens->psn_Node.ln_Succ;
  328.     }
  329.   /* Failed to find screen */
  330.   namebuf[0] = '\0';
  331.   UnlockPubScreenList();
  332.  
  333.   return 0;
  334. }
  335.  
  336. /* added two parameters to eliminate the need for the global
  337.  * which was causing some unwanted effect (bugs). -ch3/19/93 */
  338.  
  339. static enum { ok, no_screen, no_window }
  340. open_emacs_window(UWORD x, UWORD y, UWORD w, UWORD h, int backdrop,
  341.           char *pubscreen_name)
  342.      /* Open or reopen emacs window */
  343. {
  344.   WORD minw, minh;
  345.   struct Screen *new_screen;
  346.   struct Window *new_win;
  347.   struct IOStdReq *new_console;
  348.   int no_backdrop = !backdrop;
  349.  
  350.   new_screen = LockPubScreen(pubscreen_name);
  351.  
  352.   if (!new_screen)
  353.     return no_screen;
  354.  
  355.   /* removed newwindow structure, and added as tag
  356.    * items so that we can change them easier. -ch3/16/93. */
  357.  
  358.   new_win = OpenWindowTags(0, WA_Left, x, WA_Top, y,
  359.                   WA_Width, w, WA_Height, h,    /* Static items */
  360.                   WA_AutoAdjust, 1, WA_NewLookMenus, 1,
  361.                   WA_IDCMP, IDCMP_CLOSEWINDOW | IDCMP_RAWKEY |
  362.                             IDCMP_MOUSEBUTTONS| IDCMP_NEWSIZE |
  363.                             IDCMP_MENUPICK | IDCMP_MENUHELP,
  364.                   WA_PubScreen, new_screen,
  365.                   WA_BackFill, &background_hook,
  366.                   WA_MenuHelp, 1, WA_Activate, 1,
  367.                   WA_SimpleRefresh, 1,
  368.                   WA_MaxWidth, -1, WA_MaxHeight, -1,
  369.                   WA_Backdrop, backdrop,    /* changing items */
  370.                   WA_Borderless, backdrop,
  371.                   WA_CloseGadget, no_backdrop,
  372.                   WA_SizeGadget, no_backdrop,
  373.                   WA_DragBar, no_backdrop,
  374.                   WA_DepthGadget, no_backdrop,
  375.                   WA_Title, no_backdrop ?
  376.                    "GNU Emacs 18.59, Amiga port "VERS : 0,
  377.                               TAG_END);
  378.  
  379.   UnlockPubScreen(0L, new_screen);
  380.  
  381.   if (new_win)
  382.     {
  383.       /* if emacs_backdrop then the screen title will show BEHIND the window
  384.      -ch3/16/93. */
  385.       ShowTitle(new_screen, !emacs_backdrop);
  386.       SetFont(new_win->RPort, font);
  387.  
  388.       if (set_min_size(new_win, font, &minw, &minh) &&
  389.       (new_console = (struct IOStdReq *)
  390.        _device_open("console.device", CONU_CHARMAP, CONFLAG_NODRAW_ON_NEWSIZE,
  391.             (APTR)new_win, sizeof(*new_win),
  392.             sizeof(struct IOStdReq))))
  393.     {
  394.       inputsig |= 1L << new_win->UserPort->mp_SigBit;
  395.       ConsoleDevice = (struct Library *)new_console->io_Device;
  396.       emacs_app_win = AddAppWindowA(0, 0, new_win, wbport, 0);
  397.  
  398.       /* Copy the info into permanent storage */
  399.       emacs_win = new_win;
  400.       emacs_console = new_console;
  401.  
  402.       /* fetch the name of the current screen -ch3/19/93 */
  403.       emacs_screen_name = get_screen_name(emacs_win->WScreen,
  404.                           emacs_screen_name_storage);
  405.  
  406.       emacs_backdrop = backdrop;
  407.  
  408.       reset_window();
  409.  
  410.       return ok;
  411.     }
  412.       CloseWindow(new_win);
  413.     }
  414.   return no_window;
  415. }
  416.  
  417. void force_window(void)
  418. {
  419.   if (!emacs_win && !emacs_iconified)
  420.     {
  421.       if (open_emacs_window(emacs_x, emacs_y, emacs_w, emacs_h, emacs_backdrop,
  422.                 emacs_screen_name) != ok)
  423.     {
  424.       /* Try to return to defaults (Workbench, etc) */
  425.       if (open_emacs_window(0, 0, 640, 200, 0, 0) != ok)
  426.           _fail("I've lost my window ! Exiting.");
  427.     }
  428.       resume_menus();
  429.     }
  430. }
  431.  
  432. /* returns:
  433.  *    -2 if msg is not class RAWKEY
  434.  *    same as RawKeyConvert otherwise:
  435.  *    buffer length if <= kbsize
  436.  *    -1 else
  437.  */
  438. static DeadKeyConvert(struct IntuiMessage *msg, UBYTE *kbuffer, int kbsize,
  439.               struct KeyMap *kmap)
  440. {
  441.   static struct InputEvent ievent = {0, IECLASS_RAWKEY, 0, 0, 0};
  442.   int extra = 0, res;
  443.  
  444.   if (msg->Class != RAWKEY) return (-2);
  445.  
  446.   /* Do some keymapping ourselves to make emacs users happy */
  447.  
  448.   /* Ctrl-space becomes Ctrl-@ */
  449.   if (msg->Code == 0x40 && msg->Qualifier & CONTROL_MASK)
  450.     {
  451.       *kbuffer = 0;
  452.       return 1;
  453.     }
  454.   /* Backspace becomes DEL */
  455.   if (msg->Code == 0x41 && amiga_remap_bsdel)
  456.     {
  457.       *kbuffer = 0177;
  458.       return 1;
  459.     }
  460.   /* And DEL becomes CTRL-D */
  461.   if (msg->Code == 0x46 && amiga_remap_bsdel)
  462.     {
  463.       *kbuffer = 04;
  464.       return 1;
  465.     }
  466.   /* Stick numeric pad prefix in front of numeric keypad chars */
  467.   if (msg->Qualifier & IEQUALIFIER_NUMERICPAD && amiga_remap_numeric_keypad)
  468.     {
  469.       *kbuffer++ = 'x' & 037;
  470.       *kbuffer++ = '^' & 037;
  471.       *kbuffer++ = 'K';
  472.       kbsize -= 3;
  473.       extra = 3;
  474.     }
  475.  
  476.   /* pack input event */
  477.   ievent.ie_Code = msg->Code;
  478.  
  479.   /* Ignore meta in decoding keys */
  480.   ievent.ie_Qualifier = msg->Qualifier & ~META_MASK;
  481.  
  482.   /* get previous codes from location pointed to by IAddress
  483.    *  this pointer is valid until IntuiMessage is replied.
  484.    */
  485.   ievent.ie_position.ie_addr = *((APTR *)msg->IAddress);
  486.   ievent.ie_position.ie_dead.ie_prev1DownQual &= ~META_MASK;
  487.   ievent.ie_position.ie_dead.ie_prev2DownQual &= ~META_MASK;
  488.  
  489.   res = RawKeyConvert(&ievent, kbuffer, kbsize, kmap);
  490.   return res ? res + extra : 0;
  491. }
  492.  
  493. void add_wbevent(struct WBArg *wbarg)
  494. {
  495.   char filename[256];
  496.  
  497.   if (wbarg->wa_Lock && NameFromLock(wbarg->wa_Lock, filename, 256))
  498.     {
  499.       struct wbevent *event;
  500.  
  501.       if (wbarg->wa_Name) AddPart(filename, wbarg->wa_Name, 256);
  502.       if (event = (struct wbevent *)malloc(offsetof(struct wbevent, file) +
  503.                        strlen(filename) + 1))
  504.     {
  505.       event->next = wbevents;
  506.       strcpy(event->file, filename);
  507.       wbevents = event;
  508.     }
  509.     }
  510. }
  511.  
  512. void check_window(int force)
  513. {
  514.   ULONG class;
  515.   USHORT code, qualifier;
  516.   UWORD mx, my;
  517.   unsigned char buf[32];
  518.   int buflen, deiconify, i;
  519.   struct IntuiMessage *msg;
  520.   int mouse_event = FALSE, wb_event = FALSE;
  521.   struct AppMessage *amsg;
  522.  
  523.   force_window();
  524.  
  525.   if (emacs_win)
  526.     while (msg = (struct IntuiMessage *)GetMsg(emacs_win->UserPort))
  527.       {
  528.     class = msg->Class;
  529.     code = msg->Code;
  530.     qualifier = msg->Qualifier;
  531.     mx = msg->MouseX; my = msg->MouseY;
  532.     buflen = DeadKeyConvert(msg, buf, 32, 0);
  533.     ReplyMsg(msg);
  534.  
  535.     switch (class)
  536.       {
  537.       case IDCMP_CLOSEWINDOW: {
  538.         enque(030, FALSE); enque(03, FALSE); /* ^X^C */
  539.         break;
  540.       }
  541.       case IDCMP_RAWKEY: {
  542.         if (buflen > 0)
  543.           {
  544.         unsigned char *sbuf = buf;
  545.         int meta = qualifier & META_MASK;
  546.  
  547.         /* Don't set META on CSI */
  548.         do enque(*sbuf++, meta); while (--buflen);
  549.           }
  550.         break;
  551.       }
  552.       case IDCMP_NEWSIZE: amiga_change_size(); break;
  553.       case IDCMP_MENUPICK: case IDCMP_MENUHELP:
  554.         if (code == MENUNULL) break; /* else fall through */
  555.       case IDCMP_MOUSEBUTTONS: {
  556.         mouse_event = TRUE;
  557.         if (event_num == EVENTSIZE) break;
  558.  
  559.         events[event_in].class = class;
  560.         events[event_in].code = code;
  561.         events[event_in].qual = qualifier;
  562.         events[event_in].x = mx;
  563.         events[event_in].y = my;
  564.         event_num++;
  565.         event_in = (event_in + 1) % EVENTSIZE;
  566.  
  567.         break;
  568.       }
  569.       }
  570.       }
  571.   /* Handle App requests */
  572.   while (amsg = (struct AppMessage *)GetMsg(wbport))
  573.     {
  574.       /* Add an event for all these files */
  575.       for (i = 0; i < amsg->am_NumArgs; i++) add_wbevent(amsg->am_ArgList + i);
  576.       wb_event = TRUE;
  577.       /* Reply to the message, and deiconify if was icon */
  578.       deiconify = amsg->am_NumArgs == 0;
  579.       ReplyMsg(amsg);
  580.       if (deiconify && emacs_icon)
  581.     /* Reopen window */
  582.     if (open_emacs_window(emacs_x, emacs_y, emacs_w, emacs_h, emacs_backdrop,
  583.                   emacs_screen_name) == ok)
  584.       {
  585.         resume_menus();
  586.         RemoveAppIcon(emacs_icon);
  587.         emacs_icon = 0;
  588.         emacs_iconified = 0;
  589.       }
  590.     }
  591.  
  592.   if (amiga_mouse_initialized && (force && event_num > 0 || mouse_event))
  593.     {
  594.       enque(AMIGASEQ, FALSE); enque('M', FALSE);
  595.     }
  596.   if (amiga_wb_initialized && (force && wbevents || wb_event))
  597.     {
  598.       enque(AMIGASEQ, FALSE); enque('W', FALSE);
  599.     }
  600. }
  601.  
  602. void setup_intchar(char intchar)
  603. {
  604.   char cqbuf[2];
  605.  
  606.   if (MapANSI(&intchar, 1, cqbuf, 1, 0) == 1)
  607.     {
  608.       intkey_code = cqbuf[0];
  609.       intkey_qualifier = cqbuf[1];
  610.     }
  611.   else
  612.     {
  613.       /* Default is CTRL-G in usa0 keymap */
  614.       intkey_code = 0x24;
  615.       intkey_qualifier = IEQUALIFIER_CONTROL;
  616.     }
  617. }
  618.  
  619. /* Hack to detect interrupt char as soon as it is pressed */
  620. /* __interrupt disables stack checking.  -ch3/19/93.*/
  621. static long __saveds __interrupt __asm
  622. int_handler(register __a0 struct InputEvent *ev)
  623. {
  624.   struct InputEvent *ep, *laste;
  625.   static struct InputEvent retkey;
  626.   ULONG lock = LockIBase(0);
  627.  
  628.   if (emacs_win && IntuitionBase->ActiveWindow == emacs_win)
  629.     {
  630.       laste = 0;
  631.  
  632.       /* run down the list of events to see if they pressed the magic key */
  633.       for (ep = ev; ep; laste = ep, ep = ep->ie_NextEvent)
  634.     if (ep->ie_Class == IECLASS_RAWKEY &&
  635.         (ep->ie_Qualifier & 0xff) == intkey_qualifier &&
  636.         ep->ie_Code == intkey_code)
  637.       {
  638.         /* Remove this key from input sequence */
  639.         if (laste) laste->ie_NextEvent = ep->ie_NextEvent;
  640.         else ev = ep->ie_NextEvent;
  641.  
  642.         Vquit_flag = Qt;
  643.         Signal(_us, SIGBREAKF_CTRL_C);
  644.       }
  645.     }
  646.   UnlockIBase(lock);
  647.  
  648.   /* pass on the pointer to the event */
  649.   return (long)ev;
  650. }
  651.  
  652. DEFUN ("amiga-mouse-events", Famiga_mouse_events, Samiga_mouse_events, 0, 0, 0,
  653.        "Return number of pending mouse events from Intuition.")
  654.      ()
  655. {
  656.   register Lisp_Object tem;
  657.  
  658.   check_intuition ();
  659.  
  660.   XSET (tem, Lisp_Int, event_num);
  661.  
  662.   return tem;
  663. }
  664.  
  665. DEFUN ("amiga-proc-mouse-event", Famiga_proc_mouse_event, Samiga_proc_mouse_event,
  666.        0, 0, 0,
  667.        "Pulls a mouse event out of the mouse event buffer and dispatches\n\
  668. the appropriate function to act upon this event.")
  669. ()
  670. {
  671.   register Lisp_Object mouse_cmd;
  672.   register char com_letter;
  673.   register char key_mask;
  674.   register Lisp_Object tempx;
  675.   register Lisp_Object tempy;
  676.   extern Lisp_Object get_keyelt ();
  677.   extern int meta_prefix_char;
  678.   struct event *ev;
  679.   int posx, posy;
  680.  
  681.   check_intuition ();
  682.  
  683.   if (event_num) {
  684.     ev = &events[event_out];
  685.     event_out = (event_out + 1) % EVENTSIZE;
  686.     event_num--;
  687.     if (ev->class == MOUSEBUTTONS)
  688.       {
  689.     switch (ev->code)
  690.       {
  691.       case SELECTDOWN: com_letter = 2; break;
  692.       case SELECTUP: com_letter = 6; break;
  693.       case MIDDLEDOWN: com_letter = 1; break;
  694.       case MIDDLEUP: com_letter = 5; break;
  695.       case MENUDOWN: com_letter = 0; break;
  696.       case MENUUP: com_letter = 4; break;
  697.       default: com_letter = 3; break;
  698.       }
  699.     posx = amiga_pos_x(ev->x);
  700.     posy = amiga_pos_y(ev->y);
  701.     XSET (tempx, Lisp_Int, min (screen_width-1, max (0, posx)));
  702.     XSET (tempy, Lisp_Int, min (screen_height-1, max (0, posy)));
  703.       }
  704.     else
  705.       {
  706.     /* Must be Menu Pick or Help */
  707.     com_letter = ev->class == IDCMP_MENUPICK ? 3 : 7;
  708.  
  709.     /* The parameters passed describe the selected item */
  710.     XSET (tempx, Lisp_Int, MENUNUM(ev->code));
  711.     XSET (tempy, Lisp_Int, ITEMNUM(ev->code));
  712.       }
  713.     if (ev->qual & META_MASK) com_letter |= 0x20;
  714.     if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
  715.     if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
  716.  
  717.     Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  718.     Vamiga_mouse_item = make_number (com_letter);
  719.     mouse_cmd = get_keyelt (access_keymap (MouseMap, com_letter));
  720.     if (NULL (mouse_cmd)) {
  721.       bell ();
  722.       Vamiga_mouse_pos = Qnil;
  723.     }
  724.     else return call1 (mouse_cmd, Vamiga_mouse_pos);
  725.   }
  726.   return Qnil;
  727. }
  728.  
  729. DEFUN ("amiga-get-mouse-event", Famiga_get_mouse_event, Samiga_get_mouse_event,
  730.        1, 1, 0,
  731.        "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
  732. ARG non-nil means return nil immediately if no pending event;\n\
  733. otherwise, wait for an event.")
  734. (arg)
  735. Lisp_Object arg;
  736. {
  737.   register char com_letter;
  738.   register char key_mask;
  739.  
  740.   register Lisp_Object tempx;
  741.   register Lisp_Object tempy;
  742.   struct event *ev;
  743.   int posx, posy;
  744.  
  745.   check_intuition ();
  746.  
  747.   if (NULL (arg))
  748.     {
  749.       amiga_consume_input();
  750.       while (!event_num)
  751.     {
  752.       int rfds = 1;
  753.  
  754.       select(1, &rfds, 0, 0, 0);
  755.       amiga_consume_input();
  756.     }
  757.     }
  758.   /*** ??? Surely you don't mean to busy wait??? */
  759.  
  760.   if (event_num) {
  761.     ev = &events[event_out];
  762.     event_out = (event_out + 1) % EVENTSIZE;
  763.     event_num--;
  764.     switch (ev->code)
  765.       {
  766.       case SELECTDOWN: com_letter = 2; break;
  767.       case SELECTUP: com_letter = 6; break;
  768.       case MIDDLEDOWN: com_letter = 1; break;
  769.       case MIDDLEUP: com_letter = 5; break;
  770.       case MENUDOWN: com_letter = 0; break;
  771.       case MENUUP: com_letter = 4; break;
  772.       default: com_letter = 3; break;
  773.       }
  774.     if (ev->qual & META_MASK) com_letter |= 0x20;
  775.     if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
  776.     if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
  777.  
  778.     posx = amiga_pos_x(ev->x);
  779.     posy = amiga_pos_y(ev->y);
  780.     XSET (tempx, Lisp_Int, min (screen_width-1, max (0, posx)));
  781.     XSET (tempy, Lisp_Int, min (screen_height-1, max (0, posy)));
  782.  
  783.     Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  784.     Vamiga_mouse_item = make_number (com_letter);
  785.     return Fcons (com_letter, Fcons (Vamiga_mouse_pos, Qnil));
  786.   }
  787.   return Qnil;
  788. }
  789.  
  790. DEFUN ("amiga-get-wb-event", Famiga_get_wb_event, Samiga_get_wb_event,
  791.        1, 1, 0,
  792.        "Get next Workbench event out of workbench event buffer (a file name).\n\
  793. ARG non-nil means return nil immediately if no pending event;\n\
  794. otherwise, wait for an event.")
  795. (arg)
  796. Lisp_Object arg;
  797. {
  798.   Lisp_Object file;
  799.   struct wbevent *ev;
  800.  
  801.   check_intuition ();
  802.  
  803.   if (NULL (arg))
  804.     {
  805.       amiga_consume_input();
  806.       while (!wbevents)
  807.     {
  808.       int rfds = 1;
  809.  
  810.       select(1, &rfds, 0, 0, 0);
  811.       amiga_consume_input();
  812.     }
  813.     }
  814.   /*** ??? Surely you don't mean to busy wait??? */
  815.  
  816.   if (wbevents) {
  817.     file = build_string(wbevents->file);
  818.     ev = wbevents;
  819.     wbevents = wbevents->next;
  820.     free(ev);
  821.     return file;
  822.   }
  823.   return Qnil;
  824. }
  825.  
  826. DEFUN("amiga-set-foreground-color", Famiga_set_foreground_color,
  827.       Samiga_set_foreground_color, 1, 1, "nPen number: ",
  828.       "Use PEN as foreground color")
  829.      (pen)
  830. {
  831.   int fg;
  832.  
  833.   check_intuition();
  834.   CHECK_NUMBER(pen, 0);
  835.  
  836.   fg = XUINT (pen);
  837.   if (pen > 7) error("Pen colors must be between 0 & 7");
  838.   foreground = fg;
  839.   reset_window();
  840.   return Qnil;
  841. }
  842.  
  843. DEFUN("amiga-set-background-color", Famiga_set_background_color,
  844.       Samiga_set_background_color, 1, 1, "nPen number: ",
  845.       "Use PEN as background color")
  846.      (pen)
  847. {
  848.   int bg;
  849.  
  850.   check_intuition();
  851.   CHECK_NUMBER(pen, 0);
  852.  
  853.   bg = XUINT (pen);
  854.   if (pen > 7) error("Pen colors must be between 0 & 7");
  855.   background = bg;
  856.   reset_window();
  857.   return Qnil;
  858. }
  859.  
  860. DEFUN("amiga-set-inverse-fill-pen", Famiga_set_inverse_fill_pen,
  861.       Samiga_set_inverse_fill_pen, 1, 1, "nPen number: ",
  862.       "Use PEN's color for inverse fills (0-7 or 8 for reverse)")
  863.      (pen)
  864. {
  865.   int ifp = 8;
  866.  
  867.   check_intuition();
  868.   CHECK_NUMBER(pen, 0);
  869.  
  870.   ifp = XUINT (pen);
  871.   if (pen > 8)
  872.     error("choices are from 0 to 8");
  873.   inverse_fill_pen = ifp;
  874.   reset_window();
  875.   return Qnil;
  876. }
  877.  
  878. DEFUN("amiga-set-inverse-text-pen", Famiga_set_inverse_text_pen,
  879.       Samiga_set_inverse_text_pen, 1, 1, "nPen number: ",
  880.       "Use PEN's color for inverse fills (0-7 or 8 for reverse)")
  881.      (pen)
  882. {
  883.   int itp = 8;
  884.  
  885.   check_intuition();
  886.   CHECK_NUMBER(pen, 0);
  887.  
  888.   itp = XUINT (pen);
  889.   if (pen > 8)
  890.     error("choices are from 0 to 8");
  891.   inverse_text_pen = itp;
  892.   reset_window();
  893.   return Qnil;
  894. }
  895.  
  896. DEFUN("amiga-set-font", Famiga_set_font, Samiga_set_font, 2, 2,
  897.       "sFont: \n\
  898. nSize: ",
  899.       "Set font used for window to FONT with given HEIGHT.\n\
  900. The font used must be non-proportional.")
  901. (wfont, height)
  902. {
  903.   struct TextAttr attr;
  904.   struct TextFont *newfont;
  905.   char *fname;
  906.   struct Lisp_String *fstr;
  907.   WORD minw, minh, oldmw, oldmh;
  908.  
  909.   CHECK_STRING (wfont, 0);
  910.   CHECK_NUMBER (height, 0);
  911.  
  912.   check_intuition();
  913.  
  914.   fstr = XSTRING (wfont);
  915.   fname = (char *)alloca (fstr->size + 6);
  916.   strcpy (fname, fstr->data);
  917.   strcat (fname, ".font");
  918.   attr.ta_Name = fname;
  919.   attr.ta_YSize = XFASTINT (height);
  920.   attr.ta_Style = 0;
  921.   attr.ta_Flags = 0;
  922.   newfont = OpenDiskFont (&attr);
  923.  
  924.   if (!newfont)
  925.     error ("Font %s %d not found", fstr->data, XFASTINT (height));
  926.   if (newfont->tf_Flags & FPF_PROPORTIONAL)
  927.     {
  928.       CloseFont(newfont);
  929.       error ("Font %s %d is proportional", fstr->data, XFASTINT (height));
  930.     }
  931.  
  932.   if (emacs_win)
  933.     {
  934.       if (!set_min_size(emacs_win, newfont, &minw, &minh))
  935.     {
  936.       CloseFont(newfont);
  937.       if (!set_min_size(emacs_win, font, &oldmw, &oldmh))
  938.         _fail("Failed to restore old font, exiting.");
  939.       error("Window is too small for this font, need at least %d(w) by %d(h)",
  940.         minw, minh);
  941.     }
  942.       SetFont(emacs_win->RPort, newfont);
  943.     }
  944.   if (font_opened) CloseFont(font);
  945.   font_opened = TRUE;
  946.   font = newfont;
  947.   reset_window();
  948.   return Qnil;
  949. }
  950.  
  951. DEFUN("amiga-set-geometry", Famiga_set_geometry, Samiga_set_geometry, 4, MANY, 0,
  952.       "Set Emacs window geometry and screen.\n\
  953. First 4 parameters are the (X,Y) position of the top-left corner of the window\n\
  954. and its WIDTH and HEIGHT. These must be big enough for an 11x4 characters window.\n\
  955. If nil is given for any of these, that means to keep the same value as before.\n\
  956. The optional argument SCREEN specifies which screen to use, nil stands for the\n\
  957. same screen as the window is on, t stands for the default public screen (normally\n\
  958. the Workbench), a string specifies a given public screen.\n\
  959. If optional argument BACKDROP is t, a backdrop window is used.")
  960.   (nargs, args)
  961.     int nargs;
  962.     Lisp_Object *args;
  963. {
  964.   Lisp_Object x, y, w, h, scr = Qnil, backdrop = Qnil;
  965.   int opened;
  966.   WORD tempx, tempy, tempw, temph;
  967.   char *screen_name;
  968.   int use_backdrop;
  969.  
  970.   if (nargs > 6) error("Too many arguments to amiga-set-geometry");
  971.   x = args[0]; y = args[1]; w = args[2]; h = args[3];
  972.   if (nargs > 4)
  973.     {
  974.       scr = args[4];
  975.       if (nargs > 5) backdrop = args[5];
  976.     }
  977.  
  978.   check_intuition();
  979.  
  980.   if (!NULL (x))
  981.     {
  982.       CHECK_NUMBER(x, 0);
  983.       tempx = XUINT(x);
  984.     }
  985.   else tempx = EMACS_X();
  986.   if (!NULL (y))
  987.     {
  988.       CHECK_NUMBER(y, 0);
  989.       tempy = XUINT(y);
  990.     }
  991.   else tempy = EMACS_Y();
  992.   if (!NULL (w))
  993.     {
  994.       CHECK_NUMBER(w, 0);
  995.       tempw = XUINT(w);
  996.     }
  997.   else tempw = EMACS_W();
  998.   if (!NULL (h))
  999.     {
  1000.       CHECK_NUMBER(h, 0);
  1001.       temph = XUINT(h);
  1002.     }
  1003.   else temph = EMACS_H();
  1004.  
  1005.   use_backdrop = !NULL(backdrop);
  1006.  
  1007.   if (scr == Qt) screen_name = 0; /* set to zero for def. */
  1008.   else if (!NULL (scr))
  1009.     {
  1010.       CHECK_STRING (scr, 0);
  1011.       screen_name = XSTRING (scr)->data;
  1012.     }
  1013.   else screen_name = emacs_screen_name;
  1014.  
  1015.   if (emacs_win)
  1016.     {
  1017.       struct Window *old_win = emacs_win;
  1018.       struct IOStdReq *old_console = emacs_console;
  1019.  
  1020.       suspend_menus();
  1021.       opened = open_emacs_window(tempx, tempy, tempw, temph, use_backdrop,
  1022.                  screen_name);
  1023.       if (opened != ok)
  1024.     {
  1025.       resume_menus();
  1026.  
  1027.       if (opened == no_window) error("Failed to open desired window");
  1028.       else if (screen_name)
  1029.         error("Unknown public screen %s", screen_name);
  1030.       else error("The default screen wasn't found !?");
  1031.     }
  1032.  
  1033.       _device_close(old_console);
  1034.       CloseWindow(old_win);
  1035.       if (!resume_menus()) error("Failed to recover menus (No memory?)");
  1036.     }
  1037.   else /* No window, set defaults */
  1038.     {
  1039.       emacs_screen_name = screen_name;
  1040.       if (screen_name)
  1041.     {
  1042.       emacs_screen_name_storage[MAXPUBSCREENNAME] = '\0';
  1043.       strncpy(emacs_screen_name_storage, screen_name, MAXPUBSCREENNAME);
  1044.     }
  1045.       emacs_x = tempx;
  1046.       emacs_y = tempy;
  1047.       emacs_w = tempw;
  1048.       emacs_h = temph;
  1049.       emacs_backdrop = use_backdrop;
  1050.     }
  1051.   return Qnil;
  1052. }
  1053.  
  1054.  
  1055. /* The next 2 functions are very usefull for writing
  1056.  * arexx/lisp functions that interact with other programs
  1057.  * that will be sharing the same screen.  -ch3/19/93. */
  1058.  
  1059. DEFUN("amiga-get-window-geometry",
  1060.       Famiga_get_window_geometry, Samiga_get_window_geometry, 0, 0, 0,
  1061.       "Get Emacs window geometry.\n\
  1062. a list returned is of the form:  (iconified x y width height backdrop)\n\
  1063. where x, y, width, height are integers, backdrop is t or nil and iconified\n\
  1064. is t if the window is iconified and nil otherwise")
  1065. ()
  1066. {
  1067.   Lisp_Object x, y, w, h, b, i;
  1068.  
  1069.   XSET(x, Lisp_Int, EMACS_X());
  1070.   XSET(y, Lisp_Int, EMACS_Y());
  1071.   XSET(w, Lisp_Int, EMACS_W());
  1072.   XSET(h, Lisp_Int, EMACS_H());
  1073.   b = emacs_backdrop ? Qt : Qnil;
  1074.   i = emacs_iconified ? Qt : Qnil;
  1075.  
  1076.   return Fcons(i, Fcons(x, Fcons(y, Fcons(w, Fcons(h, Fcons(b, Qnil))))));
  1077. }
  1078.  
  1079. DEFUN("amiga-get-screen-geometry",
  1080.       Famiga_get_screen_geometry, Samiga_get_screen_geometry, 0, 0, 0,
  1081.       "Get geometry of the screen emacs window resides on.\n\
  1082. a list returned is of the form:  (name x y width height)\n\
  1083. where name is a string, x, y, width, height are integers.\n\
  1084. Only the public screen name is returned if the window is not currently open.\n\
  1085. In this last case, the name may be nil if the window will be opened on the\n\
  1086. default public screen.")
  1087. ()
  1088. {
  1089.   Lisp_Object name;
  1090.  
  1091.   if (emacs_screen_name) name = Qnil;
  1092.   else name = build_string(emacs_screen_name);
  1093.  
  1094.   if(emacs_win)
  1095.     {
  1096.       struct Screen *s = emacs_win->WScreen;
  1097.       Lisp_Object x, y, w, h;
  1098.  
  1099.       XSET(x, Lisp_Int, s->LeftEdge);
  1100.       XSET(y, Lisp_Int, s->TopEdge);
  1101.       XSET(w, Lisp_Int, s->Width);
  1102.       XSET(h, Lisp_Int, s->Height);
  1103.  
  1104.       return Fcons(name, Fcons(x, Fcons(y, Fcons(w, Fcons(h, Qnil)))));
  1105.     }
  1106.   return Fcons(name, Qnil);
  1107. }
  1108.  
  1109. DEFUN("amiga-iconify", Famiga_iconify, Samiga_iconify, 0, 0, "",
  1110.       "Toggle the emacs iconification state.")
  1111. ()
  1112. {
  1113.   check_intuition();
  1114.  
  1115.   if (emacs_iconified)
  1116.     {
  1117.       /* Deiconify */
  1118.  
  1119.       /* Reopen window */
  1120.       if (open_emacs_window(emacs_x, emacs_y, emacs_w, emacs_h, emacs_backdrop,
  1121.                 emacs_screen_name) != ok)
  1122.     error("Failed to deiconify (No memory?)");
  1123.       resume_menus();
  1124.  
  1125.       RemoveAppIcon(emacs_icon);
  1126.       emacs_icon = 0;
  1127.       emacs_iconified = 0;
  1128.     }
  1129.   else
  1130.     if (emacs_icon = AddAppIconA(0, 0, "Emacs", wbport, 0, &emacs_icon_object, 0))
  1131.       {
  1132.     if (emacs_win)
  1133.       {
  1134.         /* Close window */
  1135.         emacs_x = EMACS_X(); emacs_y = EMACS_Y();
  1136.         emacs_w = EMACS_W(); emacs_h = EMACS_H();
  1137.         suspend_menus();
  1138.         close_emacs_window();
  1139.       }
  1140.     emacs_iconified = 1;
  1141.       }
  1142.     else error("Iconify attempt failed\n");
  1143.  
  1144.   return Qnil;
  1145. }
  1146.  
  1147. DEFUN("amiga-set-icon-pos", Famiga_set_icon_pos, Samiga_set_icon_pos, 2, 2,
  1148. "nX position: \n\
  1149. nY position: ",
  1150.       "Set the X Y position of the icon for emacs when iconified.")
  1151.   (Lisp_Object x, Lisp_Object y)
  1152. {
  1153.   long xpos, ypos;
  1154.  
  1155.   if (NULL (x)) emacs_icon_object.do_CurrentX = NO_ICON_POSITION;
  1156.   else
  1157.     {
  1158.       CHECK_NUMBER (x, 0);
  1159.       emacs_icon_object.do_CurrentX = XINT(x);
  1160.     }
  1161.   if (NULL (y)) emacs_icon_object.do_CurrentY = NO_ICON_POSITION;
  1162.   else
  1163.     {
  1164.       CHECK_NUMBER (y, 0);
  1165.       emacs_icon_object.do_CurrentY = XINT(y);
  1166.     }
  1167.  
  1168.   return Qnil;
  1169. }
  1170.  
  1171. struct EClockVal scount[16], ecount[16];
  1172. long total[16], counting[16], nb[16], susp[16];
  1173.  
  1174. void start_count(int n)
  1175. {
  1176.   nb[n]++;
  1177.   if (counting[n]) printf("Restarted %d\n", n);
  1178.   counting[n] = 1;
  1179.   /*ReadEClock(&scount[n]);*/
  1180. }
  1181.  
  1182. void stop_count(int n)
  1183. {
  1184.   if (counting[n])
  1185.     {
  1186.       /*ReadEClock(&ecount[n]);*/
  1187.       counting[n] = 0;
  1188.  
  1189.       total[n] += ecount[n].ev_lo - scount[n].ev_lo;
  1190.     }
  1191. }
  1192.  
  1193. void suspend_count(int n)
  1194. {
  1195.   if (counting[n] && susp[n]++ == 0)
  1196.     {
  1197.       /*ReadEClock(&ecount[n]);*/
  1198.       total[n] += ecount[n].ev_lo - scount[n].ev_lo;
  1199.     }
  1200. }
  1201.  
  1202. void resume_count(int n)
  1203. {
  1204.   if (counting[n] && --susp[n] == 0) /*ReadEClock(&scount[n])*/;
  1205. }
  1206.  
  1207. disp_counts(void)
  1208. {
  1209.   int i;
  1210.  
  1211.   for (i = 0; i < 16; i++)
  1212.     {
  1213.       printf("%d(%d) ", total[i], nb[i]);
  1214.       total[i] = nb[i] = 0;
  1215.     }
  1216.   printf("\n");
  1217. }
  1218.  
  1219. void screen_puts(char *str, unsigned int len)
  1220. {
  1221.   if (emacs_win)
  1222.     {
  1223.       int i;
  1224.  
  1225.       emacs_console->io_Command = CMD_WRITE;
  1226.       emacs_console->io_Data    = (APTR)str;
  1227.       emacs_console->io_Length  = len;
  1228.  
  1229.       /*    start_count(0);
  1230.         for (i = 1; i <= 6; i++) suspend_count(i);*/
  1231.       DoIO(emacs_console);
  1232.       /*    for (i = 1; i <= 6; i++) resume_count(i);
  1233.         stop_count(0);*/
  1234.     }
  1235. }
  1236.  
  1237. DEFUN ("amiga-activate-window", Famiga_activate_window, Samiga_activate_window, 0, 0, 0,
  1238.        "Makes emacs window the currently active one.")
  1239.      ()
  1240. {
  1241.   if(emacs_win) {
  1242.     ActivateWindow(emacs_win);
  1243.     return Qnil;
  1244.   }
  1245.   error("No window to make active.");
  1246.   return Qnil;
  1247. }
  1248.  
  1249. DEFUN ("amiga-window-to-front", Famiga_window_to_front, Samiga_window_to_front, 0, 0, 0,
  1250.        "Pulls the emacs window to the front (including screen)")
  1251.      ()
  1252. {
  1253.   if(emacs_win) {
  1254.     WindowToFront(emacs_win);
  1255.     ScreenToFront(emacs_win->WScreen);
  1256.     return Qnil;
  1257.   }
  1258.   error("No window to pull to the front.");
  1259.   return Qnil;
  1260. }
  1261.  
  1262. DEFUN ("amiga-window-to-back", Famiga_window_to_back, Samiga_window_to_back, 0, 0, 0,
  1263.        "Pushes the emacs window to the back (including screen)")
  1264.      ()
  1265. {
  1266.   if(emacs_win) {
  1267.     WindowToBack(emacs_win);
  1268.     ScreenToBack(emacs_win->WScreen);
  1269.     return Qnil;
  1270.   }
  1271.   error("No window to push back.");
  1272.   return Qnil;
  1273. }
  1274.  
  1275.  
  1276. void syms_of_amiga_screen(void)
  1277. {
  1278.   DEFVAR_LISP ("amiga-mouse-item", &Vamiga_mouse_item,
  1279.            "Encoded representation of last mouse click, corresponding to\n\
  1280. numerical entries in amiga-mouse-map.");
  1281.   Vamiga_mouse_item = Qnil;
  1282.   DEFVAR_LISP ("amiga-mouse-pos", &Vamiga_mouse_pos,
  1283.            "Current x-y position of mouse by row, column as specified by font.");
  1284.   Vamiga_mouse_pos = Qnil;
  1285.  
  1286.   DEFVAR_BOOL ("amiga-remap-bsdel", &amiga_remap_bsdel,
  1287.            "*If true, map DEL to Ctrl-D and Backspace to DEL. \n\
  1288. This is the most convenient (and default) setting. If nil, don't remap.");
  1289.   amiga_remap_bsdel = 1;
  1290.  
  1291.   DEFVAR_BOOL ("amiga-remap-numeric-keypad", &amiga_remap_numeric_keypad,
  1292.            "*If true, numeric keypad keys are prefixed with C-x C-^ K.\n\
  1293. This enables you to remap them, but causes problems with functions like\n\
  1294. isearch-forward-regexp on some keyboards. Default to true.");
  1295.   amiga_remap_numeric_keypad = 1;
  1296.  
  1297.   DEFVAR_BOOL ("amiga-mouse-initialized", &amiga_mouse_initialized,
  1298.            "Set to true once lisp has been setup to process mouse commands.\n\
  1299. No mouse processing request (C-X C-^ M) will be queued while this is nil.");
  1300.   amiga_mouse_initialized = 0;
  1301.  
  1302.   DEFVAR_BOOL ("amiga-wb-initialized", &amiga_wb_initialized,
  1303.            "Set to true once lisp has been setup to process workbench commands.\n\
  1304. No workbench processing request (C-X C-^ W) will be queued while this is nil.");
  1305.   amiga_mouse_initialized = 0;
  1306.  
  1307.   defsubr (&Samiga_mouse_events);
  1308.   defsubr (&Samiga_proc_mouse_event);
  1309.   defsubr (&Samiga_get_mouse_event);
  1310.   defsubr (&Samiga_get_wb_event);
  1311.   defsubr (&Samiga_set_font);
  1312.   defsubr (&Samiga_set_geometry);
  1313.   defsubr (&Samiga_set_background_color);
  1314.   defsubr (&Samiga_set_foreground_color);
  1315.   defsubr (&Samiga_iconify);
  1316.   defsubr (&Samiga_set_icon_pos);
  1317.  
  1318.   /* New functions  -ch3/19/93. */
  1319.   defsubr (&Samiga_set_inverse_text_pen);
  1320.   defsubr (&Samiga_set_inverse_fill_pen);
  1321.   defsubr (&Samiga_window_to_front);
  1322.   defsubr (&Samiga_window_to_back);
  1323.   defsubr (&Samiga_activate_window);
  1324.   defsubr (&Samiga_get_window_geometry);
  1325.   defsubr (&Samiga_get_screen_geometry);
  1326.  
  1327. }
  1328.  
  1329. void init_amiga_screen(void)
  1330. {
  1331.   event_num = event_in = event_out = 0;
  1332.  
  1333.   if (!((IntuitionBase = (struct IntuitionBase *)
  1334.      OpenLibrary("intuition.library", 37L)) &&
  1335.     (GfxBase = (struct GfxBase *)OpenLibrary("graphics.library", 0L)) &&
  1336.     (DiskfontBase = OpenLibrary("diskfont.library", 0L)) &&
  1337.     (WorkbenchBase = OpenLibrary("workbench.library", 37)) &&
  1338.     (KeymapBase = OpenLibrary("keymap.library", 36)) &&
  1339.     (input_req = (struct IOStdReq *)_device_open("input.device", 0, 0, 0, 0,
  1340.                              sizeof(struct IOStdReq)))))
  1341.     _fail("Need version 2.04 and diskfont.library!");
  1342.  
  1343.   if (!(wbport = CreateMsgPort())) no_memory();
  1344.  
  1345.   /* Add Ctrl-G detector */
  1346.   int_handler_hook.is_Data = 0;
  1347.   int_handler_hook.is_Code = (void *)int_handler;
  1348.   int_handler_hook.is_Node.ln_Pri = 100; /* 100 not 127 is the standard value
  1349.                       * for input stream handlers.  -ch3/19/93. */
  1350.   /* it is standard for interrupts to have names  -ch3/19/93.*/
  1351.   int_handler_hook.is_Node.ln_Name = "GNU Emacs CTRL-G handler";
  1352.   input_req->io_Command = IND_ADDHANDLER;
  1353.   input_req->io_Data = (APTR)&int_handler_hook;
  1354.  
  1355.   /* wasn't checking for error. -ch3/19/93. */
  1356.   if(0 == DoIO(input_req))
  1357.     hooked = TRUE;
  1358.   else
  1359.     {
  1360.       hooked = FALSE;
  1361.       _fail("couldn't get input handler hook for CTRL-G");
  1362.     }
  1363.  
  1364.   inputsig |= 1L << wbport->mp_SigBit;
  1365.  
  1366.   background_hook.h_Entry = (ULONG (*)()) fill_background; /* added cast. */
  1367.   font = GfxBase->DefaultFont;
  1368.  
  1369.   init_amiga_menu();
  1370. }
  1371.  
  1372. void cleanup_amiga_screen(void)
  1373. {
  1374.   if (hooked)
  1375.     {
  1376.       input_req->io_Command = IND_REMHANDLER;
  1377.       input_req->io_Data = (APTR)&int_handler_hook;
  1378.       DoIO(input_req);
  1379.     }
  1380.   close_app_win();
  1381.   if (wbport) DeleteMsgPort(wbport);
  1382.   cleanup_amiga_menu();
  1383.   _device_close(emacs_console);
  1384.   if (emacs_win) CloseWindow(emacs_win);
  1385.   if (font_opened) CloseFont(font);
  1386.   if (IntuitionBase) CloseLibrary(IntuitionBase);
  1387.   if (GfxBase) CloseLibrary(GfxBase);
  1388.   if (DiskfontBase) CloseLibrary(DiskfontBase);
  1389.   if (WorkbenchBase) CloseLibrary(WorkbenchBase);
  1390.   if (KeymapBase) CloseLibrary(KeymapBase);
  1391.   _device_close(input_req);
  1392. }
  1393.