1 /* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* X pop-up deck-of-cards menu facility for gnuemacs.
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
31 /* On 4.3 this loses if it comes after xterm.h. */
38 /* This may include sys/types.h, and that somehow loses
39 if this is not done before the other system files. */
42 /* Load sys/types.h if not already loaded.
43 In some systems loading it twice is suicidal. */
45 #include <sys/types.h>
48 #include "dispextern.h"
51 #include "../oldXMenu/XMenu.h"
56 #define min(x,y) (((x) < (y)) ? (x) : (y))
57 #define max(x,y) (((x) > (y)) ? (x) : (y))
67 extern Display
*x_current_display
;
69 #define ButtonReleaseMask ButtonReleased
70 #endif /* not HAVE_X11 */
72 Lisp_Object
xmenu_show ();
73 extern int x_error_handler ();
75 /*************************************************************/
78 /* Ignoring the args is easiest. */
81 error ("Unknown XMenu error");
85 DEFUN ("x-popup-menu",Fx_popup_menu
, Sx_popup_menu
, 1, 2, 0,
86 "Pop up a deck-of-cards menu and return user's selection.\n\
87 POSITION is a position specification. This is either a mouse button event\n\
88 or a list ((XOFFSET YOFFSET) WINDOW)\n\
89 where XOFFSET and YOFFSET are positions in characters from the top left\n\
90 corner of WINDOW's frame. A mouse-event list will serve for this.\n\
91 This controls the position of the center of the first line\n\
92 in the first pane of the menu, not the top left of the menu as a whole.\n\
94 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
95 The menu items come from key bindings that have a menu string as well as\n\
96 a definition; actually, the \"definition\" in such a key binding looks like\n\
97 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
98 the keymap as a top-level element.\n\n\
99 You can also use a list of keymaps as MENU.\n\
100 Then each keymap makes a separate pane.\n\n\
101 Alternatively, you can specify a menu of multiple panes\n\
102 with a list of the form\n\
103 \(TITLE PANE1 PANE2...), where each pane is a list of form\n\
104 \(TITLE (LINE ITEM)...). Each line should be a string, and item should\n\
105 be the return value for that line (i.e. if it is selected.")
107 Lisp_Object position
, menu
;
110 Lisp_Object XMenu_return
, keymap
, tem
;
111 int XMenu_xpos
, XMenu_ypos
;
114 Lisp_Object
**obj_list
;
118 Lisp_Object ltitle
, selection
;
121 Lisp_Object x
, y
, window
;
123 /* Decode the first argument: find the window and the coordinates. */
124 tem
= Fcar (position
);
125 if (XTYPE (tem
) == Lisp_Cons
)
127 window
= Fcar (Fcdr (position
));
129 y
= Fcar (Fcdr (tem
));
133 tem
= Fcdr (position
);
135 tem
= Fcar (Fcdr (Fcdr (tem
)));
139 CHECK_WINDOW (window
, 0);
143 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
146 = FONT_WIDTH (f
->display
.x
->font
) * (XINT (x
) + XWINDOW (window
)->left
);
148 = FONT_HEIGHT (f
->display
.x
->font
) * (XINT (y
) + XWINDOW (window
)->top
);
149 XMenu_xpos
+= f
->display
.x
->left_pos
;
150 XMenu_ypos
+= f
->display
.x
->top_pos
;
152 keymap
= Fkeymapp (menu
);
154 if (XTYPE (menu
) == Lisp_Cons
)
155 tem
= Fkeymapp (Fcar (menu
));
158 /* We were given a keymap. Extract menu info from the keymap. */
160 keymap
= get_keymap (menu
);
162 /* Search for a string appearing directly as an element of the keymap.
163 That string is the title of the menu. */
164 prompt
= map_prompt (keymap
);
166 title
= (char *) XSTRING (prompt
)->data
;
168 /* Extract the detailed info to make one pane. */
169 number_of_panes
= keymap_panes (&obj_list
, &menus
, &names
, &items
,
171 /* The menu title seems to be ignored,
172 so put it in the pane title. */
176 else if (!NILP (tem
))
178 /* We were given a list of keymaps. */
180 int nmaps
= XFASTINT (Flength (menu
));
182 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
186 /* The first keymap that has a prompt string
187 supplies the menu title. */
188 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
190 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
192 prompt
= map_prompt (keymap
);
193 if (title
== 0 && !NILP (prompt
))
194 title
= (char *) XSTRING (prompt
)->data
;
197 /* Extract the detailed info to make one pane. */
198 number_of_panes
= keymap_panes (&obj_list
, &menus
, &names
, &items
,
200 /* The menu title seems to be ignored,
201 so put it in the pane title. */
207 /* We were given an old-fashioned menu. */
208 ltitle
= Fcar (menu
);
209 CHECK_STRING (ltitle
, 1);
210 title
= (char *) XSTRING (ltitle
)->data
;
211 number_of_panes
= list_of_panes (&obj_list
, &menus
, &names
, &items
,
215 fprintf (stderr
, "Panes = %d\n", number_of_panes
);
216 for (i
= 0; i
< number_of_panes
; i
++)
218 fprintf (stderr
, "Pane %d has lines %d title %s\n",
219 i
, items
[i
], menus
[i
]);
220 for (j
= 0; j
< items
[i
]; j
++)
221 fprintf (stderr
, " Item %d %s\n", j
, names
[i
][j
]);
225 selection
= xmenu_show (ROOT_WINDOW
, XMenu_xpos
, XMenu_ypos
, names
, menus
,
226 items
, number_of_panes
, obj_list
, title
,
229 /* fprintf (stderr, "selection = %x\n", selection); */
230 if (selection
!= NUL
)
231 { /* selected something */
232 XMenu_return
= selection
;
235 { /* nothing selected */
238 /* now free up the strings */
239 for (i
= 0; i
< number_of_panes
; i
++)
249 if (error_name
) error (error_name
);
259 xmenu_show (parent
, startx
, starty
, line_list
, pane_list
, line_cnt
,
260 pane_cnt
, item_list
, title
, error
)
262 int startx
, starty
; /* upper left corner position BROKEN */
263 char **line_list
[]; /* list of strings for items */
264 char *pane_list
[]; /* list of pane titles */
266 int pane_cnt
; /* total number of panes */
267 Lisp_Object
*item_list
[]; /* All items */
268 int line_cnt
[]; /* Lines in each pane */
269 char **error
; /* Error returned */
272 int last
, panes
, selidx
, lpane
, status
;
275 /* struct indices *datap, *datap_save; */
277 int ulx
, uly
, width
, height
;
278 int dispwidth
, dispheight
;
283 *error
= (char *) 0; /* Initialize error pointer to null */
284 GXMenu
= XMenuCreate (XDISPLAY parent
, "emacs");
287 *error
= "Can't create menu";
291 for (panes
= 0, lines
= 0; panes
< pane_cnt
;
292 lines
+= line_cnt
[panes
], panes
++)
294 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
295 /* datap = (char *) xmalloc (lines * sizeof (char));
296 datap_save = datap;*/
298 for (panes
= 0, sofar
= 0; panes
< pane_cnt
;
299 sofar
+= line_cnt
[panes
], panes
++)
301 /* create all the necessary panes */
302 lpane
= XMenuAddPane (XDISPLAY GXMenu
, pane_list
[panes
], TRUE
);
303 if (lpane
== XM_FAILURE
)
305 XMenuDestroy (XDISPLAY GXMenu
);
306 *error
= "Can't create pane";
309 for (selidx
= 0; selidx
< line_cnt
[panes
]; selidx
++)
311 /* add the selection stuff to the menus */
312 /* datap[selidx+sofar].pane = panes;
313 datap[selidx+sofar].line = selidx; */
314 if (XMenuAddSelection (XDISPLAY GXMenu
, lpane
, 0,
315 line_list
[panes
][selidx
], TRUE
)
318 XMenuDestroy (XDISPLAY GXMenu
);
320 *error
= "Can't add selection to menu";
321 /* error ("Can't add selection to menu"); */
326 /* all set and ready to fly */
327 XMenuRecompute (XDISPLAY GXMenu
);
328 dispwidth
= DisplayWidth (x_current_display
, XDefaultScreen (x_current_display
));
329 dispheight
= DisplayHeight (x_current_display
, XDefaultScreen (x_current_display
));
330 startx
= min (startx
, dispwidth
);
331 starty
= min (starty
, dispheight
);
332 startx
= max (startx
, 1);
333 starty
= max (starty
, 1);
334 XMenuLocate (XDISPLAY GXMenu
, 0, 0, startx
, starty
,
335 &ulx
, &uly
, &width
, &height
);
336 if (ulx
+width
> dispwidth
)
338 startx
-= (ulx
+ width
) - dispwidth
;
339 ulx
= dispwidth
- width
;
341 if (uly
+height
> dispheight
)
343 starty
-= (uly
+ height
) - dispheight
;
344 uly
= dispheight
- height
;
346 if (ulx
< 0) startx
-= ulx
;
347 if (uly
< 0) starty
-= uly
;
349 XMenuSetFreeze (GXMenu
, TRUE
);
352 status
= XMenuActivate (XDISPLAY GXMenu
, &panes
, &selidx
,
353 startx
, starty
, ButtonReleaseMask
, &datap
);
358 fprintf (stderr
, "pane= %d line = %d\n", panes
, selidx
);
360 entry
= item_list
[panes
][selidx
];
363 /* free (datap_save); */
364 XMenuDestroy (XDISPLAY GXMenu
);
365 *error
= "Can't activate menu";
366 /* error ("Can't activate menu"); */
372 XMenuDestroy (XDISPLAY GXMenu
);
373 /* free (datap_save);*/
379 defsubr (&Sx_popup_menu
);
382 /* Construct the vectors that describe a menu
383 and store them in *VECTOR, *PANES, *NAMES and *ITEMS.
384 Each of those four values is a vector indexed by pane number.
385 Return the number of panes.
387 KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */
390 keymap_panes (vector
, panes
, names
, items
, keymaps
, nmaps
)
391 Lisp_Object
***vector
; /* RETURN all menu objects */
392 char ***panes
; /* RETURN pane names */
393 char ****names
; /* RETURN all line names */
394 int **items
; /* RETURN number of items per pane */
395 Lisp_Object
*keymaps
;
398 /* Number of panes we have made. */
400 /* Number of panes we have space for. */
401 int npanes_allocated
= nmaps
;
404 if (npanes_allocated
< 4)
405 npanes_allocated
= 4;
407 /* Make space for an estimated number of panes. */
408 *vector
= (Lisp_Object
**) xmalloc (npanes_allocated
* sizeof (Lisp_Object
*));
409 *panes
= (char **) xmalloc (npanes_allocated
* sizeof (char *));
410 *items
= (int *) xmalloc (npanes_allocated
* sizeof (int));
411 *names
= (char ***) xmalloc (npanes_allocated
* sizeof (char **));
413 /* Loop over the given keymaps, making a pane for each map.
414 But don't make a pane that is empty--ignore that map instead.
415 P is the number of panes we have made so far. */
416 for (mapno
= 0; mapno
< nmaps
; mapno
++)
417 single_keymap_panes (keymaps
[mapno
], panes
, vector
, names
, items
,
418 &p
, &npanes_allocated
, "");
420 /* Return the number of panes. */
424 /* This is a recursive subroutine of the previous function.
425 It handles one keymap, KEYMAP.
426 The other arguments are passed along
427 or point to local variables of the previous function. */
429 single_keymap_panes (keymap
, panes
, vector
, names
, items
,
430 p_ptr
, npanes_allocated_ptr
, pane_name
)
432 Lisp_Object
***vector
; /* RETURN all menu objects */
433 char ***panes
; /* RETURN pane names */
434 char ****names
; /* RETURN all line names */
435 int **items
; /* RETURN number of items per pane */
437 int *npanes_allocated_ptr
;
441 Lisp_Object pending_maps
;
442 Lisp_Object tail
, item
, item1
, item2
, table
;
446 /* Make sure we have room for another pane. */
447 if (*p_ptr
== *npanes_allocated_ptr
)
449 *npanes_allocated_ptr
*= 2;
452 = (Lisp_Object
**) xrealloc (*vector
,
453 *npanes_allocated_ptr
* sizeof (Lisp_Object
*));
455 = (char **) xrealloc (*panes
,
456 *npanes_allocated_ptr
* sizeof (char *));
458 = (int *) xrealloc (*items
,
459 *npanes_allocated_ptr
* sizeof (int));
461 = (char ***) xrealloc (*names
,
462 *npanes_allocated_ptr
* sizeof (char **));
465 /* When a menu comes from keymaps, don't give names to the panes. */
466 (*panes
)[*p_ptr
] = pane_name
;
468 /* Get the length of the list level of the keymap. */
469 i
= XFASTINT (Flength (keymap
));
471 /* Add in lengths of any arrays. */
472 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
473 if (XTYPE (XCONS (tail
)->car
) == Lisp_Vector
)
474 i
+= XVECTOR (XCONS (tail
)->car
)->size
;
476 /* Create vectors for the names and values of the items in the pane.
477 I is an upper bound for the number of items. */
478 (*vector
)[*p_ptr
] = (Lisp_Object
*) xmalloc (i
* sizeof (Lisp_Object
));
479 (*names
)[*p_ptr
] = (char **) xmalloc (i
* sizeof (char *));
481 /* I is now the index of the next unused slots. */
483 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
485 /* Look at each key binding, and if it has a menu string,
486 make a menu item from it. */
487 item
= XCONS (tail
)->car
;
488 if (XTYPE (item
) == Lisp_Cons
)
490 item1
= XCONS (item
)->cdr
;
491 if (XTYPE (item1
) == Lisp_Cons
)
493 item2
= XCONS (item1
)->car
;
494 if (XTYPE (item2
) == Lisp_String
)
497 tem
= Fkeymapp (Fcdr (item1
));
498 if (XSTRING (item2
)->data
[0] == '@' && !NILP (tem
))
499 pending_maps
= Fcons (Fcons (Fcdr (item1
), item2
),
503 (*names
)[*p_ptr
][i
] = (char *) XSTRING (item2
)->data
;
504 /* The menu item "value" is the key bound here. */
505 (*vector
)[*p_ptr
][i
] = XCONS (item
)->car
;
511 else if (XTYPE (item
) == Lisp_Vector
)
513 /* Loop over the char values represented in the vector. */
514 int len
= XVECTOR (item
)->size
;
516 for (c
= 0; c
< len
; c
++)
518 Lisp_Object character
;
519 XFASTINT (character
) = c
;
520 item1
= XVECTOR (item
)->contents
[c
];
521 if (XTYPE (item1
) == Lisp_Cons
)
523 item2
= XCONS (item1
)->car
;
524 if (XTYPE (item2
) == Lisp_String
)
527 tem
= Fkeymapp (Fcdr (item1
));
528 if (XSTRING (item2
)->data
[0] == '@' && !NILP (tem
))
529 pending_maps
= Fcons (Fcons (Fcdr (item1
), item2
),
533 (*names
)[*p_ptr
][i
] = (char *) XSTRING (item2
)->data
;
534 /* The menu item "value" is the key bound here. */
535 (*vector
)[*p_ptr
][i
] = character
;
543 /* Record the number of items in the pane. */
544 (*items
)[*p_ptr
] = i
;
546 /* If we just made an empty pane, get rid of it. */
549 free ((*vector
)[*p_ptr
]);
550 free ((*names
)[*p_ptr
]);
552 /* Otherwise, advance past it. */
556 /* Process now any submenus which want to be panes at this level. */
557 while (!NILP (pending_maps
))
560 elt
= Fcar (pending_maps
);
561 single_keymap_panes (Fcar (elt
), panes
, vector
, names
, items
,
562 p_ptr
, npanes_allocated_ptr
,
563 /* Add 1 to discard the @. */
564 (char *) XSTRING (XCONS (elt
)->cdr
)->data
+ 1);
565 pending_maps
= Fcdr (pending_maps
);
569 /* Construct the vectors that describe a menu
570 and store them in *VECTOR, *PANES, *NAMES and *ITEMS.
571 Each of those four values is a vector indexed by pane number.
572 Return the number of panes.
574 MENU is the argument that was given to Fx_popup_menu. */
577 list_of_panes (vector
, panes
, names
, items
, menu
)
578 Lisp_Object
***vector
; /* RETURN all menu objects */
579 char ***panes
; /* RETURN pane names */
580 char ****names
; /* RETURN all line names */
581 int **items
; /* RETURN number of items per pane */
584 Lisp_Object tail
, item
, item1
;
587 if (XTYPE (menu
) != Lisp_Cons
) menu
= wrong_type_argument (Qlistp
, menu
);
589 i
= XFASTINT (Flength (menu
));
591 *vector
= (Lisp_Object
**) xmalloc (i
* sizeof (Lisp_Object
*));
592 *panes
= (char **) xmalloc (i
* sizeof (char *));
593 *items
= (int *) xmalloc (i
* sizeof (int));
594 *names
= (char ***) xmalloc (i
* sizeof (char **));
596 for (i
= 0, tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
), i
++)
598 item
= Fcdr (Fcar (tail
));
599 if (XTYPE (item
) != Lisp_Cons
) (void) wrong_type_argument (Qlistp
, item
);
601 fprintf (stderr
, "list_of_panes check tail, i=%d\n", i
);
603 item1
= Fcar (Fcar (tail
));
604 CHECK_STRING (item1
, 1);
606 fprintf (stderr
, "list_of_panes check pane, i=%d%s\n", i
,
607 XSTRING (item1
)->data
);
609 (*panes
)[i
] = (char *) XSTRING (item1
)->data
;
610 (*items
)[i
] = list_of_items ((*vector
)+i
, (*names
)+i
, item
);
611 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
612 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
618 /* Construct the lists of values and names for a single pane, from the
619 alist PANE. Put them in *VECTOR and *NAMES.
620 Return the number of items. */
623 list_of_items (vector
, names
, pane
) /* get list from emacs and put to vector */
624 Lisp_Object
**vector
; /* RETURN menu "objects" */
625 char ***names
; /* RETURN line names */
628 Lisp_Object tail
, item
, item1
;
631 if (XTYPE (pane
) != Lisp_Cons
) pane
= wrong_type_argument (Qlistp
, pane
);
633 i
= XFASTINT (Flength (pane
, 1));
635 *vector
= (Lisp_Object
*) xmalloc (i
* sizeof (Lisp_Object
));
636 *names
= (char **) xmalloc (i
* sizeof (char *));
638 for (i
= 0, tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
), i
++)
641 if (XTYPE (item
) != Lisp_Cons
) (void) wrong_type_argument (Qlistp
, item
);
643 fprintf (stderr
, "list_of_items check tail, i=%d\n", i
);
645 (*vector
)[i
] = Fcdr (item
);
647 CHECK_STRING (item1
, 1);
649 fprintf (stderr
, "list_of_items check item, i=%d%s\n", i
,
650 XSTRING (item1
)->data
);
652 (*names
)[i
] = (char *) XSTRING (item1
)->data
;