/* Additional Amiga Menu Bar stuff, should be moved to amiga_menu Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. 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 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #include #include #include #include #include #include #include "config.h" #include "lisp.h" #include "frame.h" #include "amiga.h" #ifdef USE_PROTOS #include "protos.h" #endif extern Lisp_Object Qmenu_enable; #if 0 extern Lisp_Object Qmenu_bar; #endif /* 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 4 elements per item: the item string, the enable flag, the item's value, 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 #define MENU_ITEMS_ITEM_NAME 0 #define MENU_ITEMS_ITEM_ENABLE 1 #define MENU_ITEMS_ITEM_VALUE 2 #define MENU_ITEMS_ITEM_EQUIV_KEY 3 #define MENU_ITEMS_ITEM_LENGTH 4 #ifdef MULTI_FRAME you lose! /* each frame needs one of these or it must be copied */ #else static Lisp_Object menu_items; #endif /* Number of slots currently allocated in menu_items. */ static int menu_items_allocated; /* This is ( + + ) */ static int menu_items_num_items; /* 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; /* sum of length of strings used in the current menu */ static int menu_items_string_len; /* Initialize the menu_items structure if we haven't already done so. Also mark it as currently empty. */ static void init_menu_items () { if (NILP (menu_items)) { menu_items_allocated = 60; menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); } menu_items_used = 0; menu_items_n_panes = 0; menu_items_submenu_depth = 0; menu_items_string_len = 0; menu_items_num_items = 0; } /* Call at the end of generating the data in menu_items. This fills in the number of items in the last pane. */ static void finish_menu_items () { } /* Call when finished using the data for the current menu in menu_items. */ static void discard_menu_items () { /* Free the structure if it is especially large. Otherwise, hold on to it, to save time. */ if (menu_items_allocated > 200) { menu_items = Qnil; menu_items_allocated = 0; } } /* Make the menu_items vector twice as large. */ static void grow_menu_items () { 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)); } /* Begin a submenu. */ static void push_submenu_start () { if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = Qnil; menu_items_submenu_depth++; } /* End a submenu. */ static void push_submenu_end () { if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda; menu_items_submenu_depth--; } /* Indicate boundary between left and right. */ static void push_left_right_boundary () { if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = Qquote; } /* Start a new menu pane in menu_items.. NAME is the pane name. PREFIX_VEC is a prefix key for this pane. NAME_LEN is the length of the name in characters. */ static void push_menu_pane (Lisp_Object name, Lisp_Object prefix_vec, int name_len) { if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated) grow_menu_items (); if (menu_items_submenu_depth == 0) menu_items_n_panes++; XVECTOR (menu_items)->contents[menu_items_used++] = Qt; XVECTOR (menu_items)->contents[menu_items_used++] = name; XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec; menu_items_string_len += name_len + 1; menu_items_num_items++; } /* 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. EQUIV is the textual description of the keyboard equivalent for this item (or nil if none). NAME_LEN is the length of the name in characters. */ static void push_menu_item (Lisp_Object name, Lisp_Object enable, Lisp_Object key, Lisp_Object equiv, int name_len) { if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated) grow_menu_items (); XVECTOR (menu_items)->contents[menu_items_used++] = name; XVECTOR (menu_items)->contents[menu_items_used++] = enable; XVECTOR (menu_items)->contents[menu_items_used++] = key; XVECTOR (menu_items)->contents[menu_items_used++] = equiv; menu_items_string_len += name_len + 1; menu_items_num_items++; } /* Figure out the current keyboard equivalent of a menu item ITEM1. The item string for menu display should be ITEM_STRING. Store the equivalent keyboard key sequence's textual description into *DESCRIP_PTR. Also cache them in the item itself. Return the real definition to execute. */ static Lisp_Object menu_item_equiv_key (item_string, item1, descrip_ptr) Lisp_Object item_string; Lisp_Object item1; Lisp_Object *descrip_ptr; { /* This is the real definition--the function to run. */ Lisp_Object def; /* This is the sublist that records cached equiv key data so we can save time. */ Lisp_Object cachelist; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object savedkey, descrip; Lisp_Object def1; int changed = 0; /* If a help string follows the item string, skip it. */ if (CONSP (XCONS (item1)->cdr) && STRINGP (XCONS (XCONS (item1)->cdr)->car)) item1 = XCONS (item1)->cdr; def = Fcdr (item1); /* Get out the saved equivalent-keyboard-key info. */ cachelist = savedkey = descrip = Qnil; if (CONSP (def) && CONSP (XCONS (def)->car) && (NILP (XCONS (XCONS (def)->car)->car) || VECTORP (XCONS (XCONS (def)->car)->car))) { cachelist = XCONS (def)->car; def = XCONS (def)->cdr; savedkey = XCONS (cachelist)->car; descrip = XCONS (cachelist)->cdr; } /* Is it still valid? */ def1 = Qnil; if (!NILP (savedkey)) def1 = Fkey_binding (savedkey, Qnil); /* If not, update it. */ if (! EQ (def1, def) /* If something had no key binding before, don't recheck it-- doing that takes too much time and makes menus too slow. */ && !(!NILP (cachelist) && NILP (savedkey))) { changed = 1; descrip = Qnil; savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); /* If the command is an alias for another (such as easymenu.el and lmenu.el set it up), see if the original command name has equivalent keys. */ if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)) savedkey = Fwhere_is_internal (XSYMBOL (def)->function, Qnil, Qt, Qnil); if (VECTORP (savedkey) && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar)) savedkey = Qnil; if (!NILP (savedkey)) { descrip = Fkey_description (savedkey); descrip = concat2 (make_string (" (", 3), descrip); descrip = concat2 (descrip, make_string (")", 1)); } } /* Cache the data we just got in a sublist of the menu binding. */ if (NILP (cachelist)) XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def); else if (changed) { XCONS (cachelist)->car = savedkey; XCONS (cachelist)->cdr = descrip; } *descrip_ptr = descrip; return def; } /* This is used as the handler when calling internal_condition_case_1. */ static Lisp_Object menu_item_enabled_p_1 (arg) Lisp_Object arg; { return Qnil; } /* Return non-nil if the command DEF is enabled when used as a menu item. This is based on looking for a menu-enable property. If NOTREAL is set, don't bother really computing this. */ static Lisp_Object menu_item_enabled_p (def, notreal) Lisp_Object def; { Lisp_Object enabled, tem; enabled = Qt; if (notreal) return enabled; if (XTYPE (def) == Lisp_Symbol) { /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ tem = Fget (def, Qmenu_enable); if (!NILP (tem)) /* (condition-case nil (eval tem) (error nil)) */ enabled = internal_condition_case_1 (Feval, tem, Qerror, menu_item_enabled_p_1); } return enabled; } void make_amiga_menu_1(FRAME_PTR f,int doprint); void make_menu_items(FRAME_PTR f, Lisp_Object menu); void make_amiga_menu(FRAME_PTR f, Lisp_Object menu) { make_menu_items(f, menu); if(menu_items_used) { make_amiga_menu_1(f, 0); } } extern struct Library *GadToolsBase; void print_amiga_menu(FRAME_PTR f) { make_amiga_menu_1(f,1); } void make_amiga_menu_1(FRAME_PTR f, int doprint) { struct NewMenu *menudata, *mkm; char *strdata; int i, t, first_pane = 0, submenu_depth = 0; int level = 0; if(!doprint) { check_intuition(); suspend_menus(f); if (EMACS_MENU(f)) Famiga_delete_menus(f); /* Now create menu structure */ menudata = (struct NewMenu *)alloca(sizeof(struct NewMenu) * (menu_items_num_items + 1)); EMACS_MENU_STRINGS(f) = strdata = (char *)xmalloc(menu_items_string_len); mkm = menudata; } /* Loop over all panes and items, print/creating menu structure. */ i = 0; while (i < menu_items_used) { /* CHFIXME */ if(mkm >= menudata+menu_items_num_items + 1) abort(); if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { submenu_depth++; first_pane = 1; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { --submenu_depth; first_pane = 0; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qt) && submenu_depth != 0) i += MENU_ITEMS_PANE_LENGTH; /* Ignore a nil in the item list. It\'s meaningful only for dialog boxes. */ else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { /* Create a new pane. */ Lisp_Object pane_name, prefix; char *pane_string; int len; pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); /* If there is just one top-level pane, put all its items directly under the top-level menu. */ if (menu_items_n_panes == 1) pane_string = ""; /* If the pane has a meaningful name, make the pane a top-level menu item with its items as a submenu beneath it. */ len = strlen(pane_string); if (len) { if(doprint) { for(t = 0; t < submenu_depth; t++) fprintf(stderr," "); fprintf(stderr,"pane = \"%s\"\n", pane_string); } else { mkm->nm_Type = NM_TITLE; strncpy(strdata, pane_string, len+1); mkm->nm_Label = strdata; strdata += len + 1; mkm->nm_CommKey = 0; mkm->nm_Flags = 0; mkm->nm_MutualExclude = 0; mkm++; } #if 0 if (keymaps && !NILP (prefix)) wv->name++; #endif #if 0 wv->value = 0; wv->enabled = 1; #endif } else if (first_pane) { } first_pane = 0; i += MENU_ITEMS_PANE_LENGTH; } else { /* Create a new item within current pane. */ Lisp_Object item_name, enable, descrip, key; char *key_string; int len; item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; /* The key generated by choosing this item */ key = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; if(NILP(key)) key_string = ""; else if(XTYPE(key) == Lisp_String) key_string = (char *) XSTRING (key)->data; else if(XTYPE(key) == Lisp_Symbol) key_string = (char *) XSYMBOL (key)->name->data; else key_string = ""; if(doprint) { for(t = 0; t < submenu_depth+1; t++) fprintf(stderr," "); fprintf(stderr,"name = \"%s\", key = [%s] %s\n", (char *) XSTRING (item_name)->data, key_string, (NILP(enable)) ? "" : "" ); } else { len = XSTRING (item_name)->size; if(submenu_depth == 0) { mkm->nm_Type = NM_ITEM; } else if(submenu_depth == 1) { mkm->nm_Type = NM_SUB; } else abort(); strncpy(strdata, XSTRING (item_name)->data, len+1); mkm->nm_Label = strdata; strdata += len + 1; mkm->nm_CommKey = 0; mkm->nm_Flags = 0; mkm->nm_MutualExclude = 0; if(NILP(enable)) mkm->nm_Flags |= NM_ITEMDISABLED; mkm++; } #if 0 wv->value = 0; wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; #endif i += MENU_ITEMS_ITEM_LENGTH; } } mkm->nm_Type = NM_END; mkm->nm_Label = 0; mkm->nm_CommKey = 0; mkm->nm_Flags = 0; mkm->nm_MutualExclude = 0; if (!(EMACS_MENU(f) = CreateMenus(menudata, TAG_END))) { free(EMACS_MENU_STRINGS(f)); EMACS_MENU_STRINGS(f) = 0; #if 0 error("Menu couldn't be created"); /* CHFIXME: how to do it for this kind of function? */ #else fprintf(stderr,"Menu couldn't be created"); #endif } if (!resume_menus(f)) #if 0 error("Menu couldn't be layed out"); #else fprintf(stderr, "Menu couldn't be layed out"); #endif } void make_menu_items(FRAME_PTR f, Lisp_Object menu) { Lisp_Object Result; int i; init_menu_items(); /* CHFIXME */ for (i = 0; i < XVECTOR (menu)->size;i += 3) { Lisp_Object string; Lisp_Object Key, enable, descrip; Lisp_Object binding; Key = XVECTOR (menu)->contents[i]; string = XVECTOR (menu)->contents[i + 1]; binding = XVECTOR (menu)->contents[i + 2]; if(NILP(string)) break; make_menu_items_1(Key, string, binding); } } /* CHFIXME */ #define Check(obj, type) if(XTYPE(obj) != type)\ {\ fprintf(stderr,"make_menu_items_1: Unknown structure (line %d, type %d)\n", __LINE__,XTYPE(obj)); \ break;\ } Lisp_Object make_menu_items_1(Lisp_Object prefix, Lisp_Object pane_name, Lisp_Object binding) { Lisp_Object Result; int i; Lisp_Object pending_maps; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object litems, litem; Lisp_Object lsubitems, lsubitem; struct Lisp_Cons *item; struct Lisp_Cons *subitem; pending_maps = Qnil; do { Check(prefix, Lisp_Symbol); Check(pane_name, Lisp_String); push_menu_pane (pane_name, prefix, XSTRING(pane_name)->size); Check(binding, Lisp_Cons); binding = XCONS(binding)->car; if(EQ(XCONS(binding)->car, Qkeymap)) { for(litems = XCONS(binding)->cdr; XTYPE(litems) == Lisp_Cons; litems = XCONS(litems)->cdr) { litem = XCONS(litems)->car; if(XTYPE(litem) == Lisp_String) { /* ((keymap "Select Buffer" ("*scratch*" "*scratch* " (nil) . menu-bar-select-buffer) (list-buffers "List All Buffers" . list-buffers))) ((keymap (open-file "Open File..." . find-file) (dired "Open Directory..." . dired) "File")) */ #if 0 /* CHFIXME: ignore this name. redundant? */ fprintf(stderr,"\tmenu = %s\n", (char *) XSTRING (litem)->data); #endif } else { Lisp_Object Def; /* These are the saved equivalent keyboard key sequence and its key-description. */ Lisp_Object descrip; Lisp_Object tem, enabled; Lisp_Object prefix,item_string; Check(litem, Lisp_Cons); item = XCONS(litem); prefix = item->car; #if 0 /* test Buffers menu (strings) */ Check(prefix, Lisp_Symbol); /* CHFIXME */ if(XTYPE(prefix) == Lisp_String) { break; /* CHFIXME */ } else if(XTYPE(prefix) == Lisp_Symbol) ; else Check(prefix, Lisp_Symbol); #endif Check(item->cdr, Lisp_Cons); item = XCONS(item->cdr); item_string = item->car; Check(item_string, Lisp_String); Def = item->cdr; /* CHFIXME: Def may be (lambda ....) */ #if 0 Check(Def, Lisp_Symbol); #endif #if 0 def = menu_item_equiv_key (item_string, item1, &descrip); #endif #if 0 /* currently not needed, all we have is protected */ /* GCPRO because we will call eval. Protecting KEYMAP preserves everything we use; aside from that, must protect whatever might be a string. Since there's no GCPRO5, we refetch item_string instead of protecting it. */ GCPRO4 (keymap, pending_maps, def, descrip); #endif #if 0 enabled = menu_item_enabled_p (def, notreal); #endif #if 0 UNGCPRO; #endif push_menu_item(item_string, /* enabled */ Qt, prefix, /* descrip */ Qnil, XSTRING(item_string)->size); if(XTYPE(Def) == Lisp_Symbol) lsubitems = XSYMBOL(Def)->value; else lsubitems = Qnil; if((XTYPE(lsubitems) == Lisp_Cons) && EQ(XCONS(lsubitems)->car, Qkeymap)) { push_submenu_start (); for(lsubitems = XCONS(lsubitems)->cdr; XTYPE(lsubitems) == Lisp_Cons; lsubitems = XCONS(lsubitems)->cdr) { Check(lsubitems, Lisp_Cons); lsubitem = XCONS(lsubitems)->car; if(XTYPE(lsubitem) == Lisp_String) { /* ignore this name */ } else { Check(lsubitem, Lisp_Cons); subitem = XCONS(lsubitem); prefix = subitem->car; Check(prefix, Lisp_Symbol); /* CHFIXME */ Check(subitem->cdr, Lisp_Cons); subitem = XCONS(subitem->cdr); item_string = subitem->car; Check(item_string, Lisp_String); Def = subitem->cdr; push_menu_item(item_string, /* enabled */ Qt, prefix, /* descrip */ Qnil, XSTRING(item_string)->size); } } push_submenu_end (); } } } } else { fprintf(stderr,"make_menu_items_1: Unknown structure\n"); } } while(0); } /* * Map actual menu selection to Lisp Symbol * * (Notes: * prefixes must be an array of 3 elements, * given numbers start with 0 * sub_item = NOSUB means: no subitem) */ int map_menu_selection(int menu_num, int item_num, int subitem_num, Lisp_Object *prefixes) { int i; int act_menu_num = -1; int act_item_num = -1; int act_subitem_num = -1; int submenu_depth = 0; Lisp_Object prefix; prefixes[0] = Qnil; prefixes[1] = Qnil; prefixes[2] = Qnil; prefix = Qnil; i = 0; while (i < menu_items_used) { Lisp_Object entry; if (EQ (XVECTOR (menu_items)->contents[i], Qt)) { act_menu_num++; if(act_menu_num == menu_num) { prefixes[0] = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; } else if(act_menu_num >= menu_num) { break; /* not found */ } act_item_num = -1; act_subitem_num = -1; i += MENU_ITEMS_PANE_LENGTH; } else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) i += 1; else if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { submenu_depth ++; if(submenu_depth > 1) abort(); i += 1; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { submenu_depth --; if(submenu_depth < 0) abort(); i += 1; } else { if(submenu_depth == 0) { act_item_num ++; act_subitem_num = -1; } else if(submenu_depth == 1) act_subitem_num ++; else abort(); if(act_menu_num < 0) abort(); prefixes[submenu_depth+1] = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; if((act_menu_num == menu_num) && (act_item_num == item_num) && ((subitem_num == NOSUB) || (act_subitem_num == subitem_num))) { if(subitem_num == NOSUB) prefixes[2] = Qnil; return 1; } i += MENU_ITEMS_ITEM_LENGTH; } } return 0; } #if 0 extern Lisp_Object Qexternal_debugging_output; void print_menu_items_vector(Lisp_Object items, int level) { int i; int submenu_depth = 0; #if 0 if(level) { for(i = 0; i < level; i++) fprintf(stderr," "); } #endif for (i = 0; i < XVECTOR (items)->size;i += 3) { Lisp_Object string; Lisp_Object key, enable, descrip; Lisp_Object binding; string = XVECTOR (items)->contents[i + 1]; binding = XVECTOR (items)->contents[i + 2]; if(NILP(string)) break; fprintf(stderr,"\tname = %s\n", (char *) XSTRING (string)->data); fprintf(stderr,"binding type: %d\n", XTYPE(binding)); Fprin1(binding, Qexternal_debugging_output); } } #endif /* from xmenu.c */ void set_frame_menubar (FRAME_PTR f, int first_time) { int id = (int) f; Lisp_Object tail, items; int i; #if 0 /* CHFIXME: needed ? */ BLOCK_INPUT; #endif #if 0 fprintf(stderr,"set_frame_menubar\n"); #endif if (NILP (items = FRAME_MENU_BAR_ITEMS (f))) items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); #if 0 make_menu_items(f, items); print_amiga_menu(f); #else make_amiga_menu(f, items); #endif #if 0 if (menubar_widget) lw_modify_all_widgets (id, first_wv, False); else { menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv, f->display.x->column_widget, 0, 0, 0, 0); f->display.x->menubar_widget = menubar_widget; XtVaSetValues (menubar_widget, XtNshowGrip, 0, XtNresizeToPreferred, 1, XtNallowResize, 1, 0); } free_menubar_widget_value_tree (first_wv); /* Don't update the menubar the first time it is created via x_window. */ if (!first_time) update_frame_menubar (f); #endif #if 0 /* CHFIXME: needed ? */ UNBLOCK_INPUT; #endif } /* CHFIXME */ Lisp_Object map_event_to_object (struct input_event *event, FRAME_PTR f) { fprintf(stderr, "map_event_to_object () called !\n"); return Qnil; } void syms_of_amiga_xmenu (void) { staticpro (&menu_items); menu_items = Qnil; }