w32menu.c 65.6 KB
Newer Older
1
/* Menu support for GNU Emacs on the Microsoft W32 API.
2
   Copyright (C) 1986, 88, 93, 94, 96, 98, 1999 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
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, 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_MULTILINGUAL_MENU
49
#undef HAVE_DIALOGS /* TODO: Implement native dialogs.  */
50

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

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

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

64 65
/* This structure is based on the one in ../lwlib/lwlib.h, modified
   for Windows.  */
66
typedef struct _widget_value
Geoff Voelker's avatar
Geoff Voelker committed
67
{
68 69 70 71 72 73
  /* name of widget */
  char*		name;
  /* value (meaning depend on widget type) */
  char*		value;
  /* keyboard equivalent. no implications for XtTranslations */ 
  char*		key;
74 75 76 77
  /* Help string or nil if none.
     GC finds this string through the frame's menu_bar_vector
     or through menu_items.  */
  Lisp_Object	help;
78 79 80 81
  /* true if enabled */
  Boolean	enabled;
  /* true if selected */
  Boolean	selected;
82 83
  /* The type of a button.  */
  enum button_type button_type;
84 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
  /* 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;

115 116 117 118 119 120 121
/* 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)))
122 123 124 125 126 127 128 129

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

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

130 131
static HMENU current_popup_menu;

132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
void syms_of_w32menu ();

typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
    IN HMENU,
    IN UINT,
    IN BOOL,
    IN OUT LPMENUITEMINFOA
    );
typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
    IN HMENU,
    IN UINT,
    IN BOOL,
    IN LPCMENUITEMINFOA
    );

GetMenuItemInfoA_Proc get_menu_item_info=NULL;
SetMenuItemInfoA_Proc set_menu_item_info=NULL;
149

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

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

Geoff Voelker's avatar
Geoff Voelker committed
154
extern Lisp_Object Qmenu_bar;
155 156 157
extern Lisp_Object Qmouse_click, Qevent_kind;

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 502 503 504 505 506
      pending_maps = Fcdr (pending_maps);
    }
}

/* This is a subroutine of single_keymap_panes that handles one
   keymap entry.
   KEY is a key in a keymap and ITEM is its binding. 
   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 518 519 520 521 522 523 524 525
  struct gcpro gcpro1, gcpro2;
  int res;
  
  /* 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 538
  enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
  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
	  xpos = (FONT_WIDTH (FRAME_FONT (f))
728
		  * XFASTINT (XWINDOW (window)->left));
729
	  ypos = (FRAME_LINE_HEIGHT (f)
730
		  * XFASTINT (XWINDOW (window)->top));
Geoff Voelker's avatar
Geoff Voelker committed
731 732 733 734
	}
      else
	/* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
	   but I don't want to make one now.  */
735
	CHECK_WINDOW (window);
736

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

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

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

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

750 751
  keymap = get_keymap (menu, 0, 0);
  if (CONSP (keymap))
752 753 754 755 756 757 758 759 760
    {
      /* 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.  */
761
      prompt = Fkeymap_prompt (keymap);
762 763 764 765 766
      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)
767
	ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
768 769 770

      keymaps = 1;
    }
771
  else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
772 773 774 775 776 777 778 779 780 781 782 783 784 785 786
    {
      /* 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;

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

789
	  prompt = Fkeymap_prompt (keymap);
790 791 792 793 794 795 796 797 798
	  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)
799
	ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
800 801 802 803 804 805 806

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

      list_of_panes (Fcdr (menu));

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

#ifdef HAVE_MENUS
822 823 824 825 826 827 828 829 830 831
  /* 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;
    }    
  
Geoff Voelker's avatar
Geoff Voelker committed
832 833
  /* Display them in a menu.  */
  BLOCK_INPUT;
834 835 836

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

  discard_menu_items ();
840
#endif /* HAVE_MENUS */
841

Geoff Voelker's avatar
Geoff Voelker committed
842
  UNGCPRO;
843

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

848 849
#ifdef HAVE_MENUS

Geoff Voelker's avatar
Geoff Voelker committed
850
DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
851 852 853 854 855 856 857 858 859 860 861 862 863 864 865
       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.
\(By default, approximately half appear on each side.)  */)
866 867
  (position, contents)
     Lisp_Object position, contents;
Geoff Voelker's avatar
Geoff Voelker committed
868
{
869
  FRAME_PTR f = NULL;
Geoff Voelker's avatar
Geoff Voelker committed
870
  Lisp_Object window;
871 872 873

  check_w32 ();

Geoff Voelker's avatar
Geoff Voelker committed
874
  /* Decode the first argument: find the window or frame to use.  */
875
  if (EQ (position, Qt)
876 877
      || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
                               || EQ (XCAR (position), Qtool_bar))))
Geoff Voelker's avatar
Geoff Voelker committed
878
    {
879 880
#if 0 /* Using the frame the mouse is on may not be right.  */
      /* Use the mouse's current position.  */
881
      FRAME_PTR new_f = SELECTED_FRAME ();
882
      Lisp_Object bar_window;
883
      enum scroll_bar_part part;
884 885 886 887 888 889 890 891
      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
892
	window = selected_window;
893 894
#endif
      window = selected_window;
Geoff Voelker's avatar
Geoff Voelker committed
895 896 897 898 899
    }
  else if (CONSP (position))
    {
      Lisp_Object tem;
      tem = Fcar (position);
900
      if (CONSP (tem))
Geoff Voelker's avatar
Geoff Voelker committed
901 902 903
	window = Fcar (Fcdr (position));
      else
	{
904 905
	  tem = Fcar (Fcdr (position));  /* EVENT_START (position) */
	  window = Fcar (tem);	     /* POSN_WINDOW (tem) */
Geoff Voelker's avatar
Geoff Voelker committed
906 907 908 909
	}
    }
  else if (WINDOWP (position) || FRAMEP (position))
    window = position;
910 911 912
  else
    window = Qnil;

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

Geoff Voelker's avatar
Geoff Voelker committed
915 916 917 918
  if (FRAMEP (window))
    f = XFRAME (window);
  else if (WINDOWP (window))
    {
919
      CHECK_LIVE_WINDOW (window);
Geoff Voelker's avatar
Geoff Voelker committed
920 921 922 923 924
      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.  */
925
    CHECK_WINDOW (window);
926

927
#ifndef HAVE_DIALOGS
Geoff Voelker's avatar
Geoff Voelker committed
928 929 930 931 932 933 934 935 936 937 938 939
  /* 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)));
  }
940
#else /* HAVE_DIALOGS */
Geoff Voelker's avatar
Geoff Voelker committed
941 942 943 944 945 946 947
  {
    Lisp_Object title;
    char *error_name;
    Lisp_Object selection;

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

    list_of_panes (Fcons (contents, Qnil));

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

    discard_menu_items ();

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

965 966
/* 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
967
   MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
968 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
void
978 979 980 981 982 983 984 985 986 987 988 989
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);
}

990 991 992 993 994 995 996
/* 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
997
{
998 999 1000 1001
  Lisp_Object prefix, entry;
  Lisp_Object vector;
  Lisp_Object *subprefix_stack;
  int submenu_depth = 0;
Geoff Voelker's avatar
Geoff Voelker committed
1002
  int i;
Richard M. Stallman's avatar
Richard M. Stallman committed
1003

1004
  if (!f)
1005
    return;
1006
  entry = Qnil;
1007 1008 1009 1010 1011 1012
  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)
    {
1013
      if (EQ (AREF (vector, i), Qnil))
1014 1015 1016 1017 1018
	{
	  subprefix_stack[submenu_depth++] = prefix;
	  prefix = entry;
	  i++;
	}
1019
      else if (EQ (AREF (vector, i), Qlambda))
1020 1021 1022 1023
	{
	  prefix = subprefix_stack[--submenu_depth];
	  i++;
	}
1024
      else if (EQ (AREF (vector, i), Qt))
1025
	{
1026
	  prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1027 1028 1029 1030
	  i += MENU_ITEMS_PANE_LENGTH;
	}
      else
	{
1031
	  entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1032 1033 1034 1035 1036 1037 1038
	  /* 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;
1039

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

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

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

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

1068 1069 1070 1071
	      /* 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;
1072 1073 1074 1075
	      return;
	    }
	  i += MENU_ITEMS_ITEM_LENGTH;
	}
1076
    }
1077 1078 1079 1080
  /* 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;
1081
}
1082

1083
/* Allocate a widget_value, blocking input.  */
1084

1085 1086 1087 1088
widget_value *
xmalloc_widget_value ()
{
  widget_value *value;
1089

Richard M. Stallman's avatar
Richard M. Stallman committed
1090
  BLOCK_INPUT;
1091
  value = malloc_widget_value ();
Geoff Voelker's avatar
Geoff Voelker committed
1092
  UNBLOCK_INPUT;
1093 1094

  return value;
Geoff Voelker's avatar
Geoff Voelker committed
1095 1096
}

1097 1098 1099 1100 1101 1102 1103 1104
/* This recursively calls free_widget_value on the tree of widgets.
   It must free all data that was malloc'ed for these widget_values.
   In Emacs, many slots are pointers into the data of Lisp_Strings, and
   must be left alone.  */

void
free_menubar_widget_value_tree (wv)
     widget_value *wv;
Geoff Voelker's avatar
Geoff Voelker committed
1105
{
1106
  if (! wv) return;
1107
  
1108