w32menu.c 68.7 KB
Newer Older
1
/* Menu support for GNU Emacs on the Microsoft W32 API.
2
   Copyright (C) 1986,88,93,94,96,98,1999,2003  Free Software Foundation, Inc.
Geoff Voelker's avatar
Geoff Voelker committed
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

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
Lute Kamstra's avatar
Lute Kamstra committed
18 19
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */
Geoff Voelker's avatar
Geoff Voelker committed
20 21

#include <config.h>
22
#include <signal.h>
23

Geoff Voelker's avatar
Geoff Voelker committed
24 25 26
#include <stdio.h>
#include "lisp.h"
#include "termhooks.h"
27
#include "keyboard.h"
28
#include "keymap.h"
Geoff Voelker's avatar
Geoff Voelker committed
29 30 31
#include "frame.h"
#include "window.h"
#include "blockinput.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
32
#include "buffer.h"
33 34
#include "charset.h"
#include "coding.h"
Geoff Voelker's avatar
Geoff Voelker committed
35 36 37 38 39 40 41 42 43 44 45 46 47

/* This may include sys/types.h, and that somehow loses
   if this is not done before the other system files.  */
#include "w32term.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"

48
#undef HAVE_DIALOGS /* TODO: Implement native dialogs.  */
49

50 51
/******************************************************************/
/* Definitions copied from lwlib.h */
Geoff Voelker's avatar
Geoff Voelker committed
52

53 54 55
typedef void * XtPointer;
typedef char Boolean;

56 57 58 59 60 61
enum button_type
{
  BUTTON_TYPE_NONE,
  BUTTON_TYPE_TOGGLE,
  BUTTON_TYPE_RADIO
};
62

63 64
/* This structure is based on the one in ../lwlib/lwlib.h, modified
   for Windows.  */
65
typedef struct _widget_value
Geoff Voelker's avatar
Geoff Voelker committed
66
{
67
  /* name of widget */
68
  Lisp_Object   lname;
69 70 71
  char*		name;
  /* value (meaning depend on widget type) */
  char*		value;
72
  /* keyboard equivalent. no implications for XtTranslations */
73
  Lisp_Object   lkey;
74
  char*		key;
75 76 77 78
  /* Help string or nil if none.
     GC finds this string through the frame's menu_bar_vector
     or through menu_items.  */
  Lisp_Object	help;
79 80 81 82
  /* true if enabled */
  Boolean	enabled;
  /* true if selected */
  Boolean	selected;
83 84
  /* The type of a button.  */
  enum button_type button_type;
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
  /* true if menu title */
  Boolean       title;
#if 0
  /* true if was edited (maintained by get_value) */
  Boolean	edited;
  /* true if has changed (maintained by lw library) */
  change_type	change;
  /* true if this widget itself has changed,
     but not counting the other widgets found in the `next' field.  */
  change_type   this_one_change;
#endif
  /* Contents of the sub-widgets, also selected slot for checkbox */
  struct _widget_value*	contents;
  /* data passed to callback */
  XtPointer	call_data;
  /* next one in the list */
  struct _widget_value*	next;
#if 0
  /* slot for the toolkit dependent part.  Always initialize to NULL. */
  void* toolkit_data;
  /* tell us if we should free the toolkit data slot when freeing the
     widget_value itself. */
  Boolean free_toolkit_data;

  /* we resource the widget_value structures; this points to the next
     one on the free list if this one has been deallocated.
   */
  struct _widget_value *free_list;
#endif
} widget_value;

116 117 118 119 120 121 122
/* Local memory management */
#define local_heap (GetProcessHeap ())
#define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
#define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))

#define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
#define free_widget_value(wv) (local_free ((wv)))
123 124 125 126 127 128 129 130

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

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif /* no TRUE */

131 132
static HMENU current_popup_menu;

133
void syms_of_w32menu ();
134
void globals_of_w32menu ();
135 136 137 138 139

typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
    IN HMENU,
    IN UINT,
    IN BOOL,
140
    IN OUT LPMENUITEMINFOA);
141 142 143 144
typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
    IN HMENU,
    IN UINT,
    IN BOOL,
145
    IN LPCMENUITEMINFOA);
146

147 148 149
GetMenuItemInfoA_Proc get_menu_item_info = NULL;
SetMenuItemInfoA_Proc set_menu_item_info = NULL;
AppendMenuW_Proc unicode_append_menu = NULL;
150

151
Lisp_Object Vmenu_updating_frame;
Geoff Voelker's avatar
Geoff Voelker committed
152

Richard M. Stallman's avatar
Richard M. Stallman committed
153 154
Lisp_Object Qdebug_on_next_call;

Geoff Voelker's avatar
Geoff Voelker committed
155
extern Lisp_Object Qmenu_bar;
156 157

extern Lisp_Object QCtoggle, QCradio;
Geoff Voelker's avatar
Geoff Voelker committed
158

Richard M. Stallman's avatar
Richard M. Stallman committed
159 160 161 162 163 164 165
extern Lisp_Object Voverriding_local_map;
extern Lisp_Object Voverriding_local_map_menu_flag;

extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;

extern Lisp_Object Qmenu_bar_update_hook;

166 167
void set_frame_menubar ();

168 169 170
static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
				Lisp_Object, Lisp_Object, Lisp_Object,
				Lisp_Object, Lisp_Object));
171
#ifdef HAVE_DIALOGS
172
static Lisp_Object w32_dialog_show ();
173
#endif
174
static Lisp_Object w32_menu_show ();
Geoff Voelker's avatar
Geoff Voelker committed
175

176 177 178 179 180
static void keymap_panes ();
static void single_keymap_panes ();
static void single_menu_item ();
static void list_of_panes ();
static void list_of_items ();
181
void w32_free_menu_strings (HWND);
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208

/* This holds a Lisp vector that holds the results of decoding
   the keymaps or alist-of-alists that specify a menu.

   It describes the panes and items within the panes.

   Each pane is described by 3 elements in the vector:
   t, the pane name, the pane's prefix key.
   Then follow the pane's items, with 5 elements per item:
   the item string, the enable flag, the item's value,
   the definition, and the equivalent keyboard key's description string.

   In some cases, multiple levels of menus may be described.
   A single vector slot containing nil indicates the start of a submenu.
   A single vector slot containing lambda indicates the end of a submenu.
   The submenu follows a menu item which is the way to reach the submenu.

   A single vector slot containing quote indicates that the
   following items should appear on the right of a dialog box.

   Using a Lisp vector to hold this information while we decode it
   takes care of protecting all the data from GC.  */

#define MENU_ITEMS_PANE_NAME 1
#define MENU_ITEMS_PANE_PREFIX 2
#define MENU_ITEMS_PANE_LENGTH 3

209 210 211 212 213 214 215 216 217 218 219 220
enum menu_item_idx
{
  MENU_ITEMS_ITEM_NAME = 0,
  MENU_ITEMS_ITEM_ENABLE,
  MENU_ITEMS_ITEM_VALUE,
  MENU_ITEMS_ITEM_EQUIV_KEY,
  MENU_ITEMS_ITEM_DEFINITION,
  MENU_ITEMS_ITEM_TYPE,
  MENU_ITEMS_ITEM_SELECTED,
  MENU_ITEMS_ITEM_HELP,
  MENU_ITEMS_ITEM_LENGTH
};
221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240

static Lisp_Object menu_items;

/* Number of slots currently allocated in menu_items.  */
static int menu_items_allocated;

/* This is the index in menu_items of the first empty slot.  */
static int menu_items_used;

/* The number of panes currently recorded in menu_items,
   excluding those within submenus.  */
static int menu_items_n_panes;

/* Current depth within submenus.  */
static int menu_items_submenu_depth;

/* Flag which when set indicates a dialog or menu has been posted by
   Xt on behalf of one of the widget sets.  */
static int popup_activated_flag;

241 242
static int next_menubar_widget_id;

243 244 245 246 247 248
/* This is set nonzero after the user activates the menu bar, and set
   to zero again after the menu bars are redisplayed by prepare_menu_bar.
   While it is nonzero, all calls to set_frame_menubar go deep.

   I don't understand why this is needed, but it does seem to be
   needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>.  */
Geoff Voelker's avatar
Geoff Voelker committed
249

250 251 252 253
int pending_menu_activation;


/* Return the frame whose ->output_data.w32->menubar_widget equals
254
   ID, or 0 if none.  */
255 256

static struct frame *
257 258
menubar_id_to_frame (id)
     HMENU id;
259 260 261
{
  Lisp_Object tail, frame;
  FRAME_PTR f;
Geoff Voelker's avatar
Geoff Voelker committed
262

263
  for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
264
    {
265
      frame = XCAR (tail);
266 267 268
      if (!GC_FRAMEP (frame))
        continue;
      f = XFRAME (frame);
269
      if (!FRAME_WINDOW_P (f))
270
	continue;
271
      if (f->output_data.w32->menubar_widget == id)
272 273 274 275 276
	return f;
    }
  return 0;
}

Geoff Voelker's avatar
Geoff Voelker committed
277 278 279
/* Initialize the menu_items structure if we haven't already done so.
   Also mark it as currently empty.  */

280 281
static void
init_menu_items ()
Geoff Voelker's avatar
Geoff Voelker committed
282
{
283
  if (NILP (menu_items))
Geoff Voelker's avatar
Geoff Voelker committed
284
    {
285 286
      menu_items_allocated = 60;
      menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
Geoff Voelker's avatar
Geoff Voelker committed
287
    }
288 289 290 291

  menu_items_used = 0;
  menu_items_n_panes = 0;
  menu_items_submenu_depth = 0;
Geoff Voelker's avatar
Geoff Voelker committed
292 293
}

294 295
/* Call at the end of generating the data in menu_items.
   This fills in the number of items in the last pane.  */
Geoff Voelker's avatar
Geoff Voelker committed
296

297 298
static void
finish_menu_items ()
Geoff Voelker's avatar
Geoff Voelker committed
299 300
{
}
301 302 303 304

/* Call when finished using the data for the current menu
   in menu_items.  */

305 306
static void
discard_menu_items ()
307
{
308 309 310
  /* Free the structure if it is especially large.
     Otherwise, hold on to it, to save time.  */
  if (menu_items_allocated > 200)
311
    {
312 313
      menu_items = Qnil;
      menu_items_allocated = 0;
314 315 316
    }
}

317
/* Make the menu_items vector twice as large.  */
Geoff Voelker's avatar
Geoff Voelker committed
318

319 320
static void
grow_menu_items ()
Geoff Voelker's avatar
Geoff Voelker committed
321
{
322 323 324 325 326 327 328 329
  Lisp_Object old;
  int old_size = menu_items_allocated;
  old = menu_items;

  menu_items_allocated *= 2;
  menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
  bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
	 old_size * sizeof (Lisp_Object));
Geoff Voelker's avatar
Geoff Voelker committed
330 331
}

332
/* Begin a submenu.  */
333

334 335 336 337 338
static void
push_submenu_start ()
{
  if (menu_items_used + 1 > menu_items_allocated)
    grow_menu_items ();
339

340
  ASET (menu_items, menu_items_used++, Qnil);
341
  menu_items_submenu_depth++;
Geoff Voelker's avatar
Geoff Voelker committed
342
}
343 344 345 346 347

/* End a submenu.  */

static void
push_submenu_end ()
Geoff Voelker's avatar
Geoff Voelker committed
348
{
349 350
  if (menu_items_used + 1 > menu_items_allocated)
    grow_menu_items ();
Geoff Voelker's avatar
Geoff Voelker committed
351

352
  ASET (menu_items, menu_items_used++, Qlambda);
353
  menu_items_submenu_depth--;
Geoff Voelker's avatar
Geoff Voelker committed
354 355
}

356
/* Indicate boundary between left and right.  */
Geoff Voelker's avatar
Geoff Voelker committed
357

358 359
static void
push_left_right_boundary ()
Geoff Voelker's avatar
Geoff Voelker committed
360
{
361 362 363
  if (menu_items_used + 1 > menu_items_allocated)
    grow_menu_items ();

364
  ASET (menu_items, menu_items_used++, Qquote);
Geoff Voelker's avatar
Geoff Voelker committed
365 366
}

367
/* Start a new menu pane in menu_items.
368
   NAME is the pane name.  PREFIX_VEC is a prefix key for this pane.  */
Geoff Voelker's avatar
Geoff Voelker committed
369

370 371 372
static void
push_menu_pane (name, prefix_vec)
     Lisp_Object name, prefix_vec;
Geoff Voelker's avatar
Geoff Voelker committed
373
{
374 375 376 377 378
  if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
    grow_menu_items ();

  if (menu_items_submenu_depth == 0)
    menu_items_n_panes++;
379 380 381
  ASET (menu_items, menu_items_used++, Qt);
  ASET (menu_items, menu_items_used++, name);
  ASET (menu_items, menu_items_used++, prefix_vec);
382
}
Geoff Voelker's avatar
Geoff Voelker committed
383

384 385 386 387 388 389 390
/* Push one menu item into the current pane.  NAME is the string to
   display.  ENABLE if non-nil means this item can be selected.  KEY
   is the key generated by choosing this item, or nil if this item
   doesn't really have a definition.  DEF is the definition of this
   item.  EQUIV is the textual description of the keyboard equivalent
   for this item (or nil if none).  TYPE is the type of this menu
   item, one of nil, `toggle' or `radio'. */
391 392

static void
393 394
push_menu_item (name, enable, key, def, equiv, type, selected, help)
     Lisp_Object name, enable, key, def, equiv, type, selected, help;
395 396 397 398
{
  if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
    grow_menu_items ();

399 400 401 402 403 404 405 406
  ASET (menu_items, menu_items_used++, name);
  ASET (menu_items, menu_items_used++, enable);
  ASET (menu_items, menu_items_used++, key);
  ASET (menu_items, menu_items_used++, equiv);
  ASET (menu_items, menu_items_used++, def);
  ASET (menu_items, menu_items_used++, type);
  ASET (menu_items, menu_items_used++, selected);
  ASET (menu_items, menu_items_used++, help);
Geoff Voelker's avatar
Geoff Voelker committed
407 408 409 410 411 412 413
}

/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
   and generate menu panes for them in menu_items.
   If NOTREAL is nonzero,
   don't bother really computing whether an item is enabled.  */

414 415
static void
keymap_panes (keymaps, nmaps, notreal)
Geoff Voelker's avatar
Geoff Voelker committed
416 417 418 419 420
     Lisp_Object *keymaps;
     int nmaps;
     int notreal;
{
  int mapno;
421

422
  init_menu_items ();
423

424 425 426 427
  /* 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++)
428
    single_keymap_panes (keymaps[mapno],
429
                         Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
Geoff Voelker's avatar
Geoff Voelker committed
430

431
  finish_menu_items ();
Geoff Voelker's avatar
Geoff Voelker committed
432 433 434 435 436 437
}

/* This is a recursive subroutine of keymap_panes.
   It handles one keymap, KEYMAP.
   The other arguments are passed along
   or point to local variables of the previous function.
438 439
   If NOTREAL is nonzero, only check for equivalent key bindings, don't
   evaluate expressions in menu items and don't make any menu.
Geoff Voelker's avatar
Geoff Voelker committed
440

441 442 443 444
   If we encounter submenus deeper than MAXDEPTH levels, ignore them.  */

static void
single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
Geoff Voelker's avatar
Geoff Voelker committed
445 446 447 448
     Lisp_Object keymap;
     Lisp_Object pane_name;
     Lisp_Object prefix;
     int notreal;
449
     int maxdepth;
Geoff Voelker's avatar
Geoff Voelker committed
450
{
451 452 453 454 455 456 457 458 459
  Lisp_Object pending_maps = Qnil;
  Lisp_Object tail, item;
  struct gcpro gcpro1, gcpro2;

  if (maxdepth <= 0)
    return;

  push_menu_pane (pane_name, prefix);

460
  for (tail = keymap; CONSP (tail); tail = XCDR (tail))
Geoff Voelker's avatar
Geoff Voelker committed
461
    {
462 463 464
      GCPRO2 (keymap, pending_maps);
      /* Look at each key binding, and if it is a menu item add it
	 to this menu.  */
465
      item = XCAR (tail);
Geoff Voelker's avatar
Geoff Voelker committed
466
      if (CONSP (item))
467
	single_menu_item (XCAR (item), XCDR (item),
Jason Rumney's avatar
Jason Rumney committed
468
			  &pending_maps, notreal, maxdepth);
Geoff Voelker's avatar
Geoff Voelker committed
469 470 471
      else if (VECTORP (item))
	{
	  /* Loop over the char values represented in the vector.  */
472
	  int len = ASIZE (item);
Geoff Voelker's avatar
Geoff Voelker committed
473 474 475 476 477
	  int c;
	  for (c = 0; c < len; c++)
	    {
	      Lisp_Object character;
	      XSETFASTINT (character, c);
478
	      single_menu_item (character, AREF (item, c),
Jason Rumney's avatar
Jason Rumney committed
479
				&pending_maps, notreal, maxdepth);
Geoff Voelker's avatar
Geoff Voelker committed
480 481
	    }
	}
482
      UNGCPRO;
Geoff Voelker's avatar
Geoff Voelker committed
483 484 485 486 487 488 489
    }

  /* Process now any submenus which want to be panes at this level.  */
  while (!NILP (pending_maps))
    {
      Lisp_Object elt, eltcdr, string;
      elt = Fcar (pending_maps);
490 491
      eltcdr = XCDR (elt);
      string = XCAR (eltcdr);
Geoff Voelker's avatar
Geoff Voelker committed
492
      /* We no longer discard the @ from the beginning of the string here.
493 494
	 Instead, we do this in w32_menu_show.  */
      single_keymap_panes (Fcar (elt), string,
495
			   XCDR (eltcdr), notreal, maxdepth - 1);
496 497 498 499 500 501
      pending_maps = Fcdr (pending_maps);
    }
}

/* This is a subroutine of single_keymap_panes that handles one
   keymap entry.
502
   KEY is a key in a keymap and ITEM is its binding.
503 504 505 506
   PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
   separate panes.
   If NOTREAL is nonzero, only check for equivalent key bindings, don't
   evaluate expressions in menu items and don't make any menu.
Jason Rumney's avatar
Jason Rumney committed
507
   If we encounter submenus deeper than MAXDEPTH levels, ignore them.  */
508 509

static void
Jason Rumney's avatar
Jason Rumney committed
510
single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
511 512 513 514
     Lisp_Object key, item;
     Lisp_Object *pending_maps_ptr;
     int maxdepth, notreal;
{
515
  Lisp_Object map, item_string, enabled;
516 517
  struct gcpro gcpro1, gcpro2;
  int res;
518

519 520 521 522 523 524 525
  /* Parse the menu item and leave the result in item_properties.  */
  GCPRO2 (key, item);
  res = parse_menu_item (item, notreal, 0);
  UNGCPRO;
  if (!res)
    return;			/* Not a menu item.  */

526
  map = AREF (item_properties, ITEM_PROPERTY_MAP);
527

528 529 530 531 532 533 534 535 536
  if (notreal)
    {
      /* We don't want to make a menu, just traverse the keymaps to
	 precompute equivalent key bindings.  */
      if (!NILP (map))
	single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
      return;
    }

537
  enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
538
  item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
539

540
  if (!NILP (map) && SREF (item_string, 0) == '@')
541 542 543 544 545 546 547 548 549
    {
      if (!NILP (enabled))
	/* An enabled separate pane. Remember this to handle it later.  */
	*pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
				   *pending_maps_ptr);
      return;
    }

  push_menu_item (item_string, enabled, key,
550 551 552 553 554
		  AREF (item_properties, ITEM_PROPERTY_DEF),
		  AREF (item_properties, ITEM_PROPERTY_KEYEQ),
		  AREF (item_properties, ITEM_PROPERTY_TYPE),
                  AREF (item_properties, ITEM_PROPERTY_SELECTED),
                  AREF (item_properties, ITEM_PROPERTY_HELP));
555 556 557 558 559 560 561

  /* Display a submenu using the toolkit.  */
  if (! (NILP (map) || NILP (enabled)))
    {
      push_submenu_start ();
      single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
      push_submenu_end ();
Geoff Voelker's avatar
Geoff Voelker committed
562 563 564
    }
}

Karl Heuer's avatar
Karl Heuer committed
565
/* Push all the panes and items of a menu described by the
Geoff Voelker's avatar
Geoff Voelker committed
566 567 568
   alist-of-alists MENU.
   This handles old-fashioned calls to x-popup-menu.  */

569 570
static void
list_of_panes (menu)
Geoff Voelker's avatar
Geoff Voelker committed
571 572 573
     Lisp_Object menu;
{
  Lisp_Object tail;
574

575
  init_menu_items ();
576

577
  for (tail = menu; !NILP (tail); tail = Fcdr (tail))
Geoff Voelker's avatar
Geoff Voelker committed
578 579
    {
      Lisp_Object elt, pane_name, pane_data;
580
      elt = Fcar (tail);
Geoff Voelker's avatar
Geoff Voelker committed
581
      pane_name = Fcar (elt);
582
      CHECK_STRING (pane_name);
583
      push_menu_pane (pane_name, Qnil);
Geoff Voelker's avatar
Geoff Voelker committed
584
      pane_data = Fcdr (elt);
585
      CHECK_CONS (pane_data);
586
      list_of_items (pane_data);
Geoff Voelker's avatar
Geoff Voelker committed
587
    }
588 589

  finish_menu_items ();
Geoff Voelker's avatar
Geoff Voelker committed
590 591 592 593
}

/* Push the items in a single pane defined by the alist PANE.  */

594 595
static void
list_of_items (pane)
Geoff Voelker's avatar
Geoff Voelker committed
596 597 598 599 600 601 602 603
     Lisp_Object pane;
{
  Lisp_Object tail, item, item1;

  for (tail = pane; !NILP (tail); tail = Fcdr (tail))
    {
      item = Fcar (tail);
      if (STRINGP (item))
604
	push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
Geoff Voelker's avatar
Geoff Voelker committed
605
      else if (NILP (item))
606
	push_left_right_boundary ();
Geoff Voelker's avatar
Geoff Voelker committed
607 608
      else
	{
609
	  CHECK_CONS (item);
Geoff Voelker's avatar
Geoff Voelker committed
610
	  item1 = Fcar (item);
611
	  CHECK_STRING (item1);
612
	  push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
Geoff Voelker's avatar
Geoff Voelker committed
613 614 615 616
	}
    }
}

617
DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648
       doc: /* Pop up a deck-of-cards menu and return user's selection.
POSITION is a position specification.  This is either a mouse button
event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
are positions in pixels from the top left corner of WINDOW's frame
\(WINDOW may be a frame object instead of a window).  This controls the
position of the center of the first line in the first pane of the
menu, not the top left of the menu as a whole.  If POSITION is t, it
means to use the current mouse position.

MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.
The menu items come from key bindings that have a menu string as well as
a definition; actually, the \"definition\" in such a key binding looks like
\(STRING . REAL-DEFINITION).  To give the menu a title, put a string into
the keymap as a top-level element.

If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
Otherwise, REAL-DEFINITION should be a valid key binding definition.

You can also use a list of keymaps as MENU.  Then each keymap makes a
separate pane.  When MENU is a keymap or a list of keymaps, the return
value is a list of events.

Alternatively, you can specify a menu of multiple panes with a list of
the form (TITLE PANE1 PANE2...), where each pane is a list of
form (TITLE ITEM1 ITEM2...).
Each ITEM is normally a cons cell (STRING . VALUE); but a string can
appear as an item--that makes a nonselectable line in the menu.
With this form of menu, the return value is VALUE from the chosen item.

If POSITION is nil, don't display the menu at all, just precalculate the
cached information about equivalent key sequences.  */)
649 650
  (position, menu)
     Lisp_Object position, menu;
Geoff Voelker's avatar
Geoff Voelker committed
651 652
{
  Lisp_Object keymap, tem;
653
  int xpos = 0, ypos = 0;
Geoff Voelker's avatar
Geoff Voelker committed
654 655 656
  Lisp_Object title;
  char *error_name;
  Lisp_Object selection;
657
  FRAME_PTR f = NULL;
Geoff Voelker's avatar
Geoff Voelker committed
658 659
  Lisp_Object x, y, window;
  int keymaps = 0;
660
  int for_click = 0;
Geoff Voelker's avatar
Geoff Voelker committed
661
  struct gcpro gcpro1;
662 663

#ifdef HAVE_MENUS
Geoff Voelker's avatar
Geoff Voelker committed
664 665
  if (! NILP (position))
    {
666 667
      check_w32 ();

Geoff Voelker's avatar
Geoff Voelker committed
668
      /* Decode the first argument: find the window and the coordinates.  */
669
      if (EQ (position, Qt)
670 671
	  || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
                                   || EQ (XCAR (position), Qtool_bar))))
Geoff Voelker's avatar
Geoff Voelker committed
672 673
	{
	  /* Use the mouse's current position.  */
674
	  FRAME_PTR new_f = SELECTED_FRAME ();
Geoff Voelker's avatar
Geoff Voelker committed
675
	  Lisp_Object bar_window;
676
	  enum scroll_bar_part part;
Geoff Voelker's avatar
Geoff Voelker committed
677
	  unsigned long time;
678

Geoff Voelker's avatar
Geoff Voelker committed
679
	  if (mouse_position_hook)
680 681
	    (*mouse_position_hook) (&new_f, 1, &bar_window,
				    &part, &x, &y, &time);
Geoff Voelker's avatar
Geoff Voelker committed
682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701
	  if (new_f != 0)
	    XSETFRAME (window, new_f);
	  else
	    {
	      window = selected_window;
	      XSETFASTINT (x, 0);
	      XSETFASTINT (y, 0);
	    }
	}
      else
	{
	  tem = Fcar (position);
	  if (CONSP (tem))
	    {
	      window = Fcar (Fcdr (position));
	      x = Fcar (tem);
	      y = Fcar (Fcdr (tem));
	    }
	  else
	    {
702 703 704
	      for_click = 1;
	      tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
	      window = Fcar (tem);	     /* POSN_WINDOW (tem) */
Geoff Voelker's avatar
Geoff Voelker committed
705 706 707 708 709
	      tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
	      x = Fcar (tem);
	      y = Fcdr (tem);
	    }
	}
710

711 712
      CHECK_NUMBER (x);
      CHECK_NUMBER (y);
Geoff Voelker's avatar
Geoff Voelker committed
713 714

      /* Decode where to put the menu.  */
715

Geoff Voelker's avatar
Geoff Voelker committed
716 717 718 719 720 721 722 723
      if (FRAMEP (window))
	{
	  f = XFRAME (window);
	  xpos = 0;
	  ypos = 0;
	}
      else if (WINDOWP (window))
	{
724
	  CHECK_LIVE_WINDOW (window);
Geoff Voelker's avatar
Geoff Voelker committed
725
	  f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
726

727 728
	  xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
	  ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
Geoff Voelker's avatar
Geoff Voelker committed
729 730 731 732
	}
      else
	/* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
	   but I don't want to make one now.  */
733
	CHECK_WINDOW (window);
734

Geoff Voelker's avatar
Geoff Voelker committed
735 736
      xpos += XINT (x);
      ypos += XINT (y);
737 738

      XSETFRAME (Vmenu_updating_frame, f);
Geoff Voelker's avatar
Geoff Voelker committed
739
    }
740
  Vmenu_updating_frame = Qnil;
741
#endif /* HAVE_MENUS */
742

Geoff Voelker's avatar
Geoff Voelker committed
743 744
  title = Qnil;
  GCPRO1 (title);
745 746 747

  /* Decode the menu items from what was specified.  */

748 749
  keymap = get_keymap (menu, 0, 0);
  if (CONSP (keymap))
750 751 752 753 754 755 756 757 758
    {
      /* We were given a keymap.  Extract menu info from the keymap.  */
      Lisp_Object prompt;

      /* Extract the detailed info to make one pane.  */
      keymap_panes (&menu, 1, NILP (position));

      /* Search for a string appearing directly as an element of the keymap.
	 That string is the title of the menu.  */
759
      prompt = Fkeymap_prompt (keymap);
760 761 762 763 764
      if (NILP (title) && !NILP (prompt))
	title = prompt;

      /* Make that be the pane title of the first pane.  */
      if (!NILP (prompt) && menu_items_n_panes >= 0)
765
	ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
766 767 768

      keymaps = 1;
    }
769
  else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
770 771 772 773 774 775 776 777 778 779 780 781 782 783 784
    {
      /* We were given a list of keymaps.  */
      int nmaps = XFASTINT (Flength (menu));
      Lisp_Object *maps
	= (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
      int i;

      title = Qnil;

      /* The first keymap that has a prompt string
	 supplies the menu title.  */
      for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
	{
	  Lisp_Object prompt;

785
	  maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
786

787
	  prompt = Fkeymap_prompt (keymap);
788 789 790 791 792 793 794 795 796
	  if (NILP (title) && !NILP (prompt))
	    title = prompt;
	}

      /* Extract the detailed info to make one pane.  */
      keymap_panes (maps, nmaps, NILP (position));

      /* Make the title be the pane title of the first pane.  */
      if (!NILP (title) && menu_items_n_panes >= 0)
797
	ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
798 799 800 801 802 803 804

      keymaps = 1;
    }
  else
    {
      /* We were given an old-fashioned menu.  */
      title = Fcar (menu);
805
      CHECK_STRING (title);
806 807 808 809 810

      list_of_panes (Fcdr (menu));

      keymaps = 0;
    }
811

Geoff Voelker's avatar
Geoff Voelker committed
812 813
  if (NILP (position))
    {
814
      discard_menu_items ();
Geoff Voelker's avatar
Geoff Voelker committed
815 816 817
      UNGCPRO;
      return Qnil;
    }
818 819

#ifdef HAVE_MENUS
820 821 822 823 824 825 826 827
  /* If resources from a previous popup menu exist yet, does nothing
     until the `menu_free_timer' has freed them (see w32fns.c).
  */
  if (current_popup_menu)
    {
      discard_menu_items ();
      UNGCPRO;
      return Qnil;
828 829
    }

Geoff Voelker's avatar
Geoff Voelker committed
830 831
  /* Display them in a menu.  */
  BLOCK_INPUT;
832 833 834

  selection = w32_menu_show (f, xpos, ypos, for_click,
			     keymaps, title, &error_name);
Geoff Voelker's avatar
Geoff Voelker committed
835
  UNBLOCK_INPUT;
836 837

  discard_menu_items ();
838
#endif /* HAVE_MENUS */
839

Geoff Voelker's avatar
Geoff Voelker committed
840
  UNGCPRO;
841

Geoff Voelker's avatar
Geoff Voelker committed
842 843 844 845
  if (error_name) error (error_name);
  return selection;
}

846 847
#ifdef HAVE_MENUS

848
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
849 850 851 852 853 854 855 856 857 858 859 860 861 862
       doc: /* Pop up a dialog box and return user's selection.
POSITION specifies which frame to use.
This is normally a mouse button event or a window or frame.
If POSITION is t, it means to use the frame the mouse is on.
The dialog box appears in the middle of the specified frame.

CONTENTS specifies the alternatives to display in the dialog box.
It is a list of the form (TITLE ITEM1 ITEM2...).
Each ITEM is a cons cell (STRING . VALUE).
The return value is VALUE from the chosen item.

An ITEM may also be just a string--that makes a nonselectable item.
An ITEM may also be nil--that means to put all preceding items
on the left of the dialog box and all following items on the right.
863 864 865 866 867 868
\(By default, approximately half appear on each side.)

If HEADER is non-nil, the frame title for the box is "Information",
otherwise it is "Question". */)
  (position, contents, header)
     Lisp_Object position, contents, header;
Geoff Voelker's avatar
Geoff Voelker committed
869
{
870
  FRAME_PTR f = NULL;
Geoff Voelker's avatar
Geoff Voelker committed
871
  Lisp_Object window;
872 873 874

  check_w32 ();

Geoff Voelker's avatar
Geoff Voelker committed
875
  /* Decode the first argument: find the window or frame to use.  */
876
  if (EQ (position, Qt)
877 878
      || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
                               || EQ (XCAR (position), Qtool_bar))))
Geoff Voelker's avatar
Geoff Voelker committed
879
    {
880 881
#if 0 /* Using the frame the mouse is on may not be right.  */
      /* Use the mouse's current position.  */
882
      FRAME_PTR new_f = SELECTED_FRAME ();
883
      Lisp_Object bar_window;
884
      enum scroll_bar_part part;
885 886 887 888 889 890 891 892
      unsigned long time;
      Lisp_Object x, y;

      (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);

      if (new_f != 0)
	XSETFRAME (window, new_f);
      else
Geoff Voelker's avatar
Geoff Voelker committed
893
	window = selected_window;
894 895
#endif
      window = selected_window;
Geoff Voelker's avatar
Geoff Voelker committed
896 897 898 899 900
    }
  else if (CONSP (position))
    {
      Lisp_Object tem;
      tem = Fcar (position);
901
      if (CONSP (tem))
Geoff Voelker's avatar
Geoff Voelker committed
902 903 904
	window = Fcar (Fcdr (position));
      else
	{
905 906
	  tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
	  window = Fcar (tem);	     /* POSN_WINDOW (tem) */
Geoff Voelker's avatar
Geoff Voelker committed
907 908 909 910
	}
    }
  else if (WINDOWP (position) || FRAMEP (position))
    window = position;
911 912 913
  else
    window = Qnil;

Geoff Voelker's avatar
Geoff Voelker committed
914
  /* Decode where to put the menu.  */
915

Geoff Voelker's avatar
Geoff Voelker committed
916 917 918 919
  if (FRAMEP (window))
    f = XFRAME (window);
  else if (WINDOWP (window))
    {
920
      CHECK_LIVE_WINDOW (window);
Geoff Voelker's avatar
Geoff Voelker committed
921 922 923 924 925
      f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
    }
  else
    /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
       but I don't want to make one now.  */
926
    CHECK_WINDOW (window);
927

928
#ifndef HAVE_DIALOGS
Geoff Voelker's avatar
Geoff Voelker committed
929 930 931 932 933 934 935 936 937 938 939 940
  /* Display a menu with these alternatives
     in the middle of frame F.  */
  {
    Lisp_Object x, y, frame, newpos;
    XSETFRAME (frame, f);
    XSETINT (x, x_pixel_width (f) / 2);
    XSETINT (y, x_pixel_height (f) / 2);
    newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));

    return Fx_popup_menu (newpos,
			  Fcons (Fcar (contents), Fcons (contents, Qnil)));
  }
941
#else /* HAVE_DIALOGS */
Geoff Voelker's avatar
Geoff Voelker committed
942 943 944 945 946 947 948
  {
    Lisp_Object title;
    char *error_name;
    Lisp_Object selection;

    /* Decode the dialog items from what was specified.  */
    title = Fcar (contents);
949
    CHECK_STRING (title);
Geoff Voelker's avatar
Geoff Voelker committed
950 951 952 953 954

    list_of_panes (Fcons (contents, Qnil));

    /* Display them in a dialog box.  */
    BLOCK_INPUT;
955
    selection = w32_dialog_show (f, 0, title, header, &error_name);
Geoff Voelker's avatar
Geoff Voelker committed
956 957 958 959 960 961 962
    UNBLOCK_INPUT;

    discard_menu_items ();

    if (error_name) error (error_name);
    return selection;
  }
963
#endif /* HAVE_DIALOGS */
Geoff Voelker's avatar
Geoff Voelker committed
964 965
}

966 967
/* Activate the menu bar of frame F.
   This is called from keyboard.c when it gets the
Pavel Janík's avatar
Pavel Janík committed
968
   MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
969 970 971 972 973 974 975 976

   To activate the menu bar, we signal to the input thread that it can
   return from the WM_INITMENU message, allowing the normal Windows
   processing of the menus.

   But first we recompute the menu bar contents (the whole tree).

   This way we can safely execute Lisp code.  */
977

978
void
979 980 981 982 983 984 985 986 987 988 989 990
x_activate_menubar (f)
     FRAME_PTR f;
{
  set_frame_menubar (f, 0, 1);

  /* Lock out further menubar changes while active.  */
  f->output_data.w32->menubar_active = 1;

  /* Signal input thread to return from WM_INITMENU.  */
  complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
}

991 992 993 994 995 996 997
/* This callback is called from the menu bar pulldown menu
   when the user makes a selection.
   Figure out what the user chose
   and put the appropriate events into the keyboard buffer.  */

void
menubar_selection_callback (FRAME_PTR f, void * client_data)
Geoff Voelker's avatar
Geoff Voelker committed
998
{
999 1000 1001 1002
  Lisp_Object prefix, entry;
  Lisp_Object vector;
  Lisp_Object *subprefix_stack;
  int submenu_depth = 0;
Geoff Voelker's avatar
Geoff Voelker committed
1003
  int i;
Richard M. Stallman's avatar
Richard M. Stallman committed
1004

1005
  if (!f)
1006
    return;
1007
  entry = Qnil;
1008 1009 1010 1011 1012 1013
  subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
  vector = f->menu_bar_vector;
  prefix = Qnil;
  i = 0;
  while (i < f->menu_bar_items_used)
    {
1014
      if (EQ (AREF (vector, i), Qnil))
1015 1016 1017 1018 1019
	{
	  subprefix_stack[submenu_depth++] = prefix;
	  prefix = entry;
	  i++;
	}
1020
      else if (EQ (AREF (vector, i), Qlambda))
1021 1022 1023 1024
	{
	  prefix = subprefix_stack[--submenu_depth];
	  i++;
	}
1025
      else if (EQ (AREF (vector, i), Qt))
1026
	{
1027
	  prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1028 1029 1030 1031
	  i += MENU_ITEMS_PANE_LENGTH;
	}
      else
	{
1032
	  entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1033 1034 1035 1036 1037 1038 1039
	  /* The EMACS_INT cast avoids a warning.  There's no problem
	     as long as pointers have enough bits to hold small integers.  */
	  if ((int) (EMACS_INT) client_data == i)
	    {
	      int j;
	      struct input_event buf;
	      Lisp_Object frame;
1040
	      EVENT_INIT (buf);
1041

1042
	      XSETFRAME (frame, f);
1043 1044 1045
	      buf.kind = MENU_BAR_EVENT;
	      buf.frame_or_window = frame;
	      buf.arg = frame;
1046
	      kbd_buffer_store_event (&buf);
1047

1048 1049 1050
	      for (j = 0; j < submenu_depth; j++)
		if (!NILP (subprefix_stack[j]))
		  {
1051 1052 1053
		    buf.kind = MENU_BAR_EVENT;
		    buf.frame_or_window = frame;
		    buf.arg = subprefix_stack[j];
1054 1055
		    kbd_buffer_store_event (&buf);
		  }
Richard M. Stallman's avatar
Richard M. Stallman committed
1056

1057 1058
	      if (!NILP (prefix))
		{
1059 1060 1061
		  buf.kind = MENU_BAR_EVENT;
		  buf.frame_or_window = frame;
		  buf.arg = prefix;
1062 1063
		  kbd_buffer_store_event (&buf);
		}
Richard M. Stallman's avatar
Richard M. Stallman committed
1064

1065 1066 1067
	      buf.kind = MENU_BAR_EVENT;
	      buf.frame_or_window = frame;
	      buf.arg = entry;
1068
	      kbd_buffer_store_event (&buf);
Richard M. Stallman's avatar
Richard M. Stallman committed
1069

1070 1071 1072 1073
	      /* Free memory used by owner-drawn and help-echo strings.  */
	      w32_free_menu_strings (FRAME_W32_WINDOW (f));
	      f->output_data.w32->menu_command_in_progress = 0;
	      f->output_data.w32->menubar_active = 0;
1074 1075 1076 1077
	      return;
	    }
	  i += MENU_ITEMS_ITEM_LENGTH;
	}
1078
    }
1079 1080 1081 1082
  /* Free memory used by owner-drawn and help-echo strings.  */
  w32_free_menu_strings (FRAME_W32_WINDOW (f));
  f->output_data.w32->menu_command_in_progress = 0;
  f->output_data.w32->menubar_active = 0;
1083
}