xmenu.c 23 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* X Communication module for terminals which understand the X protocol.
Jim Blandy's avatar
Jim Blandy committed
2
   Copyright (C) 1986, 1988, 1993 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7

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
8
the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
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.  */

/* X pop-up deck-of-cards menu facility for gnuemacs.
 *
 * Written by Jon Arnold and Roman Budzianowski
 * Mods and rewrite by Robert Krawitz
 *
 */

#ifdef XDEBUG
#include <stdio.h>
#endif

/* On 4.3 this loses if it comes after xterm.h.  */
#include <signal.h>
#include "config.h"
#include "lisp.h"
Jim Blandy's avatar
Jim Blandy committed
35
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
36
#include "window.h"
Jim Blandy's avatar
Jim Blandy committed
37
#include "keyboard.h"
38
#include "blockinput.h"
Jim Blandy's avatar
Jim Blandy committed
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65

/* This may include sys/types.h, and that somehow loses
   if this is not done before the other system files.  */
#include "xterm.h"

/* Load sys/types.h if not already loaded.
   In some systems loading it twice is suicidal.  */
#ifndef makedev
#include <sys/types.h>
#endif

#include "dispextern.h"

#ifdef HAVE_X11
#include "../oldXMenu/XMenu.h"
#else
#include <X/XMenu.h>
#endif

#define min(x,y) (((x) < (y)) ? (x) : (y))
#define max(x,y) (((x) > (y)) ? (x) : (y))

#define NUL 0

#ifndef TRUE
#define TRUE 1
#define FALSE 0
66
#endif /* TRUE */
Jim Blandy's avatar
Jim Blandy committed
67 68 69 70 71 72 73

#ifdef HAVE_X11
extern Display *x_current_display;
#else
#define	ButtonReleaseMask ButtonReleased
#endif /* not HAVE_X11 */

74
extern Lisp_Object Qmenu_enable;
Jim Blandy's avatar
Jim Blandy committed
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
Lisp_Object xmenu_show ();
extern int x_error_handler ();

/*************************************************************/

#if 0
/* Ignoring the args is easiest.  */
xmenu_quit ()
{
  error ("Unknown XMenu error");
}
#endif

DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0,
  "Pop up a deck-of-cards menu and return user's selection.\n\
90 91
POSITION is a position specification.  This is either a mouse button event\n\
or a list ((XOFFSET YOFFSET) WINDOW)\n\
Jim Blandy's avatar
Jim Blandy committed
92
where XOFFSET and YOFFSET are positions in characters from the top left\n\
93
corner of WINDOW's frame.  (WINDOW may be a frame object instead of a window.)\n\
Jim Blandy's avatar
Jim Blandy committed
94 95 96
This controls the position of the center of the first line\n\
in the first pane of the menu, not the top left of the menu as a whole.\n\
\n\
97 98 99 100 101 102
MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.\n\
The menu items come from key bindings that have a menu string as well as\n\
a definition; actually, the \"definition\" in such a key binding looks like\n\
\(STRING . REAL-DEFINITION).  To give the menu a title, put a string into\n\
the keymap as a top-level element.\n\n\
You can also use a list of keymaps as MENU.\n\
103 104 105
  Then each keymap makes a separate pane.\n\
When MENU is a keymap or a list of keymaps, the return value\n\
is a list of events.\n\n\
106
Alternatively, you can specify a menu of multiple panes\n\
107 108 109 110
  with a list of the form (TITLE PANE1 PANE2...),\n\
where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
Each ITEM is normally a cons cell (STRING . VALUE);\n\
but a string can appear as an item--that makes a nonselectable line\n\
111 112
in the menu.\n\
With this form of menu, the return value is VALUE from the chosen item.")
113 114
  (position, menu)
     Lisp_Object position, menu;
Jim Blandy's avatar
Jim Blandy committed
115 116
{
  int number_of_panes;
117
  Lisp_Object XMenu_return, keymap, tem;
Jim Blandy's avatar
Jim Blandy committed
118 119 120
  int XMenu_xpos, XMenu_ypos;
  char **menus;
  char ***names;
121
  int **enables;
Jim Blandy's avatar
Jim Blandy committed
122
  Lisp_Object **obj_list;
123
  Lisp_Object *prefixes;
Jim Blandy's avatar
Jim Blandy committed
124 125 126 127 128
  int *items;
  char *title;
  char *error_name;
  Lisp_Object ltitle, selection;
  int i, j;
Jim Blandy's avatar
Jim Blandy committed
129
  FRAME_PTR f;
Jim Blandy's avatar
Jim Blandy committed
130 131
  Lisp_Object x, y, window;

132 133 134 135 136 137 138 139 140 141
  /* Decode the first argument: find the window and the coordinates.  */
  tem = Fcar (position);
  if (XTYPE (tem) == Lisp_Cons)
    {
      window = Fcar (Fcdr (position));
      x = Fcar (tem);
      y = Fcar (Fcdr (tem));
    }
  else
    {
142 143 144
      tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
      window = Fcar (tem);	     /* POSN_WINDOW (tem) */
      tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
145 146 147
      x = Fcar (tem);
      y = Fcdr (tem);
    }
Jim Blandy's avatar
Jim Blandy committed
148 149
  CHECK_NUMBER (x, 0);
  CHECK_NUMBER (y, 0);
150

151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
  if (XTYPE (window) == Lisp_Frame)
    {
      f = XFRAME (window);

      XMenu_xpos = 0;
      XMenu_ypos = 0;
    }
  else if (XTYPE (window) == Lisp_Window)
    {
      CHECK_LIVE_WINDOW (window, 0);
      f = XFRAME (WINDOW_FRAME (XWINDOW (window)));

      XMenu_xpos = FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left;
      XMenu_ypos = FONT_HEIGHT (f->display.x->font) * XWINDOW (window)->top;
    }

  XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x);
  XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y);
Jim Blandy's avatar
Jim Blandy committed
169

Jim Blandy's avatar
Jim Blandy committed
170 171
  XMenu_xpos += f->display.x->left_pos;
  XMenu_ypos += f->display.x->top_pos;
Jim Blandy's avatar
Jim Blandy committed
172

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
  keymap = Fkeymapp (menu);
  tem = Qnil;
  if (XTYPE (menu) == Lisp_Cons)
    tem = Fkeymapp (Fcar (menu));
  if (!NILP (keymap))
    {
      /* We were given a keymap.  Extract menu info from the keymap.  */
      Lisp_Object prompt;
      keymap = get_keymap (menu);

      /* Search for a string appearing directly as an element of the keymap.
	 That string is the title of the menu.  */
      prompt = map_prompt (keymap);
      if (!NILP (prompt))
	title = (char *) XSTRING (prompt)->data;

      /* Extract the detailed info to make one pane.  */
190 191
      number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
				      &items, &menu, 1);
192 193 194 195 196 197
      /* The menu title seems to be ignored,
	 so put it in the pane title.  */
      if (menus[0] == 0)
	menus[0] = title;
    }
  else if (!NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
198
    {
199 200 201 202 203 204 205 206 207 208 209
      /* We were given a list of keymaps.  */
      Lisp_Object prompt;
      int nmaps = XFASTINT (Flength (menu));
      Lisp_Object *maps
	= (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
      int i;
      title = 0;

      /* The first keymap that has a prompt string
	 supplies the menu title.  */
      for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
Jim Blandy's avatar
Jim Blandy committed
210
	{
211 212 213 214 215
	  maps[i++] = keymap = get_keymap (Fcar (tem));

	  prompt = map_prompt (keymap);
	  if (title == 0 && !NILP (prompt))
	    title = (char *) XSTRING (prompt)->data;
Jim Blandy's avatar
Jim Blandy committed
216
	}
217 218

      /* Extract the detailed info to make one pane.  */
219
      number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables,
220
				      &items, &prefixes, maps, nmaps);
221 222 223 224 225 226 227 228 229 230 231
      /* The menu title seems to be ignored,
	 so put it in the pane title.  */
      if (menus[0] == 0)
	menus[0] = title;
    }
  else
    {
      /* We were given an old-fashioned menu.  */
      ltitle = Fcar (menu);
      CHECK_STRING (ltitle, 1);
      title = (char *) XSTRING (ltitle)->data;
232
      prefixes = 0;
233 234
      number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables,
				       &items, Fcdr (menu));
235 236 237 238 239 240 241 242 243
    }
#ifdef XDEBUG
  fprintf (stderr, "Panes = %d\n", number_of_panes);
  for (i = 0; i < number_of_panes; i++)
    {
      fprintf (stderr, "Pane %d has lines %d title %s\n",
	       i, items[i], menus[i]);
      for (j = 0; j < items[i]; j++)
	fprintf (stderr, "    Item %d %s\n", j, names[i][j]);
Jim Blandy's avatar
Jim Blandy committed
244 245 246
    }
#endif
  BLOCK_INPUT;
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267
  {
    Window root;
    int root_x, root_y;
    int dummy_int;
    unsigned int dummy_uint;
    Window dummy_window;

    /* Figure out which root window F is on.  */
    XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root,
		  &dummy_int, &dummy_int, &dummy_uint, &dummy_uint,
		  &dummy_uint, &dummy_uint);

    /* Translate the menu co-ordinates within f to menu co-ordinates
       on that root window.  */
    if (! XTranslateCoordinates (x_current_display,
				 FRAME_X_WINDOW (f), root,
				 XMenu_xpos, XMenu_ypos, &root_x, &root_y,
				 &dummy_window))
      /* But XGetGeometry said root was the root window of f's screen!  */ 
      abort ();

268
    selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables,
269 270
			    menus, prefixes, items, number_of_panes, obj_list,
			    title, &error_name);
271
  }
Jim Blandy's avatar
Jim Blandy committed
272
  UNBLOCK_INPUT;
273
  /* fprintf (stderr, "selection = %x\n", selection);  */
Jim Blandy's avatar
Jim Blandy committed
274 275 276 277 278 279 280 281 282
  if (selection != NUL)
    {				/* selected something */
      XMenu_return = selection;
    }
  else
    {				/* nothing selected */
      XMenu_return = Qnil;
    }
  /* now free up the strings */
283
  for (i = 0; i < number_of_panes; i++)
Jim Blandy's avatar
Jim Blandy committed
284
    {
285 286 287
      xfree (names[i]);
      xfree (enables[i]);
      xfree (obj_list[i]);
Jim Blandy's avatar
Jim Blandy committed
288
    }
289 290 291 292 293
  xfree (menus);
  xfree (obj_list);
  xfree (names);
  xfree (enables);
  xfree (items);
294
  /* free (title); */
Jim Blandy's avatar
Jim Blandy committed
295 296 297 298 299 300 301 302 303 304
  if (error_name) error (error_name);
  return XMenu_return;
}

struct indices {
  int pane;
  int line;
};

Lisp_Object
305
xmenu_show (parent, startx, starty, line_list, enable_list, pane_list,
306
	    prefixes, line_cnt, pane_cnt, item_list, title, error)
Jim Blandy's avatar
Jim Blandy committed
307 308 309
     Window parent;		
     int startx, starty;	/* upper left corner position BROKEN */
     char **line_list[];   	/* list of strings for items */
310
     int *enable_list[];   	/* list of strings for items */
Jim Blandy's avatar
Jim Blandy committed
311
     char *pane_list[];		/* list of pane titles */
312
     Lisp_Object *prefixes;	/* Prefix key for each pane */
Jim Blandy's avatar
Jim Blandy committed
313 314 315 316 317 318 319 320 321 322 323 324 325 326
     char *title;
     int pane_cnt;		/* total number of panes */
     Lisp_Object *item_list[];	/* All items */
     int line_cnt[];		/* Lines in each pane */
     char **error;		/* Error returned */
{
  XMenu *GXMenu;
  int last, panes, selidx, lpane, status;
  int lines, sofar;
  Lisp_Object entry;
  /* struct indices *datap, *datap_save; */
  char *datap;
  int ulx, uly, width, height;
  int dispwidth, dispheight;
327 328 329 330

  if (pane_cnt == 0)
    return 0;

331
  BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
332 333 334 335 336
  *error = (char *) 0;		/* Initialize error pointer to null */
  GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
  if (GXMenu == NUL)
    {
      *error = "Can't create menu";
337
      UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
338 339 340
      return (0);
    }
  
341 342
  for (panes = 0, lines = 0; panes < pane_cnt;
       lines += line_cnt[panes], panes++)
Jim Blandy's avatar
Jim Blandy committed
343 344
    ;
  /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
345
  /* datap = (char *) xmalloc (lines * sizeof (char));
Jim Blandy's avatar
Jim Blandy committed
346 347
    datap_save = datap;*/
  
348 349
  for (panes = 0, sofar = 0; panes < pane_cnt;
       sofar += line_cnt[panes], panes++)
Jim Blandy's avatar
Jim Blandy committed
350 351 352 353 354 355 356
    {
      /* create all the necessary panes */
      lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
      if (lpane == XM_FAILURE)
	{
	  XMenuDestroy (XDISPLAY GXMenu);
	  *error = "Can't create pane";
357
	  UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
358 359
	  return (0);
	}
360
      for (selidx = 0; selidx < line_cnt[panes]; selidx++)
Jim Blandy's avatar
Jim Blandy committed
361 362 363 364 365
	{
	  /* add the selection stuff to the menus */
	  /* datap[selidx+sofar].pane = panes;
	     datap[selidx+sofar].line = selidx; */
	  if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
366 367
				 line_list[panes][selidx],
				 enable_list[panes][selidx])
Jim Blandy's avatar
Jim Blandy committed
368 369 370 371 372 373
	      == XM_FAILURE)
	    {
	      XMenuDestroy (XDISPLAY GXMenu);
	      /* free (datap); */
	      *error = "Can't add selection to menu";
	      /* error ("Can't add selection to menu"); */
374
	      UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413
	      return (0);
	    }
	}
    }
  /* all set and ready to fly */
  XMenuRecompute (XDISPLAY GXMenu);
  dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
  dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
  startx = min (startx, dispwidth);
  starty = min (starty, dispheight);
  startx = max (startx, 1);
  starty = max (starty, 1);
  XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
	       &ulx, &uly, &width, &height);
  if (ulx+width > dispwidth)
    {
      startx -= (ulx + width) - dispwidth;
      ulx = dispwidth - width;
    }
  if (uly+height > dispheight)
    {
      starty -= (uly + height) - dispheight;
      uly = dispheight - height;
    }
  if (ulx < 0) startx -= ulx;
  if (uly < 0) starty -= uly;
    
  XMenuSetFreeze (GXMenu, TRUE);
  panes = selidx = 0;
  
  status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
			  startx, starty, ButtonReleaseMask, &datap);
  switch (status)
    {
    case XM_SUCCESS:
#ifdef XDEBUG
      fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
#endif
      entry = item_list[panes][selidx];
414 415 416 417 418 419
      if (prefixes != 0)
	{
	  entry = Fcons (entry, Qnil);
	  if (!NILP (prefixes[panes]))
	    entry = Fcons (prefixes[panes], entry);
	}
Jim Blandy's avatar
Jim Blandy committed
420 421
      break;
    case XM_FAILURE:
422
      /* free (datap_save); */
Jim Blandy's avatar
Jim Blandy committed
423 424 425 426 427 428 429 430 431
      XMenuDestroy (XDISPLAY GXMenu);
      *error = "Can't activate menu";
      /* error ("Can't activate menu"); */
    case XM_IA_SELECT:
    case XM_NO_SELECT:
      entry = Qnil;
      break;
    }
  XMenuDestroy (XDISPLAY GXMenu);
432
  UNBLOCK_INPUT;
433
  /* free (datap_save);*/
Jim Blandy's avatar
Jim Blandy committed
434 435 436 437 438 439 440
  return (entry);
}

syms_of_xmenu ()
{
  defsubr (&Sx_popup_menu);
}
441 442

/* Construct the vectors that describe a menu
443
   and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
444 445 446 447 448 449
   Each of those four values is a vector indexed by pane number.
   Return the number of panes.

   KEYMAPS is a vector of keymaps.  NMAPS gives the length of KEYMAPS.  */

int
450
keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps)
451 452 453
     Lisp_Object ***vector;	/* RETURN all menu objects */
     char ***panes;		/* RETURN pane names */
     char ****names;		/* RETURN all line names */
454
     int ***enables;		/* RETURN enable-flags of lines */
455
     int **items;		/* RETURN number of items per pane */
456
     Lisp_Object **prefixes;	/* RETURN vector of prefix keys, per pane */
457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473
     Lisp_Object *keymaps;
     int nmaps;
{
  /* Number of panes we have made.  */
  int p = 0;
  /* Number of panes we have space for.  */
  int npanes_allocated = nmaps;
  int mapno;

  if (npanes_allocated < 4)
    npanes_allocated = 4;

  /* Make space for an estimated number of panes.  */
  *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *));
  *panes = (char **) xmalloc (npanes_allocated * sizeof (char *));
  *items = (int *) xmalloc (npanes_allocated * sizeof (int));
  *names = (char ***) xmalloc (npanes_allocated * sizeof (char **));
474
  *enables = (int **) xmalloc (npanes_allocated * sizeof (int *));
475
  *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object));
476 477 478 479 480

  /* Loop over the given keymaps, making a pane for each map.
     But don't make a pane that is empty--ignore that map instead.
     P is the number of panes we have made so far.  */
  for (mapno = 0; mapno < nmaps; mapno++)
481
    single_keymap_panes (keymaps[mapno], panes, vector, names, enables, items,
482
			 prefixes, &p, &npanes_allocated, "");
483 484 485 486 487 488 489 490 491 492

  /* Return the number of panes.  */
  return p;
}

/* This is a recursive subroutine of the previous function.
   It handles one keymap, KEYMAP.
   The other arguments are passed along
   or point to local variables of the previous function.  */

493
single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes,
494 495 496 497 498
		     p_ptr, npanes_allocated_ptr, pane_name)
     Lisp_Object keymap;
     Lisp_Object ***vector;	/* RETURN all menu objects */
     char ***panes;		/* RETURN pane names */
     char ****names;		/* RETURN all line names */
499
     int ***enables;		/* RETURN enable flags of lines */
500
     int **items;		/* RETURN number of items per pane */
501
     Lisp_Object **prefixes;	/* RETURN vector of prefix keys, per pane */
502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525
     int *p_ptr;
     int *npanes_allocated_ptr;
     char *pane_name;
{
  int i;
  Lisp_Object pending_maps;
  Lisp_Object tail, item, item1, item2, table;

  pending_maps = Qnil;

  /* Make sure we have room for another pane.  */
  if (*p_ptr == *npanes_allocated_ptr)
    {
      *npanes_allocated_ptr *= 2;

      *vector
	= (Lisp_Object **) xrealloc (*vector,
				     *npanes_allocated_ptr * sizeof (Lisp_Object *));
      *panes
	= (char **) xrealloc (*panes,
			      *npanes_allocated_ptr * sizeof (char *));
      *items
	= (int *) xrealloc (*items,
			    *npanes_allocated_ptr * sizeof (int));
526 527 528 529
      *prefixes
	= (Lisp_Object *) xrealloc (*prefixes,
				    (*npanes_allocated_ptr
				     * sizeof (Lisp_Object)));
530 531 532
      *names
	= (char ***) xrealloc (*names,
			       *npanes_allocated_ptr * sizeof (char **));
533 534 535
      *enables
	= (int **) xrealloc (*enables,
			     *npanes_allocated_ptr * sizeof (int *));
536 537 538 539 540
    }

  /* When a menu comes from keymaps, don't give names to the panes.  */
  (*panes)[*p_ptr] = pane_name;

541 542 543 544
  /* Normally put nil as pane's prefix key.
     Caller will override this if appropriate.  */
  (*prefixes)[*p_ptr] = Qnil;

545 546 547
  /* Get the length of the list level of the keymap.  */
  i = XFASTINT (Flength (keymap));

548 549 550 551
  /* Add in lengths of any arrays.  */
  for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
    if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
      i += XVECTOR (XCONS (tail)->car)->size;
552 553 554 555 556

  /* Create vectors for the names and values of the items in the pane.
     I is an upper bound for the number of items.  */
  (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
  (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *));
557
  (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int));
558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573

  /* I is now the index of the next unused slots.  */
  i = 0;
  for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
    {
      /* Look at each key binding, and if it has a menu string,
	 make a menu item from it.  */
      item = XCONS (tail)->car;
      if (XTYPE (item) == Lisp_Cons)
	{
	  item1 = XCONS (item)->cdr;
	  if (XTYPE (item1) == Lisp_Cons)
	    {
	      item2 = XCONS (item1)->car;
	      if (XTYPE (item2) == Lisp_String)
		{
574 575 576 577 578 579 580 581 582 583 584 585 586 587
		  Lisp_Object def, tem;
		  Lisp_Object enabled;

		  def = Fcdr (item1);
		  enabled = Qt;
		  if (XTYPE (def) == Lisp_Symbol)
		    {
		      /* No property, or nil, means enable.
			 Otherwise, enable if value is not nil.  */
		      tem = Fget (def, Qmenu_enable);
		      if (!NILP (tem))
			enabled = Feval (tem);
		    }
		  tem = Fkeymapp (def);
588
		  if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
589
		    pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)),
590
					  pending_maps);
591
		  else
592 593 594 595
		    {
		      (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
		      /* The menu item "value" is the key bound here.  */
		      (*vector)[*p_ptr][i] = XCONS (item)->car;
596
		      (*enables)[*p_ptr][i]
597
			= (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
598 599 600 601 602
		      i++;
		    }
		}
	    }
	}
603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618
      else if (XTYPE (item) == Lisp_Vector)
	{
	  /* Loop over the char values represented in the vector.  */
	  int len = XVECTOR (item)->size;
	  int c;
	  for (c = 0; c < len; c++)
	    {
	      Lisp_Object character;
	      XFASTINT (character) = c;
	      item1 = XVECTOR (item)->contents[c];
	      if (XTYPE (item1) == Lisp_Cons)
		{
		  item2 = XCONS (item1)->car;
		  if (XTYPE (item2) == Lisp_String)
		    {
		      Lisp_Object tem;
619 620 621 622 623 624 625 626 627 628 629 630 631 632 633
		      Lisp_Object def;
		      Lisp_Object enabled;

		      def = Fcdr (item1);
		      enabled = Qt;
		      if (XTYPE (def) == Lisp_Symbol)
			{
			  tem = Fget (def, Qmenu_enable);
			  /* No property, or nil, means enable.
			     Otherwise, enable if value is not nil.  */
			  if (!NILP (tem))
			    enabled = Feval (tem);
			}

		      tem = Fkeymapp (def);
634
		      if (XSTRING (item2)->data[0] == '@' && !NILP (tem))
635
			pending_maps = Fcons (Fcons (def, Fcons (item2, character)),
636
					      pending_maps);
637
		      else
638 639 640 641
			{
			  (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data;
			  /* The menu item "value" is the key bound here.  */
			  (*vector)[*p_ptr][i] = character;
642
			  (*enables)[*p_ptr][i]
643
			    = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0);
644 645 646 647 648 649
			  i++;
			}
		    }
		}
	    }
	}
650 651 652 653 654 655 656
    }
  /* Record the number of items in the pane.  */
  (*items)[*p_ptr] = i;

  /* If we just made an empty pane, get rid of it.  */
  if (i == 0)
    {
657 658 659
      xfree ((*vector)[*p_ptr]);
      xfree ((*names)[*p_ptr]);
      xfree ((*enables)[*p_ptr]);
660 661 662 663 664 665 666 667
    }
  /* Otherwise, advance past it.  */
  else
    (*p_ptr)++;

  /* Process now any submenus which want to be panes at this level.  */
  while (!NILP (pending_maps))
    {
668 669
      Lisp_Object elt, eltcdr;
      int panenum = *p_ptr;
670
      elt = Fcar (pending_maps);
671
      eltcdr = XCONS (elt)->cdr;
672
      single_keymap_panes (Fcar (elt), panes, vector, names, enables, items,
673
			   prefixes, p_ptr, npanes_allocated_ptr,
674
			   /* Add 1 to discard the @.  */
675 676
			   (char *) XSTRING (XCONS (eltcdr)->car)->data + 1);
      (*prefixes)[panenum] = XCONS (eltcdr)->cdr;
677 678 679 680 681
      pending_maps = Fcdr (pending_maps);
    }
}

/* Construct the vectors that describe a menu
682
   and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS.
683 684 685 686
   Each of those four values is a vector indexed by pane number.
   Return the number of panes.

   MENU is the argument that was given to Fx_popup_menu.  */
Jim Blandy's avatar
Jim Blandy committed
687

688
int
689
list_of_panes (vector, panes, names, enables, items, menu)
Jim Blandy's avatar
Jim Blandy committed
690 691 692
     Lisp_Object ***vector;	/* RETURN all menu objects */
     char ***panes;		/* RETURN pane names */
     char ****names;		/* RETURN all line names */
693
     int ***enables;		/* RETURN enable flags of lines */
Jim Blandy's avatar
Jim Blandy committed
694 695 696 697 698 699 700 701
     int **items;		/* RETURN number of items per pane */
     Lisp_Object menu;
{
  Lisp_Object tail, item, item1;
  int i;
  
  if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);

702
  i = XFASTINT (Flength (menu));
Jim Blandy's avatar
Jim Blandy committed
703 704 705 706 707

  *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
  *panes = (char **) xmalloc (i * sizeof (char *));
  *items = (int *) xmalloc (i * sizeof (int));
  *names = (char ***) xmalloc (i * sizeof (char **));
708
  *enables = (int **) xmalloc (i * sizeof (int *));
Jim Blandy's avatar
Jim Blandy committed
709

710
  for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
Jim Blandy's avatar
Jim Blandy committed
711
    {
712 713
      item = Fcdr (Fcar (tail));
      if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
Jim Blandy's avatar
Jim Blandy committed
714
#ifdef XDEBUG
715
      fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
Jim Blandy's avatar
Jim Blandy committed
716
#endif
717 718
      item1 = Fcar (Fcar (tail));
      CHECK_STRING (item1, 1);
Jim Blandy's avatar
Jim Blandy committed
719
#ifdef XDEBUG
720 721
      fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
	       XSTRING (item1)->data);
Jim Blandy's avatar
Jim Blandy committed
722
#endif
723
      (*panes)[i] = (char *) XSTRING (item1)->data;
724
      (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item);
725 726 727
      /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
	 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
	 ; */
Jim Blandy's avatar
Jim Blandy committed
728 729 730
    }
  return i;
}
731 732

/* Construct the lists of values and names for a single pane, from the
733 734
   alist PANE.  Put them in *VECTOR and *NAMES.  Put the enable flags
   int *ENABLES.   Return the number of items.  */
Jim Blandy's avatar
Jim Blandy committed
735

736
int
737
list_of_items (vector, names, enables, pane)
Jim Blandy's avatar
Jim Blandy committed
738 739
     Lisp_Object **vector;	/* RETURN menu "objects" */
     char ***names;		/* RETURN line names */
740
     int **enables;		/* RETURN enable flags of lines */
Jim Blandy's avatar
Jim Blandy committed
741 742 743 744 745 746 747
     Lisp_Object pane;
{
  Lisp_Object tail, item, item1;
  int i;

  if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);

748
  i = XFASTINT (Flength (pane));
Jim Blandy's avatar
Jim Blandy committed
749 750 751

  *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
  *names = (char **) xmalloc (i * sizeof (char *));
752
  *enables = (int *) xmalloc (i * sizeof (int));
Jim Blandy's avatar
Jim Blandy committed
753

754
  for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
Jim Blandy's avatar
Jim Blandy committed
755
    {
756
      item = Fcar (tail);
757 758 759 760 761 762 763 764 765 766 767 768 769 770 771
      if (STRINGP (item))
	{
	  (*vector)[i] = Qnil;
	  (*names)[i] = (char *) XSTRING (item)->data;
	  (*enables)[i] = -1;
	}
      else
	{
	  CHECK_CONS (item, 0);
	  (*vector)[i] = Fcdr (item);
	  item1 = Fcar (item);
	  CHECK_STRING (item1, 1);
	  (*names)[i] = (char *) XSTRING (item1)->data;
	  (*enables)[i] = 1;
	}
Jim Blandy's avatar
Jim Blandy committed
772 773 774
    }
  return i;
}