/* pmfns.c -- xfns.c for the OS/2 Presentation Manager
   Copyright (C) 1993 Eberhard Mattes.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs 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 the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include <stdio.h>
#include "config.h"
#include "lisp.h"
#include "pmterm.h"
#include "pmemacs.h"
#include "frame.h"
#include "window.h"
#include "dispextern.h"
#include "keyboard.h"
#include "termhooks.h"

int x_screen_planes;

extern int pm_session_started;

extern Lisp_Object Qheight, Qicon, Qmenu_bar_lines, Qminibuffer, Qname;
extern Lisp_Object Qonly, Qunsplittable, Qunderline, Qwidth;

Lisp_Object Qalt;
Lisp_Object Qalt_modifier;
Lisp_Object Qaltgr_modifier;
Lisp_Object Qbackground_color;
Lisp_Object Qbar;
Lisp_Object Qbox;
Lisp_Object Qcursor_blink;
Lisp_Object Qcursor_type;
Lisp_Object Qdown;
Lisp_Object Qfont;
Lisp_Object Qforeground_color;
Lisp_Object Qframe;
Lisp_Object Qhalftone;
Lisp_Object Qhyper;
Lisp_Object Qleft;
Lisp_Object Qmeta;
Lisp_Object Qmouse_1;
Lisp_Object Qmouse_2;
Lisp_Object Qmouse_3;
Lisp_Object Qmouse_buttons;
Lisp_Object Qnone;
Lisp_Object Qpm_menu_bar;
Lisp_Object Qshortcuts;
Lisp_Object Qsuper;
Lisp_Object Qtop;
Lisp_Object Qvisibility;

Lisp_Object Vpm_color_alist;


void x_set_frame_parameters (struct frame *f, Lisp_Object alist);
void x_set_name (struct frame *f, Lisp_Object name, int explicit);

struct pm_menu_bar_item
{
  struct pm_menu_bar_item *next;
  Lisp_Object event;
  char name[80];
};


void free_pm_menu_bar (struct pm_menu_bar_item *p)
{
  struct pm_menu_bar_item *q;

  while (p)
    {
      q = p->next;
      xfree (p);
      p = q;
    }
}


int pm_menu_bar_changed (FRAME_PTR f)
{
  struct pm_menu_bar_item **pp, *p;
  Lisp_Object tail, el, event, name;

  if (!f->pm_menu_bar)
    return 0;
  pp = &f->pm_menu_bar_items;
  tail = FRAME_MENU_BAR_ITEMS (f);
  while (!NILP (tail))
    {
      p = *pp;
      if (!p)
        break;
      el = Fcar (tail);
      event = Fcar (el);
      name = Fcar (Fcdr (el));
      if (p->event != event)
        break;
      if (strcmp (p->name, XSTRING (name)->data) != 0)
        break;
      tail = Fcdr (tail);
      pp = &p->next;
    }
  if (NILP (tail) && !*pp)
    return 0;
  while (!NILP (tail))
    {
      el = Fcar (tail);
      event = Fcar (el);
      name = Fcar (Fcdr (el));
      if (XTYPE (event) != Lisp_Symbol && XTYPE (event) != Lisp_Int)
        abort ();
      if (XTYPE (name) != Lisp_String)
        abort ();
      p = *pp;
      if (!p)
        {
          p = (struct pm_menu_bar_item *)xmalloc (sizeof (*p));
          p->next = 0;
          *pp = p;
        }
      _strncpy (p->name, XSTRING (name)->data, sizeof (p->name));
      p->event = event;
      tail = Fcdr (tail);
      pp = &p->next;
    }
  free_pm_menu_bar (*pp);
  *pp = 0;
  return 1;
}


int defined_color (char *color, int *color_def)
{
  Lisp_Object tem;
  int r, g, b;

  tem = Fassoc (Fdowncase (build_string (color)), Vpm_color_alist);
  if (CONSP (tem))
    {
      tem = Fcdr (tem);
      if (VECTORP (tem) && XVECTOR (tem)->size == 3
          && INTEGERP (XVECTOR (tem)->contents[0])
          && INTEGERP (XVECTOR (tem)->contents[1])
          && INTEGERP (XVECTOR (tem)->contents[2]))
        {
          r = XINT (XVECTOR (tem)->contents[0]);
          g = XINT (XVECTOR (tem)->contents[1]);
          b = XINT (XVECTOR (tem)->contents[2]);
          if (!((r & ~0xff) || (g & ~0xff) || (b & ~0xff)))
            {
              *color_def = (r << 16) | (g << 8) | b;
              return 1;
            }
        }
    }
  return 0;
}


static void pm_get_framepos (FRAME_PTR f)
{
  pm_request pmr;
  pmd_framepos answer;

  pmr.header.type = PMR_FRAMEPOS;
  pmr.header.frame = (unsigned long)f;
  pm_send (&pmr, sizeof (pmr));
  pm_receive_oob (&answer, sizeof (answer));
  f->display.x->left_pos = answer.left;
  f->display.x->top_pos = answer.top;
}

/* Stolen from xfns.c */

static void
pm_set_menu_bar_lines_1 (window, n)
  Lisp_Object window;
  int n;
{
  for (; !NILP (window); window = XWINDOW (window)->next)
    {
      struct window *w = XWINDOW (window);

      w->top += n;

      if (!NILP (w->vchild))
	pm_set_menu_bar_lines_1 (w->vchild);

      if (!NILP (w->hchild))
	pm_set_menu_bar_lines_1 (w->hchild);
    }
}


static int pm_set_menu_bar_lines (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  int nlines;
  int olines = FRAME_MENU_BAR_LINES (f);

  if (XTYPE (arg) == Lisp_Int)
    nlines = XINT (arg);
  else
    nlines = 0;

  FRAME_MENU_BAR_LINES (f) = nlines;
  pm_set_menu_bar_lines_1 (f->root_window, nlines - olines);
  x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f) + nlines - olines);
  return (1);
}


static int pm_set_pm_menu_bar (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  pm_request pmr;

  if (f->pm_menu_bar && NILP (arg))
    {
      free_pm_menu_bar (f->pm_menu_bar_items);
      f->pm_menu_bar_items = 0;
      pmr.menubar.header.type = PMR_MENUBAR;
      pmr.menubar.header.frame = (unsigned long)f;
      pmr.menubar.menus = 0;
      pmr.menubar.size = 0;
      pm_send (&pmr, sizeof (pmr));
    }
  f->pm_menu_bar = !NILP (arg);
  return (1);
}


static Lisp_Object pm_get_arg (Lisp_Object alist, Lisp_Object param)
{
  Lisp_Object tem;

  tem = Fassq (param, alist);
  if (EQ (tem, Qnil))
    tem = Fassq (param, Vdefault_frame_alist);
  if (EQ (tem, Qnil))
    return Qunbound;
  return Fcdr (tem);
}


/* Record in frame F the specified or default value according to ALIST
   of the parameter named PARAM (a Lisp symbol).  */

static Lisp_Object
pm_default_parameter (f, alist, prop, deflt)
     struct frame *f;
     Lisp_Object alist;
     Lisp_Object prop;
     Lisp_Object deflt;
{
  Lisp_Object tem;

  tem = pm_get_arg (alist, prop);
  if (EQ (tem, Qunbound))
    tem = deflt;
  x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
  return tem;
}


static int pm_set_name (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  char *p1, *p2;
  long n;

  x_set_name (f, arg, 1);
  return (1);
}


static int pm_set_font (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  if (XTYPE (arg) == Lisp_String && XSTRING (arg)->size > 0
      && XSTRING (arg)->size < sizeof (dst->font_name))
    {
      strcpy (dst->font_name, XSTRING (arg)->data);
      return (1);
    }
  return (0);
}


static int pm_set_cursor_type (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  if (EQ (arg, Qbox))
    dst->cursor_type = CURSORTYPE_BOX;
  else if (EQ (arg, Qbar))
    dst->cursor_type = CURSORTYPE_BAR;
  else if (EQ (arg, Qframe))
    dst->cursor_type = CURSORTYPE_FRAME;
  else if (EQ (arg, Qunderline))
    dst->cursor_type = CURSORTYPE_UNDERLINE;
  else if (EQ (arg, Qhalftone))
    dst->cursor_type = CURSORTYPE_HALFTONE;
  else
    return (0);
  return (1);
}


static int pm_set_cursor_blink (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  dst->cursor_blink = (NILP (arg) ? PMR_FALSE : PMR_TRUE);
  return (1);
}


static int pm_set_color (FRAME_PTR f, int *dst, Lisp_Object arg)
{
  Lisp_Object tem;

  if (XTYPE (arg) == Lisp_String && defined_color (XSTRING (arg)->data, dst))
    {
      recompute_basic_faces (f);
      if (FRAME_VISIBLE_P (f))
        redraw_frame (f);
      return (1);
    }
  return (0);
}


static int pm_set_foreground_color (FRAME_PTR f, pm_modify *dst,
                                    Lisp_Object arg)
{
  return (pm_set_color (f, &f->display.x->foreground_color, arg));
}


static int pm_set_background_color (FRAME_PTR f, pm_modify *dst,
                                    Lisp_Object arg)
{
  return (pm_set_color (f, &f->display.x->background_color, arg));
}


static int pm_set_modifier (int *dst, Lisp_Object arg)
{
  if (EQ (arg, Qalt))
    *dst = alt_modifier;
  else if (EQ (arg, Qmeta))
    *dst = meta_modifier;
  else if (EQ (arg, Qsuper))
    *dst = super_modifier;
  else if (EQ (arg, Qhyper))
    *dst = hyper_modifier;
  else
    return (0);
  return (1);
}


static int pm_set_alt_modifier (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  return (pm_set_modifier (&dst->alt_modifier, arg));
}


static int pm_set_altgr_modifier (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  return (pm_set_modifier (&dst->altgr_modifier, arg));
}


static int pm_set_shortcuts (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  dst->disable_shortcuts = (NILP (arg) ? PMR_TRUE : PMR_FALSE);
  return (1);
}


static int pm_set_mouse_buttons (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  char *p;
  int i;

  if (XTYPE (arg) == Lisp_String && XSTRING (arg)->size == 3)
    {
      p = XSTRING (arg)->data;
      for (i = 0; i < 3; ++i)
        if (!((p[i] >= '1' && p[i] <= '3') || p[i] == ' '))
          return (0);
      memcpy (dst->buttons, p, 3);
      return (1);
    }
  return (0);
}


static int pm_set_width (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  if (XTYPE (arg) == Lisp_Int && XINT (arg) > 0)
    {
      dst->width = XINT (arg);
      return (1);
    }
  return (0);
}


static int pm_set_height (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  if (XTYPE (arg) == Lisp_Int && XINT (arg) > 0)
    {
      dst->height = XINT (arg);
      return (1);
    }
  return (0);
}


static int pm_set_top (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  if (XTYPE (arg) == Lisp_Int)
    {
      dst->top = XINT (arg);
      return (1);
    }
  return (0);
}


static int pm_set_left (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
{
  if (XTYPE (arg) == Lisp_Int)
    {
      dst->left = XINT (arg);
      return (1);
    }
  return (0);
}


struct pm_frame_parm_table
{
  char *name;
  int (*setter)(FRAME_PTR f, pm_modify *dst, Lisp_Object arg);
  int set;
  Lisp_Object obj;
};


static struct pm_frame_parm_table pm_frame_parms[] =
{
  {"width",                      pm_set_width, 0, 0},
  {"height",                     pm_set_height, 0, 0},
  {"top",                        pm_set_top, 0, 0},
  {"left",                       pm_set_left, 0, 0},
  {"cursor-blink",               pm_set_cursor_blink, 0, 0},
  {"cursor-type",                pm_set_cursor_type, 0, 0},
  {"font",                       pm_set_font, 0, 0},
  {"foreground-color",           pm_set_foreground_color, 0, 0},
  {"background-color",           pm_set_background_color, 0, 0},
  {"name",                       pm_set_name, 0, 0},
  {"menu-bar-lines",             pm_set_menu_bar_lines, 0, 0},
  {"pm-menu-bar",                pm_set_pm_menu_bar, 0, 0},
  {"alt-modifier",               pm_set_alt_modifier, 0, 0},
  {"altgr-modifier",             pm_set_altgr_modifier, 0, 0},
  {"mouse-buttons",              pm_set_mouse_buttons, 0, 0},
  {"shortcuts",                  pm_set_shortcuts, 0, 0}
};


static void init_pm_parm_symbols (void)
{
  int i;

  for (i = 0; i < sizeof (pm_frame_parms) / sizeof (pm_frame_parms[0]); i++)
    pm_frame_parms[i].obj = intern (pm_frame_parms[i].name);
}


void x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
{
  store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
  store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
  store_in_alist (alistptr, Qvisibility,
		  (FRAME_VISIBLE_P (f) ? Qt
		   : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
}


void x_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
  Lisp_Object tail;
  int i;
  pm_request pmr;
  pm_modify more;

  more.width = 0; more.height = 0;
  more.top = DONT_MOVE; more.left = DONT_MOVE;
  more.font_name[0] = 0;
  more.cursor_type = 0; more.cursor_blink = 0; more.disable_shortcuts = 0;
  more.alt_modifier = 0; more.altgr_modifier = 0;
  memset (more.buttons, 0, sizeof (more.buttons));

  for (i = 0; i < sizeof (pm_frame_parms) / sizeof (pm_frame_parms[0]); i++)
    pm_frame_parms[i].set = 0;

  for (tail = alist; CONSP (tail); tail = Fcdr (tail))
    {
      Lisp_Object elt, prop, arg;

      elt = Fcar (tail);
      prop = Fcar (elt);
      arg = Fcdr (elt);

      for (i = 0; i < sizeof (pm_frame_parms)/sizeof (pm_frame_parms[0]); i++)
        if (!pm_frame_parms[i].set && EQ (prop, pm_frame_parms[i].obj))
          {
            if (pm_frame_parms[i].setter(f, &more, arg))
              {
                store_frame_param (f, prop, arg);
                pm_frame_parms[i].set = 1;
              }
          }
    }

  if (more.width != 0 || more.height != 0
      || more.top != DONT_MOVE || more.left != DONT_MOVE
      || more.font_name[0] != 0
      || more.cursor_type != 0 || more.cursor_blink != 0
      || more.alt_modifier != 0 || more.altgr_modifier != 0
      || more.disable_shortcuts != 0 || more.buttons[0] != 0)
    {
      pmr.header.type = PMR_MODIFY;
      pmr.header.frame = (unsigned long)f;
      pm_send (&pmr, sizeof (pmr));
      pm_send (&more, sizeof (more));
    }
}


void x_set_name (struct frame *f, Lisp_Object name, int explicit)
{
  pm_request pmr;
  char *tmp;

  if (explicit)
    {
      if (f->explicit_name && NILP (name))
	update_mode_lines = 1;
      f->explicit_name = ! NILP (name);
    }
  else if (f->explicit_name)
    return;
  if (NILP (name))
    name = build_string ("Emacs");
  else
    CHECK_STRING (name, 0);
  if (!NILP (Fstring_equal (name, f->name)))
    return;
  if (strcmp (XSTRING (name)->data, "Emacs") == 0)
    tmp = XSTRING (name)->data;
  else
    {
      tmp = alloca (XSTRING (name)->size + 9);
      strcpy (tmp, "Emacs - ");
      strcpy (tmp + 8, XSTRING (name)->data);
    }
  pmr.name.header.type = PMR_NAME;
  pmr.name.header.frame = (unsigned long)f;
  pmr.name.count = strlen (tmp);
  pm_send (&pmr, sizeof (pmr));
  pm_send (tmp, pmr.name.count);
  f->name = name;
}


void x_implicitly_set_name (struct frame *f, Lisp_Object arg,
                            Lisp_Object oldval)
{
  x_set_name (f, arg, 0);
}


x_pixel_width (FRAME_PTR f)
{
  return PIXEL_WIDTH (f);
}

x_pixel_height (FRAME_PTR f)
{
  return PIXEL_HEIGHT (f);
}

x_char_width (FRAME_PTR f)
{
  return FONT_WIDTH (f->display.x->font);
}

x_char_height (FRAME_PTR f)
{
  return FONT_HEIGHT (f->display.x->font);
}


static int font_match (unsigned char *pattern, unsigned char *name)
{
  for (;;)
    switch (*pattern)
      {
      case 0:
        return (*name == 0);
      case '?':
        ++pattern;
        if (*name == 0)
          return 0;
        ++name;
        break;
      case '*':
        while (*pattern == '*')
          ++pattern;
        if (*pattern == 0)
          return 1;
        while (*name != 0)
          {
            if (font_match (pattern, name))
              return 1;
            ++name;
          }
        return 0;
      default:
        if (*pattern != *name)
          return 0;
        ++pattern; ++name;
        break;
      }
}


DEFUN ("pm-list-fonts", Fpm_list_fonts, Spm_list_fonts, 1, 3, 0,
  "Return a list of the names of available fonts matching PATTERN.\n\
If optional arguments FACE and FRAME are specified, return only fonts\n\
the same size as FACE on FRAME.\n\
\n\
PATTERN is a string, perhaps with wildcard characters;\n\
  the * character matches any substring, and\n\
  the ? character matches any single character.\n\
  PATTERN is case-insensitive.\n\
FACE is a face name - a symbol.\n\
\n\
The return value is a list of strings, suitable as arguments to\n\
set-face-font.\n\
\n\
The list does not include fonts Emacs can't use (i.e.  proportional\n\
fonts), even if they match PATTERN and FACE.")
  (pattern, face, frame)
    Lisp_Object pattern, face, frame;
{
  pm_request pmr;
  pmd_fontlist answer;
  unsigned char *buf, *p;
  Lisp_Object *list;
  int i, len, n, count;
  FRAME_PTR f;
  unsigned char font[64];

  CHECK_STRING (pattern, 0);
  if (!NILP (face))
    CHECK_SYMBOL (face, 1);
  if (!NILP (frame))
    CHECK_LIVE_FRAME (frame, 2);

  f = NILP (frame) ? selected_frame : XFRAME (frame);

  pmr.header.type = PMR_FONTLIST;
  pmr.header.frame = (unsigned long)f;
  pm_send (&pmr, sizeof (pmr));

  pm_receive_oob (&answer, sizeof (answer));
  buf = alloca (answer.size);
  pm_receive_oob (buf, answer.size);
  list = alloca (answer.count * sizeof (Lisp_Object));
  count = 0;
  p = buf;
  for (i = 0; i < answer.count; ++i)
    {
      len = *p++;
      n = len;
      if (n > sizeof (font) - 1)
        n = sizeof (font) - 1;
      memcpy (font, p, n);
      font[n] = 0;
      if (font_match (XSTRING (pattern)->data, font))
        list[count++] = make_string (p, len);
      p += len;
    }
  return Flist (count, list);
}


DEFUN ("pm-defined-color", Fpm_defined_color, Spm_defined_color, 1, 1, 0,
  "Return t if the PM display supports the color named COLOR.")
  (color)
     Lisp_Object color;
{
  int foo;
  
  CHECK_STRING (color, 0);

  if (defined_color (XSTRING (color)->data, &foo))
    return Qt;
  else
    return Qnil;
}


DEFUN ("pm-display-color-p", Fpm_display_color_p, Spm_display_color_p, 0, 0, 0,
  "Return t if the display supports color.")
  ()
{
  return Qt;
}


DEFUN ("pm-display-planes", Fpm_display_planes, Spm_display_planes,
  0, 1, 0,
  "Returns the number of bitplanes of the display FRAME is on.")
  (frame)
     Lisp_Object frame;
{
  /* Assume 256-color adapter.  faces.el checks for = 1. */
  return make_number (8);
}


DEFUN ("pm-open-connection", Fpm_open_connection, Spm_open_connection,
       0, 0, 0, "Open a connection to PM Emacs.")
  ()
{
  if (pm_session_started)
    error ("PM Emacs connection is already initialized");
  pm_init ();
  return Qnil;
}


/* This function is called by kill-emacs, see emacs.c. */

DEFUN ("x-close-current-connection", Fx_close_current_connection,
       Sx_close_current_connection,
       0, 0, 0, "Close the current connection to PM Emacs.")
  ()
{
  if (pm_session_started)
    pm_exit ();
  else
    fatal ("No current PM Emacs connection to close\n");
  return Qnil;
}


DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
  "Set the focus on FRAME.")
  (frame)
     Lisp_Object frame;
{
  CHECK_LIVE_FRAME (frame, 0);

  if (FRAME_X_P (XFRAME (frame)))
    {
      x_focus_on_frame (XFRAME (frame));
      return frame;
    }

  return Qnil;
}


DEFUN ("pm-create-frame", Fpm_create_frame, Spm_create_frame,
       1, 1, 0,
  "Make a new PM window, which is called a \"frame\" in Emacs terms.\n\
Return an Emacs frame object representing the PM window.\n\
ALIST is an alist of frame parameters.\n\
If the parameters specify that the frame should not have a minibuffer,\n\
and do not specify a specific minibuffer window to use,\n\
then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
be shared by the new frame.")
  (parms)
     Lisp_Object parms;
{
  struct frame *f;
  Lisp_Object frame, name, tem;
  int minibuffer_only;
  int height, width;
  pm_request pmr;

  if (!pm_session_started)
    error ("PM Emacs connection not established");

  name = pm_get_arg (parms, Qname);
  if (XTYPE (name) != Lisp_String && !EQ (name, Qunbound) && !NILP (name))
    error ("pm-create-frame: name parameter must be a string");

  minibuffer_only = 0;
  tem = pm_get_arg (parms, Qminibuffer);
  if (EQ (tem, Qnone) || NILP (tem))
    f = make_frame_without_minibuffer (Qnil);
  else if (EQ (tem, Qonly))
    {
      f = make_minibuffer_frame ();
      minibuffer_only = 1;
    }
  else if (XTYPE (tem) == Lisp_Window)
    f = make_frame_without_minibuffer (tem);
  else
    f = make_frame (1);

  FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;

  if (EQ (name, Qunbound) || NILP (name))
    {
      f->name = build_string ("Emacs");
      f->explicit_name = 0;
    }
  else
    {
      f->name = name;
      f->explicit_name = 1;
    }

  XSET (frame, Lisp_Frame, f);
  f->output_method = output_x_window;
  f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
  bzero (f->display.x, sizeof (struct x_display));

  /* Note that the frame has no physical cursor right now.  */
  f->phys_cursor_x = -1;

  f->display.x->font = (FONT_TYPE *)xmalloc (sizeof (FONT_TYPE));
  bzero (f->display.x->font, sizeof (FONT_TYPE));

  tem = pm_get_arg (parms, Qheight);
  if (EQ (tem, Qunbound))
    tem = pm_get_arg (parms, Qwidth);
  if (EQ (tem, Qunbound))
    {
      width = 80; height = 25;
    }
  else
    {
      tem = pm_get_arg (parms, Qheight);
      if (EQ (tem, Qunbound))
        error ("Height not specified");
      CHECK_NUMBER (tem, 0);
      height = XINT (tem);

      tem = pm_get_arg (parms, Qwidth);
      if (EQ (tem, Qunbound))
        error ("Width not specified");
      CHECK_NUMBER (tem, 0);
      width = XINT (tem);
    }

  pmr.create.header.type = PMR_CREATE;
  pmr.create.header.frame = (unsigned long)f;
  pmr.create.height = height;
  pmr.create.width = width;
  pm_send (&pmr, sizeof (pmr));

  pm_default_parameter (f, parms, Qfont, build_string ("10.Courier"));
  pm_default_parameter (f, parms, Qforeground_color, build_string ("black"));
  pm_default_parameter (f, parms, Qbackground_color, build_string ("white"));

  {
    Lisp_Object name = f->name;
    int explicit = f->explicit_name;

    f->name = Qnil;
    f->explicit_name = 0;
    x_set_name (f, name, explicit);
  }

  init_frame_faces (f);

  pm_default_parameter (f, parms, Qcursor_type, Qbox);
  pm_default_parameter (f, parms, Qcursor_blink, Qt);
  pm_default_parameter (f, parms, Qshortcuts, Qt);
  pm_default_parameter (f, parms, Qalt_modifier, Qmeta);
  pm_default_parameter (f, parms, Qaltgr_modifier, Qalt);
  pm_default_parameter (f, parms, Qmouse_buttons, build_string ("132"));

  f->height = f->width = 0;
  change_frame_size (f, height, width, 1, 0);

  pm_default_parameter (f, parms, Qmenu_bar_lines, make_number (0));
  pm_default_parameter (f, parms, Qpm_menu_bar, Qnil);
  pm_default_parameter (f, parms, Qtop, Qnil);
  pm_default_parameter (f, parms, Qleft, Qnil);

  pm_get_framepos (f);

  tem = pm_get_arg (parms, Qunsplittable);
  f->no_split = minibuffer_only || EQ (tem, Qt);

  /* Make the window appear on the frame and enable display,
     unless the caller says not to.  */
  {
    Lisp_Object visibility = pm_get_arg (parms, Qvisibility);

    if (EQ (visibility, Qunbound))
      visibility = Qt;

    if (EQ (visibility, Qicon))
      x_iconify_frame (f);
    else if (! NILP (visibility))
      x_make_frame_visible (f);
    else
      /* Must have been Qnil.  */
      ;
  }

  return frame;
}


/* Used in xfaces.c */

#define FACE_DEFAULT (~0)

void
pm_background_color (FRAME_PTR f)
{
  pm_request pmr;
  struct face *face;

  face = FRAME_DEFAULT_FACE (f);
  pmr.background.header.type = PMR_BACKGROUND;
  pmr.background.header.frame = (unsigned long)f;
  if (face->background != FACE_DEFAULT)
    pmr.background.background = face->background;
  else
    pmr.background.background = f->display.x->background_color;
  pm_send (&pmr, sizeof (pmr));

}

/* Used in xmenu.c */

Lisp_Object
pmmenu_show (f, button, x, y, line_list, enable_list, pane_list,
             prefixes, line_cnt, pane_cnt, item_list, title, error, menubar)
     FRAME_PTR f;
     int button;                /* mouse button number or 0 */
     int x, y;
     char **line_list[];   	/* list of strings for items */
     int *enable_list[];   	/* enable flags of lines */
     char *pane_list[];		/* list of pane titles */
     Lisp_Object *prefixes;	/* Prefix key for each pane */
     char *title;
     int pane_cnt;		/* total number of panes */
     Lisp_Object *item_list[];	/* All items */
     int line_cnt[];		/* Lines in each pane */
     char **error;		/* Error returned */
{
  int last, panes, selidx, lpane, status;
  int lines, sofar;
  int total_size;
  Lisp_Object entry;
  pm_request pmr;
  pm_menu_pane pmp;
  pm_menu_line pml;
  char *buf, *p;

  if (pane_cnt == 0 && NILP (menubar))
    return 0;

  *error = (char *) 0;		/* Initialize error pointer to null */

  if (title == 0)
    title = "untitled";

  total_size = strlen (title);
  for (panes = 0, lines = 0; panes < pane_cnt;
       lines += line_cnt[panes], panes++)
    {
      total_size += sizeof (pmp) + strlen (pane_list[panes]);
      for (selidx = 0; selidx < line_cnt[panes]; selidx++)
        total_size += sizeof (pml) + strlen (line_list[panes][selidx]);
    }

  buf = p = alloca (total_size);

  if (NILP (menubar))
    {
      pmr.popupmenu.header.type = PMR_POPUPMENU;
      pmr.popupmenu.header.frame = (unsigned long)f;
      pmr.popupmenu.panes = pane_cnt;
      pmr.popupmenu.lines = lines;
      pmr.popupmenu.button = button;
      pmr.popupmenu.x = x;
      pmr.popupmenu.y = y;
      pmr.popupmenu.title_size = strlen (title);
      pmr.popupmenu.size = total_size;
    }
  else
    {
      pmr.menu.header.type = PMR_MENU;
      pmr.menu.header.frame = (unsigned long)f;
      pmr.menu.panes = pane_cnt;
      pmr.menu.lines = lines;
      pmr.menu.title_size = strlen (title);
      pmr.menu.size = total_size;
    }
  pm_send (&pmr, sizeof (pmr));
  strcpy (p, title); p += strlen (title);

  for (panes = 0, sofar = 0; panes < pane_cnt;
       sofar += line_cnt[panes], panes++)
    {
      pmp.lines = line_cnt[panes];
      pmp.size = strlen (pane_list[panes]);
      memcpy (p, &pmp, sizeof (pmp)); p += sizeof (pmp);
      strcpy (p, pane_list[panes]); p += strlen (pane_list[panes]);
      for (selidx = 0; selidx < line_cnt[panes]; selidx++)
	{
          if (NILP (menubar))
            {
              pml.item1 = (unsigned long)((panes << 16) | (selidx + 1));
              pml.item2 = 0;
              pml.item3 = 0;
            }
          else
            {
              pml.item1 = menubar;
              if (prefixes != 0 && prefixes[panes] != Qnil)
                pml.item2 = prefixes[panes];
              else
                pml.item2 = 0;
              pml.item3 = item_list[panes][selidx];
            }
          pml.enable = enable_list[panes][selidx];
          pml.size = strlen (line_list[panes][selidx]);
          memcpy (p, &pml, sizeof (pml)); p += sizeof (pml);
          strcpy (p, line_list[panes][selidx]);
          p += strlen (line_list[panes][selidx]);
	}
    }
  pm_send (buf, total_size);

  if (NILP (menubar))
    {
      pm_receive_oob (&entry, sizeof (entry));
      if (entry == 0)
        entry = Qnil;
      else
        {
          panes = entry >> 16;
          selidx = (entry & 0xffff) - 1;
          entry = item_list[panes][selidx];
          if (prefixes != 0)
            {
              entry = Fcons (entry, Qnil);
              if (!NILP (prefixes[panes]))
                entry = Fcons (prefixes[panes], entry);
            }
        }
      return (entry);
    }
  else
    return (0);
}


/* Extract the event symbol sans modifiers from an event.  Used in
   xmenu.c */

int pm_event_button (Lisp_Object position)
{
  Lisp_Object head, els, ev;

  head = Fcar (position);           /* EVENT_HEAD (position) */
  els = Fget (head, Qevent_symbol_elements);
  if (Fmemq (Qdown, Fcdr (els)))
    {
      ev = Fcar (els);
      if (EQ (ev, Qmouse_1))
        return 1;
      else if (EQ (ev, Qmouse_2))
        return 2;
      else if (EQ (ev, Qmouse_3))
        return 3;
    }
  return 0;
}


static int menubar_size;
static int menubar_count;


static void menubar_top (FRAME_PTR f, int pass)
{
  pm_request pmr;
  pm_menubar_entry pme;
  Lisp_Object tail, string;
  char *buf, *p;

  if (XTYPE (FRAME_MENU_BAR_ITEMS (f)) != Lisp_Cons)
    return;

  if (pass == 0)
    {
      menubar_count = 0;
      menubar_size = 0;
    }
  else
    {
      pmr.menubar.header.type = PMR_MENUBAR;
      pmr.menubar.header.frame = (unsigned long)f;
      pmr.menubar.menus = menubar_count;
      pmr.menubar.size = menubar_size;
      pm_send (&pmr, sizeof (pmr));
      p = buf = alloca (menubar_size);
    }

  for (tail = FRAME_MENU_BAR_ITEMS (f); CONSP (tail); tail = XCONS (tail)->cdr)
    {
      string = XCONS (XCONS (XCONS (tail)->car)->cdr)->car;
      if (pass == 0)
        {
          /* hpos isn't used */
          XFASTINT (XCONS (XCONS (XCONS (tail)->car)->cdr)->cdr) = 0;
          ++menubar_count;
          menubar_size += sizeof (pme) + XSTRING (string)->size;
        }
      else
        {
          pme.size = XSTRING (string)->size;
          memcpy (p, &pme, sizeof (pme)); p += sizeof (pme);
          memcpy (p, XSTRING (string)->data, pme.size); p += pme.size;
        }
    }
  if (pass != 0)
    pm_send (buf, menubar_size);
}


void pm_menu_bar_top (FRAME_PTR f)
{
  menubar_top (f, 0);
  menubar_top (f, 1);
}


DEFUN ("pm-menu-bar-menu", Fpm_menu_bar_menu, Spm_menu_bar_menu, 3, 3, 0,
  "Update a menu of the PM menu bar.\n\
This function should be called from pm-menu-bar-update only.\n\
KEY is the event symbol for the menu, MENU is a menu keymap.")
  (frame, key, menu)
     Lisp_Object frame, key, menu;
{
  FRAME_PTR f;
  Lisp_Object keymap, prompt;
  int number_of_panes;
  char **menus;
  char ***names;
  int **enables;
  Lisp_Object **obj_list;
  Lisp_Object *prefixes;
  int *items;
  char *title;
  char *error_name;
  int i;
  pm_request pmr;

  f = XFRAME (frame);
  if (NILP (menu))
    {
      pmr.menu.header.type = PMR_MENU;
      pmr.menu.header.frame = (unsigned long)f;
      pmr.menu.panes = 0;
      pmr.menu.lines = 0;
      pmr.menu.title_size = 0;
      pmr.menu.size = 0;
      pm_send (&pmr, sizeof (pmr));
    }
  else
    {
      title = 0;
      keymap = get_keymap (menu);
      prompt = map_prompt (keymap);
      if (!NILP (prompt))
	title = (char *) XSTRING (prompt)->data;
      number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
				      &items, &prefixes, &menu, 1);

      pmmenu_show (f, -1, -1, -1, names, enables, menus, prefixes,
                   items, number_of_panes, obj_list, title,
                   &error_name, key);

      for (i = 0; i < number_of_panes; i++)
        {
          xfree (names[i]);
          xfree (enables[i]);
          xfree (obj_list[i]);
        }
      xfree (menus);
      xfree (obj_list);
      xfree (names);
      xfree (prefixes);
      xfree (enables);
      xfree (items);
    }
  return Qnil;
}


DEFUN ("frame-menu-bar-items", Fframe_menu_bar_items, Sframe_menu_bar_items,
  0, 1, 0,
  "Return the list of FRAME's menu bar items.\n\
The elements of the list have the form (KEY STRING . nil).")
  (frame)
     Lisp_Object frame;
{
  struct frame *f;

  if (EQ (frame, Qnil))
    f = selected_frame;
  else
    {
      CHECK_FRAME (frame, 0);
      f = XFRAME (frame);
    }
  return FRAME_MENU_BAR_ITEMS (f);
}


syms_of_xfns ()
{
  Qalt = intern ("alt");
  staticpro (&Qalt);
  Qalt_modifier = intern ("alt-modifier");
  staticpro (&Qalt_modifier);
  Qaltgr_modifier = intern ("altgr-modifier");
  staticpro (&Qaltgr_modifier);
  Qbackground_color = intern ("background-color");
  staticpro (&Qbackground_color);
  Qbar = intern ("bar");
  staticpro (&Qbar);
  Qbox = intern ("box");
  staticpro (&Qbox);
  Qcursor_blink = intern ("cursor-blink");
  staticpro (&Qcursor_blink);
  Qcursor_type = intern ("cursor-type");
  staticpro (&Qcursor_type);
  Qdown = intern ("down");
  staticpro (&Qdown);
  Qfont = intern ("font");
  staticpro (&Qfont);
  Qforeground_color = intern ("foreground-color");
  staticpro (&Qforeground_color);
  Qframe = intern ("frame");
  staticpro (&Qframe);
  Qhalftone = intern ("halftone");
  staticpro (&Qhalftone);
  Qhyper = intern ("hyper");
  staticpro (&Qhyper);
  Qleft = intern ("left");
  staticpro (&Qleft);
  Qmeta = intern ("meta");
  staticpro (&Qmeta);
  Qmouse_1 = intern ("mouse-1");
  staticpro (&Qmouse_1);
  Qmouse_2 = intern ("mouse-2");
  staticpro (&Qmouse_2);
  Qmouse_3 = intern ("mouse-3");
  staticpro (&Qmouse_3);
  Qmouse_buttons = intern ("mouse-buttons");
  staticpro (&Qmouse_buttons);
  Qnone = intern ("none");
  staticpro (&Qnone);
  Qpm_menu_bar = intern ("pm-menu-bar");
  staticpro (&Qpm_menu_bar);
  Qshortcuts = intern ("shortcuts");
  staticpro (&Qshortcuts);
  Qsuper = intern ("super");
  staticpro (&Qsuper);
  Qtop = intern ("top");
  staticpro (&Qtop);
  Qvisibility = intern ("visibility");
  staticpro (&Qvisibility);

  DEFVAR_LISP ("pm-color-alist", &Vpm_color_alist,
    "*List of elements (\"COLOR\" . [R G B]) for defining colors.\n\
\"COLOR\" is the name of the color.  Don't use upper-case letters.\n\
R, G and B are numbers in 0 through 255, indicating the intensity\n\
of the red, green and blue beams, respectively.");
  Vpm_color_alist = Qnil;

  defsubr (&Sfocus_frame);
  defsubr (&Spm_display_color_p);
  defsubr (&Spm_display_planes);
  defsubr (&Spm_list_fonts);
  defsubr (&Spm_defined_color);
  defsubr (&Spm_create_frame);
  defsubr (&Spm_open_connection);
  defsubr (&Spm_menu_bar_menu);
  defsubr (&Sframe_menu_bar_items);
  defsubr (&Sx_close_current_connection);

  init_pm_parm_symbols ();
}
