*** empty log message ***
[emacs.git] / src / xmenu.c
blob120af6bf94cc6c6d9a0dddc98bc8155d0c03ac67
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)
9 any later version.
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
27 /* $Source: /u2/third_party/gnuemacs.chow/src/RCS/xmenu.c,v $
28 * $Author: rlk $
29 * $Locker: $
30 * $Header: xmenu.c,v 1.6 86/08/26 17:23:26 rlk Exp $
34 #ifndef lint
35 static char *rcsid_GXMenu_c = "$Header: xmenu.c,v 1.6 86/08/26 17:23:26 rlk Exp $";
36 #endif lint
37 #ifdef XDEBUG
38 #include <stdio.h>
39 #endif
41 /* On 4.3 this loses if it comes after xterm.h. */
42 #include <signal.h>
43 #include "config.h"
44 #include "lisp.h"
45 #include "screen.h"
46 #include "window.h"
48 /* This may include sys/types.h, and that somehow loses
49 if this is not done before the other system files. */
50 #include "xterm.h"
52 /* Load sys/types.h if not already loaded.
53 In some systems loading it twice is suicidal. */
54 #ifndef makedev
55 #include <sys/types.h>
56 #endif
58 #include "dispextern.h"
60 #ifdef HAVE_X11
61 #include "../oldXMenu/XMenu.h"
62 #else
63 #include <X/XMenu.h>
64 #endif
66 #define min(x,y) (((x) < (y)) ? (x) : (y))
67 #define max(x,y) (((x) > (y)) ? (x) : (y))
69 #define NUL 0
71 #ifndef TRUE
72 #define TRUE 1
73 #define FALSE 0
74 #endif TRUE
76 #ifdef HAVE_X11
77 extern Display *x_current_display;
78 #else
79 #define ButtonReleaseMask ButtonReleased
80 #endif /* not HAVE_X11 */
82 Lisp_Object xmenu_show ();
83 extern int x_error_handler ();
85 /*************************************************************/
87 #if 0
88 /* Ignoring the args is easiest. */
89 xmenu_quit ()
91 error ("Unknown XMenu error");
93 #endif
95 DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 2, 0,
96 "Pop up a deck-of-cards menu and return user's selection.\n\
97 ARG is a position specification: a list ((XOFFSET YOFFSET) WINDOW)\n\
98 where XOFFSET and YOFFSET are positions in characters from the top left\n\
99 corner of WINDOW's screen. A mouse-event list will serve for this.\n\
100 This controls the position of the center of the first line\n\
101 in the first pane of the menu, not the top left of the menu as a whole.\n\
103 MENU is a specifier for a menu. It is a list of the form\n\
104 \(TITLE PANE1 PANE2...), and each pane is a list of form\n\
105 \(TITLE (LINE ITEM)...). Each line should be a string, and item should\n\
106 be the return value for that line (i.e. if it is selected.")
107 (arg, menu)
108 Lisp_Object arg, menu;
110 int number_of_panes;
111 Lisp_Object XMenu_return;
112 int XMenu_xpos, XMenu_ypos;
113 char **menus;
114 char ***names;
115 Lisp_Object **obj_list;
116 int *items;
117 char *title;
118 char *error_name;
119 Lisp_Object ltitle, selection;
120 int i, j;
121 SCREEN_PTR s;
122 Lisp_Object x, y, window;
124 window = Fcar (Fcdr (arg));
125 x = Fcar (Fcar (arg));
126 y = Fcar (Fcdr (Fcar (arg)));
127 CHECK_WINDOW (window, 0);
128 CHECK_NUMBER (x, 0);
129 CHECK_NUMBER (y, 0);
130 s = XSCREEN (WINDOW_SCREEN (XWINDOW (window)));
132 XMenu_xpos = FONT_WIDTH (s->display.x->font) * XINT (x);
133 XMenu_ypos = FONT_HEIGHT (s->display.x->font) * XINT (y);
134 XMenu_xpos += s->display.x->left_pos;
135 XMenu_ypos += s->display.x->top_pos;
137 ltitle = Fcar (menu);
138 CHECK_STRING (ltitle, 1);
139 title = (char *) XSTRING (ltitle)->data;
140 number_of_panes=list_of_panes (&obj_list, &menus, &names, &items, Fcdr (menu));
141 #ifdef XDEBUG
142 fprintf (stderr, "Panes= %d\n", number_of_panes);
143 for (i=0; i < number_of_panes; i++)
145 fprintf (stderr, "Pane %d lines %d title %s\n", i, items[i], menus[i]);
146 for (j=0; j < items[i]; j++)
148 fprintf (stderr, " Item %d %s\n", j, names[i][j]);
151 #endif
152 BLOCK_INPUT;
153 selection = xmenu_show (ROOT_WINDOW, XMenu_xpos, XMenu_ypos, names, menus,
154 items, number_of_panes, obj_list, title, &error_name);
155 UNBLOCK_INPUT;
156 /** fprintf (stderr, "selection = %x\n", selection); **/
157 if (selection != NUL)
158 { /* selected something */
159 XMenu_return = selection;
161 else
162 { /* nothing selected */
163 XMenu_return = Qnil;
165 /* now free up the strings */
166 for (i=0; i < number_of_panes; i++)
168 free (names[i]);
169 free (obj_list[i]);
171 free (menus);
172 free (obj_list);
173 free (names);
174 free (items);
175 /* free (title); */
176 if (error_name) error (error_name);
177 return XMenu_return;
180 struct indices {
181 int pane;
182 int line;
185 Lisp_Object
186 xmenu_show (parent, startx, starty, line_list, pane_list, line_cnt,
187 pane_cnt, item_list, title, error)
188 Window parent;
189 int startx, starty; /* upper left corner position BROKEN */
190 char **line_list[]; /* list of strings for items */
191 char *pane_list[]; /* list of pane titles */
192 char *title;
193 int pane_cnt; /* total number of panes */
194 Lisp_Object *item_list[]; /* All items */
195 int line_cnt[]; /* Lines in each pane */
196 char **error; /* Error returned */
198 XMenu *GXMenu;
199 int last, panes, selidx, lpane, status;
200 int lines, sofar;
201 Lisp_Object entry;
202 /* struct indices *datap, *datap_save; */
203 char *datap;
204 int ulx, uly, width, height;
205 int dispwidth, dispheight;
207 *error = (char *) 0; /* Initialize error pointer to null */
208 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
209 if (GXMenu == NUL)
211 *error = "Can't create menu";
212 return (0);
215 for (panes=0, lines=0; panes < pane_cnt; lines += line_cnt[panes], panes++)
217 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
218 /*datap = (char *) xmalloc (lines * sizeof (char));
219 datap_save = datap;*/
221 for (panes = 0, sofar=0;panes < pane_cnt;sofar +=line_cnt[panes], panes++)
223 /* create all the necessary panes */
224 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
225 if (lpane == XM_FAILURE)
227 XMenuDestroy (XDISPLAY GXMenu);
228 *error = "Can't create pane";
229 return (0);
231 for (selidx = 0; selidx < line_cnt[panes] ; selidx++)
233 /* add the selection stuff to the menus */
234 /* datap[selidx+sofar].pane = panes;
235 datap[selidx+sofar].line = selidx; */
236 if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0,
237 line_list[panes][selidx], TRUE)
238 == XM_FAILURE)
240 XMenuDestroy (XDISPLAY GXMenu);
241 /* free (datap); */
242 *error = "Can't add selection to menu";
243 /* error ("Can't add selection to menu"); */
244 return (0);
248 /* all set and ready to fly */
249 XMenuRecompute (XDISPLAY GXMenu);
250 dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display));
251 dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display));
252 startx = min (startx, dispwidth);
253 starty = min (starty, dispheight);
254 startx = max (startx, 1);
255 starty = max (starty, 1);
256 XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty,
257 &ulx, &uly, &width, &height);
258 if (ulx+width > dispwidth)
260 startx -= (ulx + width) - dispwidth;
261 ulx = dispwidth - width;
263 if (uly+height > dispheight)
265 starty -= (uly + height) - dispheight;
266 uly = dispheight - height;
268 if (ulx < 0) startx -= ulx;
269 if (uly < 0) starty -= uly;
271 XMenuSetFreeze (GXMenu, TRUE);
272 panes = selidx = 0;
274 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
275 startx, starty, ButtonReleaseMask, &datap);
276 switch (status)
278 case XM_SUCCESS:
279 #ifdef XDEBUG
280 fprintf (stderr, "pane= %d line = %d\n", panes, selidx);
281 #endif
282 entry = item_list[panes][selidx];
283 break;
284 case XM_FAILURE:
285 /*free (datap_save); */
286 XMenuDestroy (XDISPLAY GXMenu);
287 *error = "Can't activate menu";
288 /* error ("Can't activate menu"); */
289 case XM_IA_SELECT:
290 case XM_NO_SELECT:
291 entry = Qnil;
292 break;
294 XMenuDestroy (XDISPLAY GXMenu);
295 /*free (datap_save);*/
296 return (entry);
299 syms_of_xmenu ()
301 defsubr (&Sx_popup_menu);
304 list_of_panes (vector, panes, names, items, menu)
305 Lisp_Object ***vector; /* RETURN all menu objects */
306 char ***panes; /* RETURN pane names */
307 char ****names; /* RETURN all line names */
308 int **items; /* RETURN number of items per pane */
309 Lisp_Object menu;
311 Lisp_Object tail, item, item1;
312 int i;
314 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
316 i= XFASTINT (Flength (menu, 1));
318 *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *));
319 *panes = (char **) xmalloc (i * sizeof (char *));
320 *items = (int *) xmalloc (i * sizeof (int));
321 *names = (char ***) xmalloc (i * sizeof (char **));
323 for (i=0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++)
325 item = Fcdr (Fcar (tail));
326 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
327 #ifdef XDEBUG
328 fprintf (stderr, "list_of_panes check tail, i=%d\n", i);
329 #endif
330 item1 = Fcar (Fcar (tail));
331 CHECK_STRING (item1, 1);
332 #ifdef XDEBUG
333 fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i,
334 XSTRING (item1)->data);
335 #endif
336 (*panes)[i] = (char *) XSTRING (item1)->data;
337 (*items)[i] = list_of_items ((*vector)+i, (*names)+i, item);
338 /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1);
339 bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1)
340 ; */
342 return i;
346 list_of_items (vector, names, pane) /* get list from emacs and put to vector */
347 Lisp_Object **vector; /* RETURN menu "objects" */
348 char ***names; /* RETURN line names */
349 Lisp_Object pane;
351 Lisp_Object tail, item, item1;
352 int i;
354 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
356 i= XFASTINT (Flength (pane, 1));
358 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
359 *names = (char **) xmalloc (i * sizeof (char *));
361 for (i=0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++)
363 item = Fcar (tail);
364 if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item);
365 #ifdef XDEBUG
366 fprintf (stderr, "list_of_items check tail, i=%d\n", i);
367 #endif
368 (*vector)[i] = Fcdr (item);
369 item1 = Fcar (item);
370 CHECK_STRING (item1, 1);
371 #ifdef XDEBUG
372 fprintf (stderr, "list_of_items check item, i=%d%s\n", i,
373 XSTRING (item1)->data);
374 #endif
375 (*names)[i] = (char *) XSTRING (item1)->data;
377 return i;