src/xmenu.c

   1 /* X Communication module for terminals which understand the X protocol.
   2    Copyright (C) 1986, 1988 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   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.
  10
  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.
  15
  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.  */
  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
  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
  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
  77 extern Display *x_current_display;
  78 #else
  79 #define ButtonReleaseMask ButtonReleased
  80 #endif /* not HAVE_X11 */
  81
  82 Lisp_Object xmenu_show ();
  83 extern int x_error_handler ();
  84
  85 /*************************************************************/
  86
  87 #if 0
  88 /* Ignoring the args is easiest.  */
  89 xmenu_quit ()
  90 {
  91   error ("Unknown XMenu error");
  92 }
  93 #endif
  94
  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\
 102 \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;
 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
 180 struct indices {
 181   int pane;
 182   int line;
 183 };
 184
 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 */
 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
 299 syms_of_xmenu ()
 300 {
 301   defsubr (&Sx_popup_menu);
 302 }
 303
 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;
 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; !NILP (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
 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;
 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; !NILP (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 }