/* pmfns.c -- xfns.c for the OS/2 Presentation Manager
   Copyright (C) 1993, 1994 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_f4;
Lisp_Object Qalt_f5;
Lisp_Object Qalt_f6;
Lisp_Object Qalt_f7;
Lisp_Object Qalt_f8;
Lisp_Object Qalt_f9;
Lisp_Object Qalt_f10;
Lisp_Object Qalt_f11;
Lisp_Object Qalt_modifier;
Lisp_Object Qalt_space;
Lisp_Object Qaltgr;
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 Qf1;
Lisp_Object Qf10;
Lisp_Object Qfont;
Lisp_Object Qforeground_color;
Lisp_Object Qframe;
Lisp_Object Qhalftone;
Lisp_Object Qhyper;
Lisp_Object Qleft;
Lisp_Object Qmenu_bar_time_out;
Lisp_Object Qmeta;
Lisp_Object Qmouse_1;
Lisp_Object Qmouse_2;
Lisp_Object Qmouse_3;
Lisp_Object Qmouse_buttons;
Lisp_Object Qnone;
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);

void
check_x ()
{
  if (!pm_session_started)
    error ("PM Emacs not in use or not initialized");
}

struct pm_menu_bar_item
{
  struct pm_menu_bar_item *next;
  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 items, name;
  int i;

  pp = &f->pm_menu_bar_items;
  items = FRAME_MENU_BAR_ITEMS (f);
  for (i = 0; i < XVECTOR (items)->size; i += 3)
    {
      p = *pp;
      if (p == NULL)
        break;
      name = XVECTOR (items)->contents[i + 1];
      if (NILP (name))
        break;
      if (strcmp (p->name, XSTRING (name)->data) != 0)
        break;
      pp = &p->next;
    }
  if (*pp == NULL)
    {
      if (i >= XVECTOR (items)->size)
        return (0);
      name = XVECTOR (items)->contents[i + 1];
      if (NILP (name))
        return (0);
    }
  for (; i < XVECTOR (items)->size; i += 3)
    {
      name = XVECTOR (items)->contents[i + 1];
      if (NILP (name))
        break;
      if (XTYPE (name) != Lisp_String)
        abort ();
      p = *pp;
      if (p == NULL)
        {
          p = (struct pm_menu_bar_item *)xmalloc (sizeof (*p));
          p->next = NULL;
          *pp = p;
        }
      _strncpy (p->name, XSTRING (name)->data, sizeof (p->name));
      pp = &p->next;
    }
  free_pm_menu_bar (*pp);
  *pp = NULL;
  return 1;
}


void
free_frame_menubar (FRAME_PTR f)
{
}


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

  name = alloca (strlen (color) + 1);
  for (p = name; *color != 0; ++color)
    if (*color != ' ')
      *p++ = *color;
  *p = 0;
  tem = Fassoc (Fdowncase (build_string (name)), 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.framepos.header.type = PMR_FRAMEPOS;
  pmr.framepos.header.frame = (unsigned long)f;
  pmr.framepos.serial = pm_serial++;
  pm_send (&pmr, sizeof (pmr));
  if (pm_receive (pmr.framepos.serial, &answer, NULL, 0) != NULL)
    {
      f->display.x->left_pos = answer.left;
      f->display.x->top_pos = answer.top;
      f->display.x->pixel_height = answer.pix_height;
      f->display.x->pixel_width = answer.pix_width;
    }
}

/* Stolen from xfns.c */

static void
x_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))
	x_set_menu_bar_lines_1 (w->vchild);

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


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

  if (FRAME_MINIBUF_ONLY_P (f))
    return;

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

#ifdef USE_X_TOOLKIT
  FRAME_MENU_BAR_LINES (f) = 0;
  if (nlines)
    FRAME_EXTERNAL_MENU_BAR (f) = 1;
  else
    {
      if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
        {
          pm_request pmr;

          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));
        }
      free_frame_menubar (f);
      FRAME_EXTERNAL_MENU_BAR (f) = 0;
    }
#else /* not USE_X_TOOLKIT */
  FRAME_MENU_BAR_LINES (f) = nlines;
  x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
  x_set_window_size (f, 0, FRAME_WIDTH (f),
                     FRAME_HEIGHT (f) + nlines - olines);
#endif /* not USE_X_TOOLKIT */
  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)
{
  int ok;

  ok = pm_set_color (f, &f->display.x->background_color, arg);
  if (ok)
    dst->background_color = f->display.x->background_color;
  return ok;
}


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)
{

  if (EQ (arg, Qt))
    dst->shortcuts = ~0;
  else if (NILP (arg) || CONSP (arg))
    {
      Lisp_Object elt;

      dst->shortcuts = SHORTCUT_SET;
      while (CONSP (arg))
        {
          elt = XCONS (arg)->car;
          if (EQ (elt, Qalt))
            dst->shortcuts |= SHORTCUT_ALT;
          else if (EQ (elt, Qaltgr))
            dst->shortcuts |= SHORTCUT_ALTGR;
          else if (EQ (elt, Qf1))
            dst->shortcuts |= SHORTCUT_F1;
          else if (EQ (elt, Qf10))
            dst->shortcuts |= SHORTCUT_F10;
          else if (EQ (elt, Qalt_f4))
            dst->shortcuts |= SHORTCUT_ALT_F4;
          else if (EQ (elt, Qalt_f5))
            dst->shortcuts |= SHORTCUT_ALT_F5;
          else if (EQ (elt, Qalt_f6))
            dst->shortcuts |= SHORTCUT_ALT_F6;
          else if (EQ (elt, Qalt_f7))
            dst->shortcuts |= SHORTCUT_ALT_F7;
          else if (EQ (elt, Qalt_f8))
            dst->shortcuts |= SHORTCUT_ALT_F8;
          else if (EQ (elt, Qalt_f9))
            dst->shortcuts |= SHORTCUT_ALT_F9;
          else if (EQ (elt, Qalt_f10))
            dst->shortcuts |= SHORTCUT_ALT_F10;
          else if (EQ (elt, Qalt_f11))
            dst->shortcuts |= SHORTCUT_ALT_F11;
          else if (EQ (elt, Qalt_space))
            dst->shortcuts |= SHORTCUT_ALT_SPACE;
          else
            {
              dst->shortcuts = 0;
              return 0;
            }
          arg = XCONS (arg)->cdr;
        }
    }
  else
    return 0;
  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);
}


static int pm_set_menu_bar_time_out (FRAME_PTR f, pm_modify *dst,
                                     Lisp_Object arg)
{
  if (XTYPE (arg) == Lisp_Int && XINT (arg) > 0)
    {
      dst->menu_bar_time_out = 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",             x_set_menu_bar_lines, 0, 0},
  {"menu-bar-time-out",          pm_set_menu_bar_time_out, 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));
  FRAME_SAMPLE_VISIBILITY (f);
  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.background_color = COLOR_NONE;
  more.font_name[0] = 0;
  more.cursor_type = 0; more.cursor_blink = 0; more.shortcuts = 0;
  more.alt_modifier = 0; more.altgr_modifier = 0;
  more.menu_bar_time_out = 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.background_color != COLOR_NONE
      || more.font_name[0] != 0
      || more.cursor_type != 0 || more.cursor_blink != 0
      || more.alt_modifier != 0 || more.altgr_modifier != 0
      || more.menu_bar_time_out != 0
      || more.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));
      if (more.font_name[0] != 0)
        recompute_basic_faces (f);
    }
}


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);
}


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;

  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);

  len = XSTRING (pattern)->size;
  if (len > 511) len = 511;
  pmr.fontlist.header.type = PMR_FONTLIST;
  pmr.fontlist.header.frame = (unsigned long)f;
  pmr.fontlist.serial = pm_serial++;
  pmr.fontlist.pattern_length = len;
  pm_send (&pmr, sizeof (pmr));
  pm_send (XSTRING (pattern)->data, len);

  buf = pm_receive (pmr.fontlist.serial, NULL, NULL, 0);
  if (buf == NULL)
    return Qnil;

  answer = (pmd_fontlist *)buf;
  list = alloca (answer->count * sizeof (Lisp_Object));
  count = 0;
  p = buf + sizeof (pmd_fontlist);

  for (i = 0; i < answer->count; ++i)
    {
      len = *p++;
      list[count++] = make_string (p, len);
      p += len;
    }
  xfree (buf);
  return Flist (count, list);
}


DEFUN ("pm-color-defined-p", Fpm_color_defined_p, Spm_color_defined_p, 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;
{
  return make_number (x_screen_planes);
}


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;
}


Lisp_Object
x_get_focus_frame ()
{
  Lisp_Object tem;
  /*TODO*/
  XSET (tem, Lisp_Frame, selected_frame);
  return tem;
}


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 ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
  "If a frame has been focused, release it.")
  ()
{
  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;
  int count = specpdl_ptr - specpdl;
  pm_request pmr;

  check_x ();

  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));
  f->display.x->font->ascent = 1;           /* TODO */
  f->display.x->font->descent = 0;          /* TODO */
  f->display.x->font->max_bounds.width = 1; /* TODO */
  f->display.x->pixel_height = 0;
  f->display.x->pixel_width = 0;
  f->display.x->line_height = 1; /* TODO */
  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);
    }

  pm_add_frame (f);

  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;
    int explicit = f->explicit_name;

    f->explicit_name = 0;
    name = f->name;
    f->name = Qnil;
    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, Qmenu_bar_time_out, make_number (5000));
  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);

  Vframe_list = Fcons (frame, Vframe_list);

  /* Make the window appear on the frame and enable display,
     unless the caller says not to.  */
  {
    Lisp_Object visibility;

    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 unbind_to (count, frame);
}


/* 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 items, string, maps, tem;
  char *buf, *p;
  int i;

  items = FRAME_MENU_BAR_ITEMS (f);
  if (XTYPE (items) != Lisp_Vector || XVECTOR (items)->size < 1)
    return;
  string = XVECTOR (items)->contents[0 + 1];
  if (NILP (string))
    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 (i = 0; i < XVECTOR (items)->size; i += 3)
    {
      string = XVECTOR (items)->contents[i + 1];
      if (NILP (string))
        break;
      if (pass == 0)
        {
          ++menubar_count;
          menubar_size += sizeof (pme) + XSTRING (string)->size;
        }
      else
        {
          pme.str_length = XSTRING (string)->size;
          pme.command = 0;
          maps = XVECTOR (items)->contents[i + 2];
          if (CONSP (maps) && NILP (XCONS (maps)->cdr))
            {
              tem = XCONS (maps)->car;
              if (!NILP (Fcommandp (tem))
                  && NILP (Feval (Fget (tem, intern ("safe-menu-bar-menu")))))
                pme.command = 1;
            }
          memcpy (p, &pme, sizeof (pme)); p += sizeof (pme);
          memcpy (p, XSTRING (string)->data, pme.str_length);
          p += pme.str_length;
        }
    }
  if (pass != 0)
    pm_send (buf, menubar_size);
}


void
update_frame_menubar (FRAME_PTR f)
{
  if (pm_menu_bar_changed (f))
    {
      menubar_top (f, 0);
      menubar_top (f, 1);
    }
}


DEFUN ("pm-get-drop", Fpm_get_drop, Spm_get_drop, 1, 1, 0,
  "Get name of dopped object.\n\
TIMESTAMP is the timestamp of the event.\n\
Return nil if there is no such object.")
  (timestamp)
     Lisp_Object timestamp;
{
  pm_request pmr;
  char name[260];               /* CCHMAXPATH */
  int size;

  check_x ();

  CHECK_NUMBER (timestamp, 0);
  pmr.drop.header.type = PMR_DROP;
  pmr.drop.header.frame = 0;
  pmr.drop.serial = pm_serial++;
  pmr.drop.cookie = XINT (timestamp);
  pm_send (&pmr, sizeof (pmr));
  if (pm_receive (pmr.drop.serial, name, &size, 0) == NULL
      || size == 0)
    return Qnil;
  return make_string (name, size);
}


/* Return a list of code pages supported by PM. */

Lisp_Object pm_list_code_pages (void)
{
  pm_request pmr;
  int *buf;
  int i, size;
  Lisp_Object list;

  pmr.cplist.header.type = PMR_CPLIST;
  pmr.cplist.header.frame = 0;
  pmr.cplist.serial = pm_serial++;
  pm_send (&pmr, sizeof (pmr));
  buf = pm_receive (pmr.cplist.serial, NULL, &size, 0);
  if (buf == NULL)
    return Qnil;
  list = Qnil;
  for (i = size / sizeof (int) - 1; i >= 1; --i)
    list = Fcons (make_number (buf[i]), list);
  xfree (buf);
  return list;
}


/* Send the new code page to pmemacs.exe, recompute all faces, and
   redraw all frames.  Return zero on error. */

int pm_set_code_page (int cp)
{
  pm_request pmr;
  int ok;

  pmr.codepage.header.type = PMR_CODEPAGE;
  pmr.codepage.header.frame = 0;
  pmr.codepage.codepage = cp;
  pmr.codepage.serial = pm_serial++;
  pm_send (&pmr, sizeof (pmr));
  if (pm_receive (pmr.codepage.serial, &ok, NULL, 0) == NULL || !ok)
    return 0;
  clear_face_vector ();         /* Recompute all faces */
  Fredraw_display ();
  return 1;
}


DEFUN ("pm-file-dialog", Fpm_file_dialog, Spm_file_dialog, 3, 7, 0,
  "Show and process a file dialog on frame FRAME with TITLE.\n\
If FRAME is nil, use the current frame.  The default directory is DIR,\n\
which is not expanded---you must call `expand-file-name' yourself.\n\
The initial value of the file-name entryfield is DEFAULT or empty if\n\
DEFAULT is nil.  Fifth arg MUSTMATCH non-nil means require existing\n\
file's name.  Sixth arg SAVEAS non-nil creates a Save As dialog instead\n\
of a Open dialog.  Seventh arg BUTTON specifies text to for the OK button,\n\
the default is \"OK\".\n\
Return the select file name as string.  Return nil, if no file name was\n\
selected.")
  (frame, title, dir, defalt, mustmatch, saveas, button)
     Lisp_Object frame, title, dir, defalt, mustmatch, saveas, button;
{
  pm_request pmr;
  pm_filedialog more;
  char name[260];               /* CCHMAXPATH */
  int size;
  FRAME_PTR f;

  check_x ();

  if (NILP (frame))
    f = selected_frame;
  else
    {
      CHECK_LIVE_FRAME (frame, 0);
      f = XFRAME (frame);
    }

  CHECK_STRING (title, 1);
  CHECK_STRING (dir, 2);
  if (!NILP (defalt))
    CHECK_STRING (defalt, 3);
  if (!NILP (button))
    CHECK_STRING (button, 5);

  pmr.header.type = PMR_FILEDIALOG;
  pmr.header.frame = (unsigned long)f;
  more.serial = pm_serial++;
  more.save_as = !NILP (saveas);
  more.must_match = !NILP (mustmatch);
  _strncpy (more.title, XSTRING (title)->data, sizeof (more.title));
  _strncpy (more.dir, XSTRING (dir)->data, sizeof (more.dir));
  if (NILP (defalt))
    more.defalt[0] = 0;
  else
    _strncpy (more.defalt, XSTRING (defalt)->data, sizeof (more.defalt));
  if (NILP (button))
    strcpy (more.ok_button, "OK");
  else
    _strncpy (more.ok_button, XSTRING (button)->data);
  pm_send (&pmr, sizeof (pmr));
  pm_send (&more, sizeof (more));

  if (pm_receive (more.serial, name, &size, 1) == NULL || size == 0)
    return Qnil;
  return make_string (name, size);
}


void
x_sync (frame)
     Lisp_Object frame;
{
}


syms_of_xfns ()
{
  Qalt = intern ("alt");
  staticpro (&Qalt);
  Qalt_f4 = intern ("alt-f4");
  staticpro (&Qalt_f4);
  Qalt_f5 = intern ("alt-f5");
  staticpro (&Qalt_f5);
  Qalt_f6 = intern ("alt-f6");
  staticpro (&Qalt_f6);
  Qalt_f7 = intern ("alt-f7");
  staticpro (&Qalt_f7);
  Qalt_f8 = intern ("alt-f8");
  staticpro (&Qalt_f8);
  Qalt_f9 = intern ("alt-f9");
  staticpro (&Qalt_f9);
  Qalt_f10 = intern ("alt-f10");
  staticpro (&Qalt_f10);
  Qalt_f11 = intern ("alt-f11");
  staticpro (&Qalt_f11);
  Qalt_modifier = intern ("alt-modifier");
  staticpro (&Qalt_modifier);
  Qalt_space = intern ("alt-space");
  staticpro (&Qalt_space);
  Qaltgr = intern ("altgr");
  staticpro (&Qaltgr);
  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);
  Qf1 = intern ("f1");
  staticpro (&Qf1);
  Qf10 = intern ("f10");
  staticpro (&Qf10);
  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);
  Qmenu_bar_time_out = intern ("menu-bar-time-out");
  staticpro (&Qmenu_bar_time_out);
  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);
  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 (&Sunfocus_frame);
  defsubr (&Spm_display_color_p);
  defsubr (&Spm_display_planes);
  defsubr (&Spm_list_fonts);
  defsubr (&Spm_color_defined_p);
  defsubr (&Spm_create_frame);
  defsubr (&Spm_open_connection);
  defsubr (&Spm_get_drop);
  defsubr (&Spm_file_dialog);
  defsubr (&Sx_close_current_connection);

  init_pm_parm_symbols ();
}