home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / e20313sr.zip / emacs / 20.3.1 / src / pmfns.c < prev    next >
C/C++ Source or Header  |  1999-07-31  |  48KB  |  1,747 lines
  1. /* pmfns.c -- xfns.c for the OS/2 Presentation Manager
  2.    Copyright (C) 1993-1996 Eberhard Mattes.
  3.    Copyright (C) 1995 Patrick Nadeau (scroll bar code).
  4.  
  5. This file is part of GNU Emacs.
  6.  
  7. GNU Emacs is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Emacs is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Emacs; see the file COPYING.  If not, write to
  19. the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20. Boston, MA 02111-1307, USA.  */
  21.  
  22. #include <stdio.h>
  23. #include "config.h"
  24. #include "lisp.h"
  25. #include "pmlib.h"
  26. #include "pmterm.h"
  27. #include "pmemacs.h"
  28. #include "frame.h"
  29. #include "window.h"
  30. #include "dispextern.h"
  31. #include "keyboard.h"
  32. #include "blockinput.h"
  33. #include "termhooks.h"
  34.  
  35. extern pmd_config pm_config;
  36. extern int pm_session_started;
  37.  
  38. extern Lisp_Object Qheight, Qicon, Qmenu_bar_lines, Qminibuffer, Qname;
  39. extern Lisp_Object Qonly, Qunsplittable, Qunderline, Qwidth;
  40.  
  41. Lisp_Object Qalt;
  42. Lisp_Object Qalt_f4;
  43. Lisp_Object Qalt_f5;
  44. Lisp_Object Qalt_f6;
  45. Lisp_Object Qalt_f7;
  46. Lisp_Object Qalt_f8;
  47. Lisp_Object Qalt_f9;
  48. Lisp_Object Qalt_f10;
  49. Lisp_Object Qalt_f11;
  50. Lisp_Object Qalt_modifier;
  51. Lisp_Object Qalt_space;
  52. Lisp_Object Qaltgr;
  53. Lisp_Object Qaltgr_modifier;
  54. Lisp_Object Qbackground_color;
  55. Lisp_Object Qbar;
  56. Lisp_Object Qborder_color;
  57. Lisp_Object Qborder_width;
  58. Lisp_Object Qbox;
  59. Lisp_Object Qcursor_blink;
  60. Lisp_Object Qcursor_type;
  61. Lisp_Object Qdisplay;
  62. Lisp_Object Qdown;
  63. Lisp_Object Qf1;
  64. Lisp_Object Qf10;
  65. Lisp_Object Qforeground_color;
  66. Lisp_Object Qframe;
  67. Lisp_Object Qhalftone;
  68. Lisp_Object Qhyper;
  69. Lisp_Object Qleft;
  70. Lisp_Object Qright;
  71. Lisp_Object Qmenu_font;
  72. Lisp_Object Qmeta;
  73. Lisp_Object Qmouse_1;
  74. Lisp_Object Qmouse_2;
  75. Lisp_Object Qmouse_3;
  76. Lisp_Object Qmouse_buttons;
  77. Lisp_Object Qnone;
  78. Lisp_Object Qparent_id;
  79. Lisp_Object Qscroll_bar_width;
  80. Lisp_Object Qshortcuts;
  81. Lisp_Object Qsuper;
  82. Lisp_Object Qtop;
  83. Lisp_Object Qvisibility;
  84. Lisp_Object Qvar_width_fonts;
  85. Lisp_Object Qvertical_scroll_bars;
  86. Lisp_Object Qvisibility;
  87. Lisp_Object Qwindow_id;
  88. Lisp_Object Qx_frame_parameter;
  89. Lisp_Object Qx_resource_name;
  90. Lisp_Object Quser_position;
  91. Lisp_Object Quser_size;
  92. Lisp_Object Qdisplay;
  93.  
  94. Lisp_Object Vpm_color_alist;
  95.  
  96.  
  97. void x_set_frame_parameters (struct frame *f, Lisp_Object alist);
  98. void x_set_name (struct frame *f, Lisp_Object name, int explicit);
  99.  
  100. /* Nonzero if we can use mouse menus.
  101.    You should not call this unless HAVE_MENUS is defined.  */
  102.  
  103. int
  104. have_menus_p ()
  105. {
  106.   return pm_session_started;
  107. }
  108.  
  109.  
  110. void
  111. check_x ()
  112. {
  113.   if (!pm_session_started)
  114.     error ("PM Emacs not in use or not initialized");
  115. }
  116.  
  117.  
  118. static struct x_display_info *
  119. check_pm_display_info (frame)
  120.      Lisp_Object frame;
  121. {
  122.   if (NILP (frame))
  123.     {
  124.       if (FRAME_X_P (selected_frame))
  125.     return FRAME_X_DISPLAY_INFO (selected_frame);
  126.       else if (pm_session_started)
  127.     return pm_display;
  128.       else
  129.     error ("PM windows are not in use or not initialized");
  130.     }
  131.   else if (STRINGP (frame))
  132.     return pm_display;
  133.   else
  134.     {
  135.       FRAME_PTR f;
  136.  
  137.       CHECK_LIVE_FRAME (frame, 0);
  138.       f = XFRAME (frame);
  139.       if (! FRAME_X_P (f))
  140.     error ("non-PM frame used");
  141.       return FRAME_X_DISPLAY_INFO (f);
  142.     }
  143. }
  144.  
  145.  
  146. void
  147. free_frame_menubar (FRAME_PTR f)
  148. {
  149.   pm_request pmr;
  150.   pm_menu pmm;
  151.  
  152.   pmr.menubar.header.type = PMR_MENUBAR;
  153.   pmr.menubar.header.frame = (unsigned long)f;
  154.   pmr.menubar.entries = 1;
  155.   pmr.menubar.size = sizeof (pmm);
  156.   pmm.type = PMMENU_END;
  157.   pm_send (&pmr, sizeof (pmr));
  158.   pm_send (&pmm, sizeof (pmm));
  159. }
  160.  
  161.  
  162. int
  163. defined_color (f, color, color_def, alloc)
  164.      FRAME_PTR f;
  165.      char *color;
  166.      XColor *color_def;
  167.      int alloc;
  168. {
  169.   Lisp_Object tem;
  170.   int r, g, b;
  171.   char *name, *p;
  172.  
  173.   if (color[0] == '#')
  174.     {
  175.       int n;
  176.       unsigned rgb = 0;
  177.  
  178.       ++color;
  179.       for (n = 0; n < 6; ++n)
  180.         {
  181.           rgb <<= 4;
  182.           if (*color >= '0' && *color <= '9')
  183.             rgb |= *color - '0';
  184.           else if (*color >= 'a' && *color <= 'f')
  185.             rgb |= *color - 'a' + 10;
  186.           else if (*color >= 'A' && *color <= 'F')
  187.             rgb |= *color - 'A' + 10;
  188.           else
  189.             return 0;
  190.           ++color;
  191.         }
  192.       if (*color != 0)
  193.         return 0;
  194.       color_def->pixel = rgb;
  195.       return 1;
  196.     }
  197.   if (strnicmp (color, "rgbi:", 5) == 0)
  198.     {
  199.       double fr, fg, fb;
  200.       int n;
  201.  
  202.       if (sscanf (color + 5, "%lf/%lf/%lf%n", &fr, &fg, &fb, &n) != 3
  203.           || n != strlen (color + 5)
  204.           || fr < 0.0 || fg < 0.0 || fb < 0.0
  205.           || fr > 1.0 || fg > 1.0 || fb > 1.0)
  206.         return 0;
  207.       r = (int)(fr * 255.0);
  208.       g = (int)(fg * 255.0);
  209.       b = (int)(fb * 255.0);
  210.       color_def->pixel = (r << 16) | (g << 8) | b;
  211.       return 1;
  212.     }
  213.   name = alloca (strlen (color) + 1);
  214.   for (p = name; *color != 0; ++color)
  215.     if (*color != ' ')
  216.       *p++ = *color;
  217.   *p = 0;
  218.   tem = Fassoc (Fdowncase (build_string (name)), Vpm_color_alist);
  219.   if (CONSP (tem))
  220.     {
  221.       tem = Fcdr (tem);
  222.       if (VECTORP (tem) && XVECTOR (tem)->size == 3
  223.           && INTEGERP (XVECTOR (tem)->contents[0])
  224.           && INTEGERP (XVECTOR (tem)->contents[1])
  225.           && INTEGERP (XVECTOR (tem)->contents[2]))
  226.         {
  227.           r = XINT (XVECTOR (tem)->contents[0]);
  228.           g = XINT (XVECTOR (tem)->contents[1]);
  229.           b = XINT (XVECTOR (tem)->contents[2]);
  230.           if (!((r & ~0xff) || (g & ~0xff) || (b & ~0xff)))
  231.             {
  232.               color_def->pixel = (r << 16) | (g << 8) | b;
  233.               return 1;
  234.             }
  235.         }
  236.     }
  237.   return 0;
  238. }
  239.  
  240.  
  241. static void pm_get_framepos (FRAME_PTR f)
  242. {
  243.   pm_request pmr;
  244.   pmd_framepos answer;
  245.  
  246.   BLOCK_INPUT;
  247.   pmr.framepos.header.type = PMR_FRAMEPOS;
  248.   pmr.framepos.header.frame = (unsigned long)f;
  249.   pmr.framepos.serial = pm_serial++;
  250.   pm_send (&pmr, sizeof (pmr));
  251.   if (pm_receive (pmr.framepos.serial, &answer, NULL, 0) != NULL)
  252.     {
  253.       f->output_data.x->left_pos = answer.left;
  254.       f->output_data.x->top_pos = answer.top;
  255.       f->output_data.x->pixel_height = answer.pix_height;
  256.       f->output_data.x->pixel_width = answer.pix_width;
  257.     }
  258.   UNBLOCK_INPUT;
  259. }
  260.  
  261.  
  262. int x_set_menu_bar_lines (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  263. {
  264.   int nlines;
  265.   int olines = FRAME_MENU_BAR_LINES (f);
  266.  
  267.   if (FRAME_MINIBUF_ONLY_P (f))
  268.     return;
  269.  
  270.   if (INTEGERP (arg))
  271.     nlines = XINT (arg);
  272.   else
  273.     nlines = 0;
  274.  
  275. #ifdef USE_X_TOOLKIT
  276.   FRAME_MENU_BAR_LINES (f) = 0;
  277.   if (nlines)
  278.     FRAME_EXTERNAL_MENU_BAR (f) = 1;
  279.   else
  280.     {
  281.       if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
  282.     free_frame_menubar (f);
  283.       FRAME_EXTERNAL_MENU_BAR (f) = 0;
  284.     }
  285. #else /* not USE_X_TOOLKIT */
  286.   FRAME_MENU_BAR_LINES (f) = nlines;
  287.   x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
  288.   x_set_window_size (f, 0, FRAME_WIDTH (f),
  289.                      FRAME_HEIGHT (f) + nlines - olines);
  290. #endif /* not USE_X_TOOLKIT */
  291.   return (1);
  292. }
  293.  
  294.  
  295. static Lisp_Object pm_get_arg (Lisp_Object alist, Lisp_Object param)
  296. {
  297.   Lisp_Object tem;
  298.  
  299.   tem = Fassq (param, alist);
  300.   if (EQ (tem, Qnil))
  301.     tem = Fassq (param, Vdefault_frame_alist);
  302.   if (EQ (tem, Qnil))
  303.     return Qunbound;
  304.   return Fcdr (tem);
  305. }
  306.  
  307.  
  308. /* Record in frame F the specified or default value according to ALIST
  309.    of the parameter named PARAM (a Lisp symbol).  */
  310.  
  311. static Lisp_Object
  312. pm_default_parameter (f, alist, prop, deflt)
  313.      struct frame *f;
  314.      Lisp_Object alist;
  315.      Lisp_Object prop;
  316.      Lisp_Object deflt;
  317. {
  318.   Lisp_Object tem;
  319.  
  320.   tem = pm_get_arg (alist, prop);
  321.   if (EQ (tem, Qunbound))
  322.     tem = deflt;
  323.   x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
  324.   return tem;
  325. }
  326.  
  327.  
  328. static int pm_set_name (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  329. {
  330.   char *p1, *p2;
  331.   long n;
  332.  
  333.   x_set_name (f, arg, 1);
  334.   return (1);
  335. }
  336.  
  337.  
  338. static int pm_set_font (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  339. {
  340.   Lisp_Object bar;
  341.  
  342.   CHECK_STRING (arg, 1);
  343.  
  344.   if (XSTRING (arg)->size > 0
  345.       && XSTRING (arg)->size < sizeof (dst->default_font))
  346.     {
  347.       f->output_data.x->font = XLoadQueryFont (FRAME_X_DISPLAY (f),
  348.                                                XSTRING (arg)->data);
  349.       if (f->output_data.x->font == NULL)
  350.         error ("Font `%s' is not defined", XSTRING (arg)->data);
  351.       strcpy (dst->default_font, XSTRING (arg)->data);
  352.  
  353.       /* Invalidate the position cache of all scrollbars of this
  354.          frame.  This will reposition the scrollbars on the next
  355.          redraw. */
  356.  
  357.       for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
  358.            bar = XSCROLL_BAR (bar)->next)
  359.         XSETINT (XSCROLL_BAR (bar)->width, -1);
  360.       for (bar = FRAME_CONDEMNED_SCROLL_BARS (f); !NILP (bar);
  361.            bar = XSCROLL_BAR (bar)->next)
  362.         XSETINT (XSCROLL_BAR (bar)->width, -1);
  363.  
  364.       return 1;
  365.     }
  366.   error ("Font `%s' is not defined", XSTRING (arg)->data);
  367.   return 0;
  368. }
  369.  
  370.  
  371. static int pm_set_menu_font (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  372. {
  373.   if (NILP (arg))
  374.     {
  375.       dst->menu_font[0] = 0;
  376.       dst->menu_font_set = 1;
  377.       return 1;
  378.     }
  379.   else if (STRINGP (arg) && XSTRING (arg)->size > 0
  380.       && XSTRING (arg)->size < sizeof (dst->menu_font))
  381.     {
  382.       strcpy (dst->menu_font, XSTRING (arg)->data);
  383.       dst->menu_font_set = 1;
  384.       return 1;
  385.     }
  386.   return 0;
  387. }
  388.  
  389.  
  390. static int pm_set_visibility (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  391. {
  392.   Lisp_Object frame;
  393.  
  394.   XSETFRAME (frame, f);
  395.   if (NILP (arg))
  396.     Fmake_frame_invisible (frame, Qt);
  397.   else if (EQ (arg, Qicon))
  398.     Ficonify_frame (frame);
  399.   else
  400.     Fmake_frame_visible (frame);
  401. }
  402.  
  403.  
  404. static int pm_set_cursor_type (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  405. {
  406.   if (EQ (arg, Qbox))
  407.     dst->cursor_type = CURSORTYPE_BOX;
  408.   else if (EQ (arg, Qbar))
  409.     {
  410.       dst->cursor_type = CURSORTYPE_BAR;
  411.       dst->cursor_width = 0;
  412.     }
  413.   else if (EQ (arg, Qframe))
  414.     dst->cursor_type = CURSORTYPE_FRAME;
  415.   else if (EQ (arg, Qunderline))
  416.     dst->cursor_type = CURSORTYPE_UNDERLINE;
  417.   else if (EQ (arg, Qhalftone))
  418.     dst->cursor_type = CURSORTYPE_HALFTONE;
  419.   else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
  420.            && INTEGERP (XCONS (arg)->cdr))
  421.     {
  422.       dst->cursor_type = CURSORTYPE_BAR;
  423.       dst->cursor_width = XINT (XCONS (arg)->cdr);
  424.     }
  425.   else
  426.     return (0);
  427.   return (1);
  428. }
  429.  
  430.  
  431. static int pm_set_cursor_blink (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  432. {
  433.   dst->cursor_blink = (NILP (arg) ? PMR_FALSE : PMR_TRUE);
  434.   return (1);
  435. }
  436.  
  437.  
  438. static int pm_set_color (FRAME_PTR f, int *dst, Lisp_Object arg)
  439. {
  440.   XColor color;
  441.  
  442.   if (STRINGP (arg) && defined_color (f, XSTRING (arg)->data, &color, 0))
  443.     {
  444.       *dst = color.pixel;
  445.       recompute_basic_faces (f);
  446.       if (FRAME_VISIBLE_P (f))
  447.         redraw_frame (f);
  448.       return (1);
  449.     }
  450.   return (0);
  451. }
  452.  
  453.  
  454. static int pm_set_foreground_color (FRAME_PTR f, pm_modify *dst,
  455.                                     Lisp_Object arg)
  456. {
  457.   return (pm_set_color (f, &f->output_data.x->foreground_color, arg));
  458. }
  459.  
  460.  
  461. static int pm_set_background_color (FRAME_PTR f, pm_modify *dst,
  462.                                     Lisp_Object arg)
  463. {
  464.   int ok;
  465.  
  466.   ok = pm_set_color (f, &f->output_data.x->background_color, arg);
  467.   if (ok)
  468.     dst->background_color = f->output_data.x->background_color;
  469.   return ok;
  470. }
  471.  
  472.  
  473. static int pm_set_modifier (int *dst, Lisp_Object arg)
  474. {
  475.   if (EQ (arg, Qalt))
  476.     *dst = alt_modifier;
  477.   else if (EQ (arg, Qmeta))
  478.     *dst = meta_modifier;
  479.   else if (EQ (arg, Qsuper))
  480.     *dst = super_modifier;
  481.   else if (EQ (arg, Qhyper))
  482.     *dst = hyper_modifier;
  483.   else
  484.     return (0);
  485.   return (1);
  486. }
  487.  
  488.  
  489. static int pm_set_alt_modifier (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  490. {
  491.   return (pm_set_modifier (&dst->alt_modifier, arg));
  492. }
  493.  
  494.  
  495. static int pm_set_altgr_modifier (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  496. {
  497.   return (pm_set_modifier (&dst->altgr_modifier, arg));
  498. }
  499.  
  500.  
  501. static int pm_set_shortcuts (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  502. {
  503.  
  504.   if (EQ (arg, Qt))
  505.     dst->shortcuts = ~0;
  506.   else if (NILP (arg) || CONSP (arg))
  507.     {
  508.       Lisp_Object elt;
  509.  
  510.       dst->shortcuts = SHORTCUT_SET;
  511.       while (CONSP (arg))
  512.         {
  513.           elt = XCONS (arg)->car;
  514.           if (EQ (elt, Qalt))
  515.             dst->shortcuts |= SHORTCUT_ALT;
  516.           else if (EQ (elt, Qaltgr))
  517.             dst->shortcuts |= SHORTCUT_ALTGR;
  518.           else if (EQ (elt, Qf1))
  519.             dst->shortcuts |= SHORTCUT_F1;
  520.           else if (EQ (elt, Qf10))
  521.             dst->shortcuts |= SHORTCUT_F10;
  522.           else if (EQ (elt, Qalt_f4))
  523.             dst->shortcuts |= SHORTCUT_ALT_F4;
  524.           else if (EQ (elt, Qalt_f5))
  525.             dst->shortcuts |= SHORTCUT_ALT_F5;
  526.           else if (EQ (elt, Qalt_f6))
  527.             dst->shortcuts |= SHORTCUT_ALT_F6;
  528.           else if (EQ (elt, Qalt_f7))
  529.             dst->shortcuts |= SHORTCUT_ALT_F7;
  530.           else if (EQ (elt, Qalt_f8))
  531.             dst->shortcuts |= SHORTCUT_ALT_F8;
  532.           else if (EQ (elt, Qalt_f9))
  533.             dst->shortcuts |= SHORTCUT_ALT_F9;
  534.           else if (EQ (elt, Qalt_f10))
  535.             dst->shortcuts |= SHORTCUT_ALT_F10;
  536.           else if (EQ (elt, Qalt_f11))
  537.             dst->shortcuts |= SHORTCUT_ALT_F11;
  538.           else if (EQ (elt, Qalt_space))
  539.             dst->shortcuts |= SHORTCUT_ALT_SPACE;
  540.           else
  541.             {
  542.               dst->shortcuts = 0;
  543.               return 0;
  544.             }
  545.           arg = XCONS (arg)->cdr;
  546.         }
  547.     }
  548.   else
  549.     return 0;
  550.   return 1;
  551. }
  552.  
  553.  
  554. static int pm_set_mouse_buttons (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  555. {
  556.   char *p;
  557.   int i;
  558.  
  559.   if (STRINGP (arg) && XSTRING (arg)->size == 3)
  560.     {
  561.       p = XSTRING (arg)->data;
  562.       for (i = 0; i < 3; ++i)
  563.         if (!((p[i] >= '1' && p[i] <= '3') || p[i] == ' '))
  564.           return (0);
  565.       memcpy (dst->buttons, p, 3);
  566.       return (1);
  567.     }
  568.   return (0);
  569. }
  570.  
  571.  
  572. static int pm_set_width (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  573. {
  574.   if (INTEGERP (arg) && XINT (arg) > 0)
  575.     {
  576.       dst->width = XINT (arg);
  577.       return (1);
  578.     }
  579.   return (0);
  580. }
  581.  
  582.  
  583. static int pm_set_height (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  584. {
  585.   if (INTEGERP (arg) && XINT (arg) > 0)
  586.     {
  587.       dst->height = XINT (arg);
  588.       return (1);
  589.     }
  590.   return (0);
  591. }
  592.  
  593.  
  594. static int pm_set_top_left (FRAME_PTR f, int *offset, int *base,
  595.                             Lisp_Object arg)
  596. {
  597.   if (INTEGERP (arg))
  598.     {
  599.       *offset = XINT (arg);
  600.       *base = XINT (arg) >= 0 ? 1 : -1;
  601.       return 1;
  602.     }
  603.   else if (EQ (arg, Qminus))
  604.     {
  605.       *offset = 0;
  606.       *base = -1;
  607.       return 1;
  608.     }
  609.   else if (CONSP (arg) && EQ (XCONS (arg)->car, Qminus)
  610.            && CONSP (XCONS (arg)->cdr)
  611.            && INTEGERP (XCONS (XCONS (arg)->cdr)->car))
  612.     {
  613.       *offset = - XINT (XCONS (XCONS (arg)->cdr)->car);
  614.       *base = -1;
  615.       return 1;
  616.     }
  617.   else if (CONSP (arg) && EQ (XCONS (arg)->car, Qplus)
  618.            && CONSP (XCONS (arg)->cdr)
  619.            && INTEGERP (XCONS (XCONS (arg)->cdr)->car))
  620.     {
  621.       *offset = XINT (XCONS (XCONS (arg)->cdr)->car);
  622.       *base = 1;
  623.       return 1;
  624.     }
  625.   return 0;
  626. }
  627.  
  628.  
  629. static int pm_set_top (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  630. {
  631.   return pm_set_top_left (f, &dst->top, &dst->top_base, arg);
  632. }
  633.  
  634.  
  635. static int pm_set_left (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  636. {
  637.   return pm_set_top_left (f, &dst->left, &dst->left_base, arg);
  638. }
  639.  
  640.  
  641. static int pm_set_unsplittable (FRAME_PTR f, pm_modify *dst, Lisp_Object arg)
  642. {
  643.   f->no_split = !NILP (arg);
  644.   return (1);
  645. }
  646.  
  647.  
  648. /* Handle `vertical-scroll-bar' frame parameter.  Originally written
  649.    by Patrick Nadeau, modified by Eberhard Mattes. Jeremy Bowen 1999 */
  650.  
  651. static int pm_set_vertical_scroll_bars (FRAME_PTR f, pm_modify *dst,
  652.                                         Lisp_Object arg)
  653. {
  654.     /* =================================================
  655.        if (FRAME_CAN_HAVE_SCROLL_BARS (f))
  656.        {
  657.        FRAME_HAS_VERTICAL_SCROLL_BARS (f) = !NILP (arg);
  658.        =======================================================*/
  659.     if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
  660.         || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
  661.         || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
  662.         || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
  663.     {
  664.         FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = (NILP (arg) ?
  665.             vertical_scroll_bar_none :
  666.             /* Put scroll bars on the right by default, as is conventional
  667.                on OS/2.  */
  668.             EQ (Qleft, arg)
  669.             ? vertical_scroll_bar_left 
  670.             : vertical_scroll_bar_right);
  671.  
  672.  
  673.         /*===================================================*/
  674.         if (FRAME_HAS_VERTICAL_SCROLL_BARS (f))
  675.             dst->sb_width = FRAME_SCROLL_BAR_COLS (f);
  676.         else
  677.             dst->sb_width = 0;
  678.     }
  679.     return (1);
  680. }
  681.  
  682.  
  683. static int pm_set_scroll_bar_width (FRAME_PTR f, pm_modify *dst,
  684.                                     Lisp_Object arg)
  685. {
  686.   if (NILP (arg))
  687.     {
  688.       FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
  689.       FRAME_SCROLL_BAR_COLS (f) = 2;
  690.     }
  691.   else
  692.     return (0);
  693.   if (FRAME_HAS_VERTICAL_SCROLL_BARS (f))
  694.     dst->sb_width = FRAME_SCROLL_BAR_COLS (f);
  695.   return (1);
  696. }
  697.  
  698.  
  699. static int pm_set_var_width_fonts (FRAME_PTR f, pm_modify *dst,
  700.                                    Lisp_Object arg)
  701. {
  702.   dst->var_width_fonts = (NILP (arg) ? PMR_FALSE : PMR_TRUE);
  703.   return (1);
  704. }
  705.  
  706.  
  707. struct pm_frame_parm_table
  708. {
  709.   char *name;
  710.   int (*setter)(FRAME_PTR f, pm_modify *dst, Lisp_Object arg);
  711.   int set;
  712.   Lisp_Object obj;
  713. };
  714.  
  715.  
  716. static struct pm_frame_parm_table pm_frame_parms[] =
  717. {
  718.   {"width",                      pm_set_width, 0, 0},
  719.   {"height",                     pm_set_height, 0, 0},
  720.   {"top",                        pm_set_top, 0, 0},
  721.   {"left",                       pm_set_left, 0, 0},
  722.   {"cursor-blink",               pm_set_cursor_blink, 0, 0},
  723.   {"cursor-type",                pm_set_cursor_type, 0, 0},
  724.   {"font",                       pm_set_font, 0, 0},
  725.   {"menu-font",                  pm_set_menu_font, 0, 0},
  726.   {"foreground-color",           pm_set_foreground_color, 0, 0},
  727.   {"background-color",           pm_set_background_color, 0, 0},
  728.   {"name",                       pm_set_name, 0, 0},
  729.   {"alt-modifier",               pm_set_alt_modifier, 0, 0},
  730.   {"altgr-modifier",             pm_set_altgr_modifier, 0, 0},
  731.   {"mouse-buttons",              pm_set_mouse_buttons, 0, 0},
  732.   {"shortcuts",                  pm_set_shortcuts, 0, 0},
  733.   {"vertical-scroll-bars",       pm_set_vertical_scroll_bars, 0, 0},
  734.   {"visibility",                 pm_set_visibility, 0, 0},
  735.   {"menu-bar-lines",             x_set_menu_bar_lines, 0, 0},
  736.   {"scroll-bar-width",           pm_set_scroll_bar_width, 0, 0},
  737.   {"unsplittable",               pm_set_unsplittable, 0, 0},
  738.   {"var-width-fonts",            pm_set_var_width_fonts, 0, 0}
  739. };
  740.  
  741.  
  742. static void init_pm_parm_symbols (void)
  743. {
  744.   int i;
  745.  
  746.   for (i = 0; i < sizeof (pm_frame_parms) / sizeof (pm_frame_parms[0]); i++)
  747.     pm_frame_parms[i].obj = intern (pm_frame_parms[i].name);
  748. }
  749.  
  750.  
  751. void x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
  752. {
  753.   Lisp_Object tem;
  754.  
  755.   /* Represent negative positions (off the top or left screen edge)
  756.      in a way that Fmodify_frame_parameters will understand correctly.  */
  757.   XSETINT (tem, f->output_data.x->left_pos);
  758.   if (f->output_data.x->left_pos >= 0)
  759.     store_in_alist (alistptr, Qleft, tem);
  760.   else
  761.     store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
  762.  
  763.   XSETINT (tem, f->output_data.x->top_pos);
  764.   if (f->output_data.x->top_pos >= 0)
  765.     store_in_alist (alistptr, Qtop, tem);
  766.   else
  767.     store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
  768.  
  769.   FRAME_SAMPLE_VISIBILITY (f);
  770.   store_in_alist (alistptr, Qvisibility,
  771.           (FRAME_VISIBLE_P (f) ? Qt
  772.            : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
  773.   store_in_alist (alistptr, Qdisplay, build_string (":pm.0"));
  774. }
  775.  
  776.  
  777. void x_set_frame_parameters (struct frame *f, Lisp_Object alist)
  778. {
  779.   Lisp_Object tail;
  780.   int i;
  781.   pm_request pmr;
  782.   pm_modify more;
  783.  
  784.   more.width = 0; more.height = 0;
  785.   more.top = 0; more.top_base = 0; more.left = 0; more.left_base = 0;
  786.   more.background_color = COLOR_NONE;
  787.   more.default_font[0] = 0; more.menu_font[0] = 0; more.menu_font_set = 0;
  788.   more.cursor_type = 0; more.cursor_width = 0; more.cursor_blink = 0;
  789.   more.shortcuts = 0; more.alt_modifier = 0; more.altgr_modifier = 0;
  790.   more.sb_width = -1; more.var_width_fonts = 0;
  791.   memset (more.buttons, 0, sizeof (more.buttons));
  792.  
  793.   for (i = 0; i < sizeof (pm_frame_parms) / sizeof (pm_frame_parms[0]); i++)
  794.     pm_frame_parms[i].set = 0;
  795.  
  796.   for (tail = alist; CONSP (tail); tail = Fcdr (tail))
  797.     {
  798.       Lisp_Object elt, prop, arg;
  799.  
  800.       elt = Fcar (tail);
  801.       prop = Fcar (elt);
  802.       arg = Fcdr (elt);
  803.  
  804.       for (i = 0; i < sizeof (pm_frame_parms)/sizeof (pm_frame_parms[0]); i++)
  805.         if (EQ (prop, pm_frame_parms[i].obj))
  806.           {
  807.             if (!pm_frame_parms[i].set
  808.                 && pm_frame_parms[i].setter(f, &more, arg))
  809.               {
  810.                 store_frame_param (f, prop, arg);
  811.                 pm_frame_parms[i].set = 1;
  812.               }
  813.             break;
  814.           }
  815.       if (i >= sizeof (pm_frame_parms)/sizeof (pm_frame_parms[0]))
  816.         store_frame_param (f, prop, arg);
  817.     }
  818.  
  819.   if (more.width != 0 || more.height != 0
  820.       || more.top_base != 0 || more.left_base != 0
  821.       || more.background_color != COLOR_NONE
  822.       || more.default_font[0] != 0 || more.menu_font_set
  823.       || more.cursor_type != 0 || more.cursor_blink != 0
  824.       || more.alt_modifier != 0 || more.altgr_modifier != 0
  825.       || more.shortcuts != 0 || more.buttons[0] != 0
  826.       || more.sb_width != -1 || more.var_width_fonts != 0)
  827.     {
  828.       pmr.header.type = PMR_MODIFY;
  829.       pmr.header.frame = (unsigned long)f;
  830.       pm_send (&pmr, sizeof (pmr));
  831.       pm_send (&more, sizeof (more));
  832.       if (more.default_font[0] != 0)
  833.         recompute_basic_faces (f);
  834.     }
  835. }
  836.  
  837.  
  838. void x_set_name (struct frame *f, Lisp_Object name, int explicit)
  839. {
  840.   pm_request pmr;
  841.   char *tmp;
  842.  
  843.   if (explicit)
  844.     {
  845.       if (f->explicit_name && NILP (name))
  846.     update_mode_lines = 1;
  847.       f->explicit_name = ! NILP (name);
  848.     }
  849.   else if (f->explicit_name)
  850.     return;
  851.   if (NILP (name))
  852.     {
  853.       /* Check for no change needed in this very common case
  854.      before we do any consing.  */
  855.       if (strcmp (XSTRING (f->name)->data, "Emacs") == 0)
  856.         return;
  857.       name = build_string ("Emacs");
  858.     }
  859.   else
  860.     CHECK_STRING (name, 0);
  861.   if (!NILP (Fstring_equal (name, f->name)))
  862.     return;
  863.   if (strcmp (XSTRING (name)->data, "Emacs") == 0)
  864.     tmp = XSTRING (name)->data;
  865.   else
  866.     {
  867.       tmp = alloca (XSTRING (name)->size + 9);
  868.       strcpy (tmp, "Emacs - ");
  869.       strcpy (tmp + 8, XSTRING (name)->data);
  870.     }
  871.   pmr.name.header.type = PMR_NAME;
  872.   pmr.name.header.frame = (unsigned long)f;
  873.   pmr.name.count = strlen (tmp);
  874.   pm_send (&pmr, sizeof (pmr));
  875.   pm_send (tmp, pmr.name.count);
  876.   f->name = name;
  877. }
  878.  
  879.  
  880. void x_implicitly_set_name (struct frame *f, Lisp_Object arg,
  881.                             Lisp_Object oldval)
  882. {
  883.   x_set_name (f, arg, 0);
  884. }
  885.  
  886.  
  887. int
  888. x_pixel_width (FRAME_PTR f)
  889. {
  890.   return PIXEL_WIDTH (f);
  891. }
  892.  
  893. int
  894. x_pixel_height (FRAME_PTR f)
  895. {
  896.   return PIXEL_HEIGHT (f);
  897. }
  898.  
  899. int
  900. x_char_width (FRAME_PTR f)
  901. {
  902.   return FONT_WIDTH (f->output_data.x->font);
  903. }
  904.  
  905. int
  906. x_char_height (FRAME_PTR f)
  907. {
  908.   return FONT_HEIGHT (f->output_data.x->font);
  909. }
  910.  
  911.  
  912. int
  913. x_screen_planes (frame)
  914.      Lisp_Object frame;
  915. {
  916.   return pm_config.planes;
  917. }
  918.  
  919.  
  920. /* Borrowed from xterm.c.  */
  921.  
  922. /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
  923.    and checking validity for X.  */
  924.  
  925. FRAME_PTR
  926. check_x_frame (frame)
  927.      Lisp_Object frame;
  928. {
  929.   FRAME_PTR f;
  930.  
  931.   if (NILP (frame))
  932.     f = selected_frame;
  933.   else
  934.     {
  935.       CHECK_LIVE_FRAME (frame, 0);
  936.       f = XFRAME (frame);
  937.     }
  938.   if (! FRAME_X_P (f))
  939.     error ("non-X frame used");
  940.   return f;
  941. }
  942.  
  943.  
  944.  
  945. DEFUN ("pm-list-fonts", Fpm_list_fonts, Spm_list_fonts, 1, 3, 0,
  946.   "Return a list of the names of available fonts matching PATTERN.\n\
  947. If optional arguments FACE and FRAME are specified, return only fonts\n\
  948. the same size as FACE on FRAME.\n\
  949. \n\
  950. PATTERN is a string, perhaps with wildcard characters;\n\
  951.   the * character matches any substring, and\n\
  952.   the ? character matches any single character.\n\
  953.   PATTERN is case-insensitive.\n\
  954. FACE is a face name - a symbol.\n\
  955. \n\
  956. The return value is a list of strings, suitable as arguments to\n\
  957. set-face-font.\n\
  958. \n\
  959. The list does not include fonts Emacs can't use (i.e.  proportional\n\
  960. fonts), even if they match PATTERN and FACE.")
  961.   (pattern, face, frame)
  962.     Lisp_Object pattern, face, frame;
  963. {
  964.   pm_request pmr;
  965.   pmd_fontlist *answer;
  966.   unsigned char *buf, *p;
  967.   Lisp_Object *list;
  968.   int i, len, n, count;
  969.   FRAME_PTR f;
  970.  
  971.   check_x ();
  972.   CHECK_STRING (pattern, 0);
  973.   if (!NILP (face))
  974.     CHECK_SYMBOL (face, 1);
  975.   if (!NILP (frame))
  976.     CHECK_LIVE_FRAME (frame, 2);
  977.  
  978.   f = NILP (frame) ? selected_frame : XFRAME (frame);
  979.  
  980.   len = XSTRING (pattern)->size;
  981.   if (len > 511) len = 511;
  982.  
  983.   BLOCK_INPUT;
  984.   pmr.fontlist.header.type = PMR_FONTLIST;
  985.   pmr.fontlist.header.frame = (unsigned long)f;
  986.   pmr.fontlist.serial = pm_serial++;
  987.   pmr.fontlist.pattern_length = len;
  988.   pm_send (&pmr, sizeof (pmr));
  989.   pm_send (XSTRING (pattern)->data, len);
  990.  
  991.   buf = pm_receive (pmr.fontlist.serial, NULL, NULL, 0);
  992.   UNBLOCK_INPUT;
  993.   if (buf == NULL)
  994.     return Qnil;
  995.  
  996.   answer = (pmd_fontlist *)buf;
  997.   list = alloca (answer->count * sizeof (Lisp_Object));
  998.   count = 0;
  999.   p = buf + sizeof (pmd_fontlist);
  1000.  
  1001.   for (i = 0; i < answer->count; ++i)
  1002.     {
  1003.       len = *p++;
  1004.       list[count++] = make_string (p, len);
  1005.       p += len;
  1006.     }
  1007.   xfree (buf);
  1008.   return Flist (count, list);
  1009. }
  1010.  
  1011.  
  1012. DEFUN ("pm-color-defined-p", Fpm_color_defined_p, Spm_color_defined_p, 1, 2, 0,
  1013.   "Return non-nil if color COLOR is supported on frame FRAME.\n\
  1014. if FRAME is omitted or nil, use the selected frame.")
  1015.   (color, frame)
  1016.      Lisp_Object color, frame;
  1017. {
  1018.   XColor foo;
  1019.   FRAME_PTR f = check_x_frame (frame);
  1020.  
  1021.   CHECK_STRING (color, 1);
  1022.  
  1023.   if (defined_color (f, XSTRING (color)->data, &foo, 0))
  1024.     return Qt;
  1025.   else
  1026.     return Qnil;
  1027. }
  1028.  
  1029.  
  1030. DEFUN ("pm-color-values", Fpm_color_values, Spm_color_values, 1, 2, 0,
  1031.   "Return a description of the color named COLOR on frame FRAME.\n\
  1032. The value is a list of integer RGB values--(RED GREEN BLUE).\n\
  1033. These values appear to range from 0 to 65280 or 65535, depending\n\
  1034. on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
  1035. If FRAME is omitted or nil, use the selected frame.")
  1036.   (color, frame)
  1037.      Lisp_Object color, frame;
  1038. {
  1039.   XColor foo;
  1040.   FRAME_PTR f = check_x_frame (frame);
  1041.  
  1042.   CHECK_STRING (color, 1);
  1043.  
  1044.   if (defined_color (f, XSTRING (color)->data, &foo, 0))
  1045.     {
  1046.       Lisp_Object rgb[3];
  1047.  
  1048.       rgb[0] = make_number (((foo.pixel >> 16) & 0xff) * 256);
  1049.       rgb[1] = make_number (((foo.pixel >> 8) & 0xff) * 256);
  1050.       rgb[2] = make_number (((foo.pixel >> 0) & 0xff) * 256);
  1051.       return Flist (3, rgb);
  1052.     }
  1053.   else
  1054.     return Qnil;
  1055. }
  1056.  
  1057.  
  1058. DEFUN ("pm-display-color-p", Fpm_display_color_p, Spm_display_color_p, 0, 1, 0,
  1059.   "Return t if the display supports color.\n\
  1060. The optional argument DISPLAY specifies which display to ask about.\n\
  1061. DISPLAY should be either a frame or a display name (a string).\n\
  1062. If omitted or nil, that stands for the selected frame's display.")
  1063.   (display)
  1064.      Lisp_Object display;
  1065. {
  1066.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1067.  
  1068.   return Qt;
  1069. }
  1070.  
  1071.  
  1072. DEFUN ("pm-display-grayscale-p", Fpm_display_grayscale_p,
  1073.   Spm_display_grayscale_p, 0, 1, 0,
  1074.   "Return t if the X display supports shades of gray.\n\
  1075. The optional argument DISPLAY specifies which display to ask about.\n\
  1076. DISPLAY should be either a frame or a display name (a string).\n\
  1077. If omitted or nil, that stands for the selected frame's display.")
  1078.   (display)
  1079.      Lisp_Object display;
  1080. {
  1081.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1082.  
  1083.   if (pm_config.planes <= 1)
  1084.     return Qnil;
  1085.   return Qt;
  1086. }
  1087.  
  1088.  
  1089. DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
  1090.   0, 1, 0,
  1091.   "Returns the width in pixels of the X display DISPLAY.\n\
  1092. The optional argument DISPLAY specifies which display to ask about.\n\
  1093. DISPLAY should be either a frame or a display name (a string).\n\
  1094. If omitted or nil, that stands for the selected frame's display.")
  1095.   (display)
  1096.      Lisp_Object display;
  1097. {
  1098.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1099.  
  1100.   return make_number (pm_config.width);
  1101. }
  1102.  
  1103. DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
  1104.   Sx_display_pixel_height, 0, 1, 0,
  1105.   "Returns the height in pixels of the X display DISPLAY.\n\
  1106. The optional argument DISPLAY specifies which display to ask about.\n\
  1107. DISPLAY should be either a frame or a display name (a string).\n\
  1108. If omitted or nil, that stands for the selected frame's display.")
  1109.   (display)
  1110.      Lisp_Object display;
  1111. {
  1112.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1113.  
  1114.   return make_number (pm_config.height);
  1115. }
  1116.  
  1117.  
  1118. DEFUN ("pm-display-planes", Fpm_display_planes, Spm_display_planes,
  1119.   0, 1, 0,
  1120.   "Returns the number of bitplanes of the display FRAME is on.\n\
  1121. The optional argument DISPLAY specifies which display to ask about.\n\
  1122. DISPLAY should be either a frame or a display name (a string).\n\
  1123. If omitted or nil, that stands for the selected frame's display.")
  1124.   (display)
  1125.      Lisp_Object display;
  1126. {
  1127.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1128.  
  1129.   return make_number (pm_config.planes);
  1130. }
  1131.  
  1132.  
  1133. DEFUN ("pm-display-color-cells", Fpm_display_color_cells,
  1134.   Spm_display_color_cells, 0, 1, 0,
  1135.   "Returns the number of color cells of the display DISPLAY.\n\
  1136. The optional argument DISPLAY specifies which display to ask about.\n\
  1137. DISPLAY should be either a frame or a display name (a string).\n\
  1138. If omitted or nil, that stands for the selected frame's display.")
  1139.   (display)
  1140.      Lisp_Object display;
  1141. {
  1142.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1143.  
  1144.   return make_number (pm_config.color_cells);
  1145. }
  1146.  
  1147.  
  1148. DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
  1149.   "Returns the number of screens on the X server of display DISPLAY.\n\
  1150. The optional argument DISPLAY specifies which display to ask about.\n\
  1151. DISPLAY should be either a frame or a display name (a string).\n\
  1152. If omitted or nil, that stands for the selected frame's display.")
  1153.   (display)
  1154.      Lisp_Object display;
  1155. {
  1156.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1157.  
  1158.   return make_number (1);
  1159. }
  1160.  
  1161.  
  1162. DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
  1163.   "Returns the height in millimeters of the X display DISPLAY.\n\
  1164. The optional argument DISPLAY specifies which display to ask about.\n\
  1165. DISPLAY should be either a frame or a display name (a string).\n\
  1166. If omitted or nil, that stands for the selected frame's display.")
  1167.   (display)
  1168.      Lisp_Object display;
  1169. {
  1170.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1171.  
  1172.   return make_number (pm_config.height_mm);
  1173. }
  1174.  
  1175. DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
  1176.   "Returns the width in millimeters of the X display DISPLAY.\n\
  1177. The optional argument DISPLAY specifies which display to ask about.\n\
  1178. DISPLAY should be either a frame or a display name (a string).\n\
  1179. If omitted or nil, that stands for the selected frame's display.")
  1180.   (display)
  1181.      Lisp_Object display;
  1182. {
  1183.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1184.  
  1185.   return make_number (pm_config.width_mm);
  1186. }
  1187.  
  1188.  
  1189. DEFUN ("pm-open-connection", Fpm_open_connection, Spm_open_connection,
  1190.        0, 0, 0, "Open a connection to PM Emacs.")
  1191.   ()
  1192. {
  1193.   if (pm_session_started)
  1194.     error ("PM Emacs connection is already initialized");
  1195.   pm_init ();
  1196.   return Qnil;
  1197. }
  1198.  
  1199.  
  1200. /* This function is called by kill-emacs, see emacs.c. */
  1201.  
  1202. DEFUN ("x-close-connection", Fx_close_connection,
  1203.        Sx_close_connection, 1, 1, 0,
  1204.    "Close the connection to DISPLAY's X server.\n\
  1205. For DISPLAY, specify either a frame or a display name (a string).\n\
  1206. If DISPLAY is nil, that stands for the selected frame's display.")
  1207.   (display)
  1208.   Lisp_Object display;
  1209. {
  1210.   struct x_display_info *dpyinfo = check_pm_display_info (display);
  1211.  
  1212.   if (dpyinfo->reference_count > 0)
  1213.     error ("Display still has frames on it");
  1214.   pm_shutdown ();
  1215.   return Qnil;
  1216. }
  1217.  
  1218.  
  1219. DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
  1220.   "Return the list of display names that Emacs has connections to.")
  1221.   ()
  1222. {
  1223.   if (pm_session_started)
  1224.     return Fcons (build_string (":pm.0"), Qnil);
  1225.   else
  1226.     return Qnil;
  1227. }
  1228.  
  1229.  
  1230. Lisp_Object
  1231. x_get_focus_frame (frame)
  1232.      struct frame *frame;
  1233. {
  1234.   struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
  1235.   Lisp_Object tem;
  1236.  
  1237.   /*TODO*/
  1238.   XSETFRAME (tem, selected_frame);
  1239.   return tem;
  1240. }
  1241.  
  1242.  
  1243. DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
  1244.   "Set the focus on FRAME.")
  1245.   (frame)
  1246.      Lisp_Object frame;
  1247. {
  1248.   CHECK_LIVE_FRAME (frame, 0);
  1249.  
  1250.   if (FRAME_X_P (XFRAME (frame)))
  1251.     {
  1252.       x_focus_on_frame (XFRAME (frame));
  1253.       return frame;
  1254.     }
  1255.  
  1256.   return Qnil;
  1257. }
  1258.  
  1259.  
  1260. DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
  1261.   "If a frame has been focused, release it.")
  1262.   ()
  1263. {
  1264.   return Qnil;
  1265. }
  1266.  
  1267.  
  1268. DEFUN ("pm-create-frame", Fpm_create_frame, Spm_create_frame,
  1269.        1, 1, 0,
  1270.   "Make a new PM window, which is called a \"frame\" in Emacs terms.\n\
  1271. Return an Emacs frame object.\n\
  1272. ALIST is an alist of frame parameters.\n\
  1273. If the parameters specify that the frame should not have a minibuffer,\n\
  1274. and do not specify a specific minibuffer window to use,\n\
  1275. then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
  1276. be shared by the new frame.\n\
  1277. \n\
  1278. This function is an internal primitive--use `make-frame' instead.")
  1279.   (parms)
  1280.      Lisp_Object parms;
  1281. {
  1282.   struct frame *f;
  1283.   Lisp_Object frame, name, tem;
  1284.   int minibuffer_only;
  1285.   int width, height;
  1286.   int count = specpdl_ptr - specpdl;
  1287.   struct gcpro gcpro1, gcpro2, gcpro3;
  1288.   pm_request pmr;
  1289.   Lisp_Object display;
  1290.   struct kboard *kb;
  1291.  
  1292.   check_x ();
  1293.  
  1294.   kb = &the_only_kboard;
  1295.   display = Qnil;
  1296.  
  1297.   name = pm_get_arg (parms, Qname);
  1298.   if (!STRINGP (name) && !EQ (name, Qunbound) && !NILP (name))
  1299.     error ("Invalid frame name--not a string or nil");
  1300.  
  1301.   /* make_frame_without_minibuffer can run Lisp code and garbage collect.  */
  1302.   frame = Qnil;
  1303.   GCPRO3 (parms, name, frame);
  1304.  
  1305.   minibuffer_only = 0;
  1306.   tem = pm_get_arg (parms, Qminibuffer);
  1307.   if (EQ (tem, Qnone) || NILP (tem))
  1308.     f = make_frame_without_minibuffer (Qnil, kb, display);
  1309.   else if (EQ (tem, Qonly))
  1310.     {
  1311.       f = make_minibuffer_frame ();
  1312.       minibuffer_only = 1;
  1313.     }
  1314.   else if (WINDOWP (tem))
  1315.     f = make_frame_without_minibuffer (tem, kb, display);
  1316.   else
  1317.     f = make_frame (1);
  1318.  
  1319.   XSETFRAME (frame, f);
  1320.  
  1321.   FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
  1322.  
  1323.   f->output_method = output_x_window;
  1324.   f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
  1325.   bzero (f->output_data.x, sizeof (struct x_output));
  1326.  
  1327.   FRAME_X_DISPLAY_INFO (f) = pm_display;
  1328.  
  1329.   /* Note that the frame has no physical cursor right now.  */
  1330.   f->phys_cursor_x = -1;
  1331.  
  1332.   /* Set the name; the functions to which we pass f expect the name to
  1333.      be set.  */
  1334.   if (EQ (name, Qunbound) || NILP (name))
  1335.     {
  1336.       f->name = build_string ("Emacs");
  1337.       f->explicit_name = 0;
  1338.     }
  1339.   else
  1340.     {
  1341.       f->name = name;
  1342.       f->explicit_name = 1;
  1343.     }
  1344.  
  1345.   f->output_data.x->font = NULL;
  1346.   f->output_data.x->pixel_height = 0;
  1347.   f->output_data.x->pixel_width = 0;
  1348.   f->output_data.x->line_height = 1; /* TODO */
  1349.   tem = pm_get_arg (parms, Qheight);
  1350.   if (EQ (tem, Qunbound))
  1351.     tem = pm_get_arg (parms, Qwidth);
  1352.   if (EQ (tem, Qunbound))
  1353.     {
  1354.       width = 80; height = 25;
  1355.     }
  1356.   else
  1357.     {
  1358.       tem = pm_get_arg (parms, Qheight);
  1359.       if (EQ (tem, Qunbound))
  1360.         error ("Height not specified");
  1361.       CHECK_NUMBER (tem, 0);
  1362.       height = XINT (tem);
  1363.  
  1364.       tem = pm_get_arg (parms, Qwidth);
  1365.       if (EQ (tem, Qunbound))
  1366.         error ("Width not specified");
  1367.       CHECK_NUMBER (tem, 0);
  1368.       width = XINT (tem);
  1369.     }
  1370.  
  1371.   pm_add_frame (f);
  1372.  
  1373.   pmr.create.header.type = PMR_CREATE;
  1374.   pmr.create.header.frame = (unsigned long)f;
  1375.   pmr.create.height = height;
  1376.   pmr.create.width = width;
  1377.   pm_send (&pmr, sizeof (pmr));
  1378.  
  1379.   pm_default_parameter (f, parms, Qvar_width_fonts, Qnil);
  1380.   pm_default_parameter (f, parms, Qforeground_color, build_string ("black"));
  1381.   pm_default_parameter (f, parms, Qbackground_color, build_string ("white"));
  1382.   pm_default_parameter (f, parms, Qfont, build_string (DEFAULT_FONT));
  1383.  
  1384.   {
  1385.     Lisp_Object name;
  1386.     int explicit = f->explicit_name;
  1387.  
  1388.     f->explicit_name = 0;
  1389.     name = f->name;
  1390.     f->name = Qnil;
  1391.     x_set_name (f, name, explicit);
  1392.   }
  1393.  
  1394.   init_frame_faces (f);
  1395.  
  1396.   pm_default_parameter (f, parms, Qcursor_type, Qbox);
  1397.   pm_default_parameter (f, parms, Qcursor_blink, Qt);
  1398.   pm_default_parameter (f, parms, Qshortcuts, Qnil);
  1399.   pm_default_parameter (f, parms, Qalt_modifier, Qmeta);
  1400.   pm_default_parameter (f, parms, Qaltgr_modifier, Qalt);
  1401.   pm_default_parameter (f, parms, Qmouse_buttons, build_string ("132"));
  1402.  
  1403.   f->height = f->width = 0;
  1404.   change_frame_size (f, height, width, 1, 0);
  1405.  
  1406.   pm_default_parameter (f, parms, Qmenu_font, Qnil);
  1407.   pm_default_parameter (f, parms, Qmenu_bar_lines, make_number (1));
  1408.   pm_default_parameter (f, parms, Qtop, Qnil);
  1409.   pm_default_parameter (f, parms, Qleft, Qnil);
  1410.   pm_default_parameter (f, parms, Qscroll_bar_width, Qnil);
  1411.   pm_default_parameter (f, parms, Qvertical_scroll_bars, Qt);
  1412.  
  1413.   if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
  1414.     initialize_frame_menubar (f);
  1415.  
  1416.   tem = pm_get_arg (parms, Qunsplittable);
  1417.   f->no_split = minibuffer_only || EQ (tem, Qt);
  1418.  
  1419.   UNGCPRO;
  1420.  
  1421.   Vframe_list = Fcons (frame, Vframe_list);
  1422.  
  1423.   /* Now that the frame is official, it counts as a reference to
  1424.      its display.  */
  1425.   FRAME_X_DISPLAY_INFO (f)->reference_count++;
  1426.  
  1427.   /* Make the window appear on the frame and enable display,
  1428.      unless the caller says not to.  */
  1429.   {
  1430.     Lisp_Object visibility;
  1431.  
  1432.     visibility = pm_get_arg (parms, Qvisibility);
  1433.     if (EQ (visibility, Qunbound))
  1434.       visibility = Qt;
  1435.  
  1436.     if (EQ (visibility, Qicon))
  1437.       x_iconify_frame (f);
  1438.     else if (! NILP (visibility))
  1439.       x_make_frame_visible (f);
  1440.     else
  1441.       /* Must have been Qnil.  */
  1442.       ;
  1443.   }
  1444.  
  1445.   pmr.header.type = PMR_CREATEDONE;
  1446.   pmr.header.frame = (unsigned long)f;
  1447.   pm_send (&pmr, sizeof (pmr));
  1448.  
  1449.   pm_get_framepos (f);
  1450.  
  1451.   return unbind_to (count, frame);
  1452. }
  1453.  
  1454.  
  1455. /* Extract the event symbol sans modifiers from an event.  Used in
  1456.    xmenu.c */
  1457.  
  1458. int pm_event_button (Lisp_Object position)
  1459. {
  1460.   Lisp_Object head, els, ev;
  1461.  
  1462.   head = Fcar (position);           /* EVENT_HEAD (position) */
  1463.   els = Fget (head, Qevent_symbol_elements);
  1464.   if (Fmemq (Qdown, Fcdr (els)))
  1465.     {
  1466.       ev = Fcar (els);
  1467.       if (EQ (ev, Qmouse_1))
  1468.         return 1;
  1469.       else if (EQ (ev, Qmouse_2))
  1470.         return 2;
  1471.       else if (EQ (ev, Qmouse_3))
  1472.         return 3;
  1473.     }
  1474.   return 0;
  1475. }
  1476.  
  1477.  
  1478. DEFUN ("pm-get-drop", Fpm_get_drop, Spm_get_drop, 1, 1, 0,
  1479.   "Get name of dropped object.\n\
  1480. TIMESTAMP is the timestamp of the event.\n\
  1481. Return nil if there is no such object.")
  1482.   (timestamp)
  1483.      Lisp_Object timestamp;
  1484. {
  1485.   pm_request pmr;
  1486.   char name[260];               /* CCHMAXPATH */
  1487.   void *buf;
  1488.   int size;
  1489.  
  1490.   check_x ();
  1491.  
  1492.   CHECK_NUMBER (timestamp, 0);
  1493.  
  1494.   BLOCK_INPUT;
  1495.   pmr.drop.header.type = PMR_DROP;
  1496.   pmr.drop.header.frame = 0;
  1497.   pmr.drop.serial = pm_serial++;
  1498.   pmr.drop.cookie = XINT (timestamp);
  1499.   pm_send (&pmr, sizeof (pmr));
  1500.   buf = pm_receive (pmr.drop.serial, name, &size, 0);
  1501.   UNBLOCK_INPUT;
  1502.   if (buf == NULL || size == 0)
  1503.     return Qnil;
  1504.   return make_string (name, size);
  1505. }
  1506.  
  1507.  
  1508. /* Return a list of code pages supported by PM. */
  1509.  
  1510. Lisp_Object pm_list_code_pages (void)
  1511. {
  1512.   pm_request pmr;
  1513.   int *buf;
  1514.   int i, size;
  1515.   Lisp_Object list;
  1516.  
  1517.   BLOCK_INPUT;
  1518.   pmr.cplist.header.type = PMR_CPLIST;
  1519.   pmr.cplist.header.frame = 0;
  1520.   pmr.cplist.serial = pm_serial++;
  1521.   pm_send (&pmr, sizeof (pmr));
  1522.   buf = pm_receive (pmr.cplist.serial, NULL, &size, 0);
  1523.   UNBLOCK_INPUT;
  1524.   if (buf == NULL)
  1525.     return Qnil;
  1526.   list = Qnil;
  1527.   for (i = size / sizeof (int) - 1; i >= 1; --i)
  1528.     list = Fcons (make_number (buf[i]), list);
  1529.   xfree (buf);
  1530.   return list;
  1531. }
  1532.  
  1533.  
  1534. /* Send the new code page to pmemacs.exe, recompute all faces, and
  1535.    redraw all frames.  Return zero on error. */
  1536.  
  1537. int pm_set_code_page (int cp)
  1538. {
  1539.   pm_request pmr;
  1540.   void *buf;
  1541.   int ok;
  1542.  
  1543.   BLOCK_INPUT;
  1544.   pmr.codepage.header.type = PMR_CODEPAGE;
  1545.   pmr.codepage.header.frame = 0;
  1546.   pmr.codepage.codepage = cp;
  1547.   pmr.codepage.serial = pm_serial++;
  1548.   pm_send (&pmr, sizeof (pmr));
  1549.   buf = pm_receive (pmr.codepage.serial, &ok, NULL, 0);
  1550.   UNBLOCK_INPUT;
  1551.   if (buf == NULL || !ok)
  1552.     return 0;
  1553.   clear_face_cache ();          /* Recompute all faces */
  1554.   Fredraw_display ();
  1555.   return 1;
  1556. }
  1557.  
  1558.  
  1559. DEFUN ("pm-file-dialog", Fpm_file_dialog, Spm_file_dialog, 3, 7, 0,
  1560.   "Show and process a file dialog on frame FRAME with TITLE.\n\
  1561. If FRAME is nil, use the current frame.  The default directory is DIR,\n\
  1562. which is not expanded---you must call `expand-file-name' yourself.\n\
  1563. The initial value of the file-name entryfield is DEFAULT or empty if\n\
  1564. DEFAULT is nil.  Fifth arg MUSTMATCH non-nil means require existing\n\
  1565. file's name.  Sixth arg SAVEAS non-nil creates a Save As dialog instead\n\
  1566. of a Open dialog.  Seventh arg BUTTON specifies text to for the OK button,\n\
  1567. the default is \"OK\".\n\
  1568. Return the select file name as string.  Return nil, if no file name was\n\
  1569. selected.")
  1570.   (frame, title, dir, defalt, mustmatch, saveas, button)
  1571.      Lisp_Object frame, title, dir, defalt, mustmatch, saveas, button;
  1572. {
  1573.   pm_request pmr;
  1574.   pm_filedialog more;
  1575.   char name[260];               /* CCHMAXPATH */
  1576.   void *buf;
  1577.   int size;
  1578.   FRAME_PTR f;
  1579.  
  1580.   check_x ();
  1581.  
  1582.   if (NILP (frame))
  1583.     f = selected_frame;
  1584.   else
  1585.     {
  1586.       CHECK_LIVE_FRAME (frame, 0);
  1587.       f = XFRAME (frame);
  1588.     }
  1589.  
  1590.   CHECK_STRING (title, 1);
  1591.   CHECK_STRING (dir, 2);
  1592.   if (!NILP (defalt))
  1593.     CHECK_STRING (defalt, 3);
  1594.   if (!NILP (button))
  1595.     CHECK_STRING (button, 5);
  1596.  
  1597.   BLOCK_INPUT;
  1598.   pmr.header.type = PMR_FILEDIALOG;
  1599.   pmr.header.frame = (unsigned long)f;
  1600.   more.serial = pm_serial++;
  1601.   more.save_as = !NILP (saveas);
  1602.   more.must_match = !NILP (mustmatch);
  1603.   _strncpy (more.title, XSTRING (title)->data, sizeof (more.title));
  1604.   _strncpy (more.dir, XSTRING (dir)->data, sizeof (more.dir));
  1605.   if (NILP (defalt))
  1606.     more.defalt[0] = 0;
  1607.   else
  1608.     _strncpy (more.defalt, XSTRING (defalt)->data, sizeof (more.defalt));
  1609.   if (NILP (button))
  1610.     strcpy (more.ok_button, "OK");
  1611.   else
  1612.     _strncpy (more.ok_button, XSTRING (button)->data);
  1613.   pm_send (&pmr, sizeof (pmr));
  1614.   pm_send (&more, sizeof (more));
  1615.  
  1616.   buf = pm_receive (more.serial, name, &size, 1);
  1617.   UNBLOCK_INPUT;
  1618.   if (buf == NULL || size == 0)
  1619.     return Qnil;
  1620.   return make_string (name, size);
  1621. }
  1622.  
  1623.  
  1624. void x_sync (frame)
  1625.      Lisp_Object frame;
  1626. {
  1627. }
  1628.  
  1629.  
  1630. void syms_of_xfns ()
  1631. {
  1632.   Qalt = intern ("alt");
  1633.   staticpro (&Qalt);
  1634.   Qalt_f4 = intern ("alt-f4");
  1635.   staticpro (&Qalt_f4);
  1636.   Qalt_f5 = intern ("alt-f5");
  1637.   staticpro (&Qalt_f5);
  1638.   Qalt_f6 = intern ("alt-f6");
  1639.   staticpro (&Qalt_f6);
  1640.   Qalt_f7 = intern ("alt-f7");
  1641.   staticpro (&Qalt_f7);
  1642.   Qalt_f8 = intern ("alt-f8");
  1643.   staticpro (&Qalt_f8);
  1644.   Qalt_f9 = intern ("alt-f9");
  1645.   staticpro (&Qalt_f9);
  1646.   Qalt_f10 = intern ("alt-f10");
  1647.   staticpro (&Qalt_f10);
  1648.   Qalt_f11 = intern ("alt-f11");
  1649.   staticpro (&Qalt_f11);
  1650.   Qalt_modifier = intern ("alt-modifier");
  1651.   staticpro (&Qalt_modifier);
  1652.   Qalt_space = intern ("alt-space");
  1653.   staticpro (&Qalt_space);
  1654.   Qaltgr = intern ("altgr");
  1655.   staticpro (&Qaltgr);
  1656.   Qaltgr_modifier = intern ("altgr-modifier");
  1657.   staticpro (&Qaltgr_modifier);
  1658.   Qbackground_color = intern ("background-color");
  1659.   staticpro (&Qbackground_color);
  1660.   Qbar = intern ("bar");
  1661.   staticpro (&Qbar);
  1662.   Qbox = intern ("box");
  1663.   staticpro (&Qbox);
  1664.   Qcursor_blink = intern ("cursor-blink");
  1665.   staticpro (&Qcursor_blink);
  1666.   Qcursor_type = intern ("cursor-type");
  1667.   staticpro (&Qcursor_type);
  1668.   Qdisplay = intern ("display");
  1669.   staticpro (&Qdisplay);
  1670.   Qdown = intern ("down");
  1671.   staticpro (&Qdown);
  1672.   Qf1 = intern ("f1");
  1673.   staticpro (&Qf1);
  1674.   Qf10 = intern ("f10");
  1675.   staticpro (&Qf10);
  1676.   Qforeground_color = intern ("foreground-color");
  1677.   staticpro (&Qforeground_color);
  1678.   Qframe = intern ("frame");
  1679.   staticpro (&Qframe);
  1680.   Qhalftone = intern ("halftone");
  1681.   staticpro (&Qhalftone);
  1682.   Qhyper = intern ("hyper");
  1683.   staticpro (&Qhyper);
  1684.   Qleft = intern ("left");
  1685.   staticpro (&Qleft);
  1686.   Qmenu_font = intern ("menu-font");
  1687.   staticpro (&Qmenu_font);
  1688.   Qmeta = intern ("meta");
  1689.   staticpro (&Qmeta);
  1690.   Qmouse_1 = intern ("mouse-1");
  1691.   staticpro (&Qmouse_1);
  1692.   Qmouse_2 = intern ("mouse-2");
  1693.   staticpro (&Qmouse_2);
  1694.   Qmouse_3 = intern ("mouse-3");
  1695.   staticpro (&Qmouse_3);
  1696.   Qmouse_buttons = intern ("mouse-buttons");
  1697.   staticpro (&Qmouse_buttons);
  1698.   Qnone = intern ("none");
  1699.   staticpro (&Qnone);
  1700.   Qscroll_bar_width = intern ("scroll-bar-width");
  1701.   staticpro (&Qscroll_bar_width);
  1702.   Qshortcuts = intern ("shortcuts");
  1703.   staticpro (&Qshortcuts);
  1704.   Qsuper = intern ("super");
  1705.   staticpro (&Qsuper);
  1706.   Qtop = intern ("top");
  1707.   staticpro (&Qtop);
  1708.   Qvisibility = intern ("visibility");
  1709.   staticpro (&Qvisibility);
  1710.   Qvar_width_fonts = intern ("var-width-fonts");
  1711.   staticpro (&Qvar_width_fonts);
  1712.   Qvertical_scroll_bars = intern ("vertical-scroll-bars");
  1713.   staticpro (&Qvertical_scroll_bars);
  1714.  
  1715.   DEFVAR_LISP ("pm-color-alist", &Vpm_color_alist,
  1716.     "*List of elements (\"COLOR\" . [R G B]) for defining colors.\n\
  1717. \"COLOR\" is the name of the color.  Don't use upper-case letters.\n\
  1718. R, G and B are numbers in 0 through 255, indicating the intensity\n\
  1719. of the red, green and blue beams, respectively.");
  1720.   Vpm_color_alist = Qnil;
  1721.  
  1722.   Fprovide (intern ("x-toolkit"));
  1723.  
  1724.   defsubr (&Sfocus_frame);
  1725.   defsubr (&Sunfocus_frame);
  1726.   defsubr (&Spm_display_color_p);
  1727.   defsubr (&Spm_display_grayscale_p);
  1728.   defsubr (&Spm_display_planes);
  1729.   defsubr (&Spm_display_color_cells);
  1730.   defsubr (&Spm_list_fonts);
  1731.   defsubr (&Spm_color_defined_p);
  1732.   defsubr (&Spm_color_values);
  1733.   defsubr (&Spm_create_frame);
  1734.   defsubr (&Spm_open_connection);
  1735.   defsubr (&Spm_get_drop);
  1736.   defsubr (&Spm_file_dialog);
  1737.   defsubr (&Sx_close_connection);
  1738.   defsubr (&Sx_display_list);
  1739.   defsubr (&Sx_display_mm_height);
  1740.   defsubr (&Sx_display_mm_width);
  1741.   defsubr (&Sx_display_pixel_height);
  1742.   defsubr (&Sx_display_pixel_width);
  1743.   defsubr (&Sx_display_screens);
  1744.  
  1745.   init_pm_parm_symbols ();
  1746. }
  1747.