Initial revision
[bpt/emacs.git] / src / xmenu.c
CommitLineData
dcfdbac7
JB
1/* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20/* X pop-up deck-of-cards menu facility for gnuemacs.
21 *
22 * Written by Jon Arnold and Roman Budzianowski
23 * Mods and rewrite by Robert Krawitz
24 *
25 */
26
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 $
31 *
32 */
33
34#ifndef lint
35static 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
40
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"
47
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"
51
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
57
58#include "dispextern.h"
59
60#ifdef HAVE_X11
61#include "../oldXMenu/XMenu.h"
62#else
63#include <X/XMenu.h>
64#endif
65
66#define min(x,y) (((x) < (y)) ? (x) : (y))
67#define max(x,y) (((x) > (y)) ? (x) : (y))
68
69#define NUL 0
70
71#ifndef TRUE
72#define TRUE 1
73#define FALSE 0
74#endif TRUE
75
76#ifdef HAVE_X11
77extern Display *x_current_display;
78#else
79#define ButtonReleaseMask ButtonReleased
80#endif /* not HAVE_X11 */
81
82Lisp_Object xmenu_show ();
83extern int x_error_handler ();
84
85/*************************************************************/
86
87#if 0
88/* Ignoring the args is easiest. */
89xmenu_quit ()
90{
91 error ("Unknown XMenu error");
92}
93#endif
94
95DEFUN ("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\
97ARG is a position specification: a list ((XOFFSET YOFFSET) WINDOW)\n\
98where XOFFSET and YOFFSET are positions in characters from the top left\n\
99corner of WINDOW's screen. A mouse-event list will serve for this.\n\
100This controls the position of the center of the first line\n\
101in the first pane of the menu, not the top left of the menu as a whole.\n\
102\n\
103MENU 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\
106be the return value for that line (i.e. if it is selected.")
107 (arg, menu)
108 Lisp_Object arg, menu;
109{
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;
123
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)));
131
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;
136
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++)
144 {
145 fprintf (stderr, "Pane %d lines %d title %s\n", i, items[i], menus[i]);
146 for (j=0; j < items[i]; j++)
147 {
148 fprintf (stderr, " Item %d %s\n", j, names[i][j]);
149 }
150 }
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;
160 }
161 else
162 { /* nothing selected */
163 XMenu_return = Qnil;
164 }
165 /* now free up the strings */
166 for (i=0; i < number_of_panes; i++)
167 {
168 free (names[i]);
169 free (obj_list[i]);
170 }
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;
178}
179
180struct indices {
181 int pane;
182 int line;
183};
184
185Lisp_Object
186xmenu_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 */
197{
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;
206
207 *error = (char *) 0; /* Initialize error pointer to null */
208 GXMenu = XMenuCreate (XDISPLAY parent, "emacs");
209 if (GXMenu == NUL)
210 {
211 *error = "Can't create menu";
212 return (0);
213 }
214
215 for (panes=0, lines=0; panes < pane_cnt; lines += line_cnt[panes], panes++)
216 ;
217 /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */
218 /*datap = (char *) xmalloc (lines * sizeof (char));
219 datap_save = datap;*/
220
221 for (panes = 0, sofar=0;panes < pane_cnt;sofar +=line_cnt[panes], panes++)
222 {
223 /* create all the necessary panes */
224 lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE);
225 if (lpane == XM_FAILURE)
226 {
227 XMenuDestroy (XDISPLAY GXMenu);
228 *error = "Can't create pane";
229 return (0);
230 }
231 for (selidx = 0; selidx < line_cnt[panes] ; selidx++)
232 {
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)
239 {
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);
245 }
246 }
247 }
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)
259 {
260 startx -= (ulx + width) - dispwidth;
261 ulx = dispwidth - width;
262 }
263 if (uly+height > dispheight)
264 {
265 starty -= (uly + height) - dispheight;
266 uly = dispheight - height;
267 }
268 if (ulx < 0) startx -= ulx;
269 if (uly < 0) starty -= uly;
270
271 XMenuSetFreeze (GXMenu, TRUE);
272 panes = selidx = 0;
273
274 status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx,
275 startx, starty, ButtonReleaseMask, &datap);
276 switch (status)
277 {
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;
293 }
294 XMenuDestroy (XDISPLAY GXMenu);
295 /*free (datap_save);*/
296 return (entry);
297}
298
299syms_of_xmenu ()
300{
301 defsubr (&Sx_popup_menu);
302}
303
304list_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;
310{
311 Lisp_Object tail, item, item1;
312 int i;
313
314 if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu);
315
316 i= XFASTINT (Flength (menu, 1));
317
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 **));
322
323 for (i=0, tail = menu; !NULL (tail); tail = Fcdr (tail), i++)
324 {
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 ; */
341 }
342 return i;
343}
344
345
346list_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;
350{
351 Lisp_Object tail, item, item1;
352 int i;
353
354 if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane);
355
356 i= XFASTINT (Flength (pane, 1));
357
358 *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object));
359 *names = (char **) xmalloc (i * sizeof (char *));
360
361 for (i=0, tail = pane; !NULL (tail); tail = Fcdr (tail), i++)
362 {
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;
376 }
377 return i;
378}