/[emacs]/emacs/src/keyboard.c
ViewVC logotype

Diff of /emacs/src/keyboard.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.691 by rms, Fri Jul 12 11:18:36 2002 UTC revision 1.692 by kfstorm, Fri Jul 12 23:47:31 2002 UTC
# Line 660  Lisp_Object Vdisable_point_adjustment; Line 660  Lisp_Object Vdisable_point_adjustment;
660    
661  Lisp_Object Vglobal_disable_point_adjustment;  Lisp_Object Vglobal_disable_point_adjustment;
662    
663    /* A function to display keyboard-menus, and read the user's response.
664       If nil, keyboard menus are disabled.  */
665    
666    Lisp_Object Vkey_menu_prompt_function;
667    
668  /* The time when Emacs started being idle.  */  /* The time when Emacs started being idle.  */
669    
670  static EMACS_TIME timer_idleness_start_time;  static EMACS_TIME timer_idleness_start_time;
# Line 1359  command_loop_1 () Line 1364  command_loop_1 ()
1364    this_command_key_count = 0;    this_command_key_count = 0;
1365    this_single_command_key_start = 0;    this_single_command_key_start = 0;
1366    
1367    if (! NILP (Vmemory_full))    if (NILP (Vmemory_full))
1368      {      {
1369        /* Make sure this hook runs after commands that get errors and        /* Make sure this hook runs after commands that get errors and
1370           throw to top level.  */           throw to top level.  */
# Line 7666  read_char_x_menu_prompt (nmaps, maps, pr Line 7671  read_char_x_menu_prompt (nmaps, maps, pr
7671    return Qnil ;    return Qnil ;
7672  }  }
7673    
 /* Buffer in use so far for the minibuf prompts for menu keymaps.  
    We make this bigger when necessary, and never free it.  */  
 static char *read_char_minibuf_menu_text;  
 /* Size of that buffer.  */  
 static int read_char_minibuf_menu_width;  
   
7674  static Lisp_Object  static Lisp_Object
7675  read_char_minibuf_menu_prompt (commandflag, nmaps, maps)  read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
7676       int commandflag ;       int commandflag ;
# Line 7680  read_char_minibuf_menu_prompt (commandfl Line 7679  read_char_minibuf_menu_prompt (commandfl
7679  {  {
7680    int mapno;    int mapno;
7681    register Lisp_Object name;    register Lisp_Object name;
   int nlength;  
   int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;  
7682    int idx = -1;    int idx = -1;
   int nobindings = 1;  
7683    Lisp_Object rest, vector;    Lisp_Object rest, vector;
7684    char *menu;    /* This is a list of the prompt and individual menu entries passed to
7685         lisp for formatting and display.  The format is:
7686           MENU_LIST : (MENU_PROMPT ENTRY...)
7687           ENTRY     : (EVENT PROMPT [BINDING [TOGGLE_TYPE TOGGLE_STATE]])   */
7688      Lisp_Object menu_list = Qnil;
7689    
7690    vector = Qnil;    vector = Qnil;
7691    name = Qnil;    name = Qnil;
# Line 7693  read_char_minibuf_menu_prompt (commandfl Line 7693  read_char_minibuf_menu_prompt (commandfl
7693    if (! menu_prompting)    if (! menu_prompting)
7694      return Qnil;      return Qnil;
7695    
   /* Make sure we have a big enough buffer for the menu text.  */  
   if (read_char_minibuf_menu_text == 0)  
     {  
       read_char_minibuf_menu_width = width + 4;  
       read_char_minibuf_menu_text = (char *) xmalloc (width + 4);  
     }  
   else if (width + 4 > read_char_minibuf_menu_width)  
     {  
       read_char_minibuf_menu_width = width + 4;  
       read_char_minibuf_menu_text  
         = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);  
     }  
   menu = read_char_minibuf_menu_text;  
   
7696    /* Get the menu name from the first map that has one (a prompt string).  */    /* Get the menu name from the first map that has one (a prompt string).  */
7697    for (mapno = 0; mapno < nmaps; mapno++)    for (mapno = 0; mapno < nmaps; mapno++)
7698      {      {
# Line 7719  read_char_minibuf_menu_prompt (commandfl Line 7705  read_char_minibuf_menu_prompt (commandfl
7705    if (!STRINGP (name))    if (!STRINGP (name))
7706      return Qnil;      return Qnil;
7707    
   /* Prompt string always starts with map's prompt, and a space.  */  
   strcpy (menu, XSTRING (name)->data);  
   nlength = STRING_BYTES (XSTRING (name));  
   menu[nlength++] = ':';  
   menu[nlength++] = ' ';  
   menu[nlength] = 0;  
   
7708    /* Start prompting at start of first map.  */    /* Start prompting at start of first map.  */
7709    mapno = 0;    mapno = 0;
7710    rest = maps[mapno];    rest = maps[mapno];
7711    
7712    /* Present the documented bindings, a line at a time.  */    /* Loop over elements of map.  */
7713    while (1)    for (;;)
7714      {      {
7715        int notfirst = 0;        Lisp_Object elt;
       int i = nlength;  
       Lisp_Object obj;  
       int ch;  
       Lisp_Object orig_defn_macro;  
   
       /* Loop over elements of map.  */  
       while (i < width)  
         {  
           Lisp_Object elt;  
   
           /* If reached end of map, start at beginning of next map.  */  
           if (NILP (rest))  
             {  
               mapno++;  
               /* At end of last map, wrap around to first map if just starting,  
                  or end this line if already have something on it.  */  
               if (mapno == nmaps)  
                 {  
                   mapno = 0;  
                   if (notfirst || nobindings) break;  
                 }  
               rest = maps[mapno];  
             }  
7716    
7717            /* Look at the next element of the map.  */        /* If reached end of map, start at beginning of next map.  */
7718            if (idx >= 0)        if (NILP (rest))
7719              elt = XVECTOR (vector)->contents[idx];          {
7720            else            mapno++;
7721              elt = Fcar_safe (rest);            if (mapno == nmaps)
7722                /* Done with all maps.  */
7723                break;
7724              rest = maps[mapno];
7725            }
7726    
7727          /* Look at the next element of the map.  */
7728          if (idx >= 0)
7729            elt = AREF (vector, idx);
7730          else
7731            elt = Fcar_safe (rest);
7732    
7733          if (idx < 0 && VECTORP (elt))
7734            {
7735              /* If we found a dense table in the keymap,
7736                 advanced past it, but start scanning its contents.  */
7737              rest = Fcdr_safe (rest);
7738              vector = elt;
7739              idx = 0;
7740            }
7741          else
7742            {
7743              /* An ordinary element.  */
7744              Lisp_Object event, tem;
7745    
7746            if (idx < 0 && VECTORP (elt))            if (idx < 0)
7747              {              {
7748                /* If we found a dense table in the keymap,                event = Fcar_safe (elt); /* alist */
7749                   advanced past it, but start scanning its contents.  */                elt = Fcdr_safe (elt);
               rest = Fcdr_safe (rest);  
               vector = elt;  
               idx = 0;  
7750              }              }
7751            else            else
7752              {              {
7753                /* An ordinary element.  */                XSETINT (event, idx); /* vector */
               Lisp_Object event, tem;  
   
               if (idx < 0)  
                 {  
                   event = Fcar_safe (elt); /* alist */  
                   elt = Fcdr_safe (elt);  
                 }  
               else  
                 {  
                   XSETINT (event, idx); /* vector */  
                 }  
   
               /* Ignore the element if it has no prompt string.  */  
               if (INTEGERP (event) && parse_menu_item (elt, 0, -1))  
                 {  
                   /* 1 if the char to type matches the string.  */  
                   int char_matches;  
                   Lisp_Object upcased_event, downcased_event;  
                   Lisp_Object desc = Qnil;  
                   Lisp_Object s  
                     = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];  
   
                   upcased_event = Fupcase (event);  
                   downcased_event = Fdowncase (event);  
                   char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]  
                                   || XINT (downcased_event) == XSTRING (s)->data[0]);  
                   if (! char_matches)  
                     desc = Fsingle_key_description (event, Qnil);  
   
 #if 0  /* It is redundant to list the equivalent key bindings because  
           the prefix is what the user has already typed.  */  
                   tem  
                     = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];  
                   if (!NILP (tem))  
                     /* Insert equivalent keybinding. */  
                     s = concat2 (s, tem);  
 #endif  
                   tem  
                     = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];  
                   if (EQ (tem, QCradio) || EQ (tem, QCtoggle))  
                     {  
                       /* Insert button prefix. */  
                       Lisp_Object selected  
                         = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];  
                       if (EQ (tem, QCradio))  
                         tem = build_string (NILP (selected) ? "(*) " : "( ) ");  
                       else  
                         tem = build_string (NILP (selected) ? "[X] " : "[ ] ");  
                       s = concat2 (tem, s);  
                     }  
                     
   
                   /* If we have room for the prompt string, add it to this line.  
                      If this is the first on the line, always add it.  */  
                   if ((XSTRING (s)->size + i + 2  
                        + (char_matches ? 0 : XSTRING (desc)->size + 3))  
                       < width  
                       || !notfirst)  
                     {  
                       int thiswidth;  
   
                       /* Punctuate between strings.  */  
                       if (notfirst)  
                         {  
                           strcpy (menu + i, ", ");  
                           i += 2;  
                         }  
                       notfirst = 1;  
                       nobindings = 0 ;  
   
                       /* If the char to type doesn't match the string's  
                          first char, explicitly show what char to type.  */  
                       if (! char_matches)  
                         {  
                           /* Add as much of string as fits.  */  
                           thiswidth = XSTRING (desc)->size;  
                           if (thiswidth + i > width)  
                             thiswidth = width - i;  
                           bcopy (XSTRING (desc)->data, menu + i, thiswidth);  
                           i += thiswidth;  
                           strcpy (menu + i, " = ");  
                           i += 3;  
                         }  
   
                       /* Add as much of string as fits.  */  
                       thiswidth = XSTRING (s)->size;  
                       if (thiswidth + i > width)  
                         thiswidth = width - i;  
                       bcopy (XSTRING (s)->data, menu + i, thiswidth);  
                       i += thiswidth;  
                       menu[i] = 0;  
                     }  
                   else  
                     {  
                       /* If this element does not fit, end the line now,  
                          and save the element for the next line.  */  
                       strcpy (menu + i, "...");  
                       break;  
                     }  
                 }  
   
               /* Move past this element.  */  
               if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)  
                 /* Handle reaching end of dense table.  */  
                 idx = -1;  
               if (idx >= 0)  
                 idx++;  
               else  
                 rest = Fcdr_safe (rest);  
7754              }              }
7755    
7756              /* Ignore the element if it has no prompt string.  */
7757              if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
7758                {
7759                  /* The list describing this entry.  */
7760                  Lisp_Object entry = Qnil;
7761                  Lisp_Object prop_val;
7762    
7763                  prop_val = AREF (item_properties, ITEM_PROPERTY_TYPE);
7764                  if (EQ (prop_val, QCradio) || EQ (prop_val, QCtoggle))
7765                    /* This is a `toggle-able' menu-entry, make the
7766                       tail of the list describe it.  */
7767                    entry
7768                      = Fcons (prop_val,
7769                               Fcons (AREF (item_properties,
7770                                            ITEM_PROPERTY_SELECTED),
7771                                      entry));
7772    
7773                  /* Equivalent keybinding.  */
7774                  prop_val = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7775                  if (!NILP (entry) || !NILP (prop_val))
7776                    entry = Fcons (prop_val, entry);
7777    
7778                  /* The string prompt.  */
7779                  prop_val = AREF (item_properties, ITEM_PROPERTY_NAME);
7780                  entry = Fcons (prop_val, entry);
7781    
7782                  /* Finally, the car of the list is the event.  */
7783                  entry = Fcons (event, entry);
7784    
7785                  /* Push this entry on the the list of entries.  */
7786                  menu_list = Fcons (entry, menu_list);
7787                }
7788    
7789              /* Move past this element.  */
7790              if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7791                /* Handle reaching end of dense table.  */
7792                idx = -1;
7793              if (idx >= 0)
7794                idx++;
7795              else
7796                rest = Fcdr_safe (rest);
7797          }          }
7798        }
7799    
7800        /* Prompt with that and read response.  */    /* Put the entries in the proper order for the display function.  */
7801        message2_nolog (menu, strlen (menu),    menu_list = Fnreverse (menu_list);
                       ! NILP (current_buffer->enable_multibyte_characters));  
7802    
7803        /* Make believe its not a keyboard macro in case the help char    /* The car of the entries list is the prompt for the whole menu.  */
7804           is pressed.  Help characters are not recorded because menu prompting    menu_list = Fcons (name, menu_list);
          is not used on replay.  
          */  
       orig_defn_macro = current_kboard->defining_kbd_macro;  
       current_kboard->defining_kbd_macro = Qnil;  
       do  
         obj = read_char (commandflag, 0, 0, Qt, 0);  
       while (BUFFERP (obj));  
       current_kboard->defining_kbd_macro = orig_defn_macro;  
7805    
7806        if (!INTEGERP (obj))    /* Display the menu, and prompt for a key.  */
7807          return obj;    if (NILP (Vkey_menu_prompt_function))
7808        else      return Qnil;
7809          ch = XINT (obj);    else
7810        return call1 (Vkey_menu_prompt_function, menu_list);
       if (! EQ (obj, menu_prompt_more_char)  
           && (!INTEGERP (menu_prompt_more_char)  
               || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))  
         {  
           if (!NILP (current_kboard->defining_kbd_macro))  
             store_kbd_macro_char (obj);  
           return obj;  
         }  
       /* Help char - go round again */  
     }  
7811  }  }
7812    
7813  /* Reading key sequences.  */  /* Reading key sequences.  */
# Line 11012  Used during Emacs' startup.  */); Line 10903  Used during Emacs' startup.  */);
10903                 doc: /* *How long to display an echo-area message when the minibuffer is active.                 doc: /* *How long to display an echo-area message when the minibuffer is active.
10904  If the value is not a number, such messages don't time out.  */);  If the value is not a number, such messages don't time out.  */);
10905    Vminibuffer_message_timeout = make_number (2);    Vminibuffer_message_timeout = make_number (2);
10906    
10907      DEFVAR_LISP ("key-menu-prompt-function", &Vkey_menu_prompt_function,
10908                   doc: /* A function to display keyboard-menus, and read the user's response.
10909    If nil, keyboard menus are disabled.
10910    
10911    It is called with single argument, which is a list describing the keyboard menu
10912    and should return the key the user types.
10913    
10914    The argument is a list of the prompt and individual menu entries.
10915    The format is as follows:
10916    
10917           MENU  : (PROMPT ENTRY...)
10918           ENTRY : (EVENT PROMPT [BINDING [TOGGLE_TYPE TOGGLE_STATE]])
10919    
10920    Note that there is a prompt for the whole menu, and one for each
10921    individual entry.  */);
10922      Vkey_menu_prompt_function = Qnil;
10923  }  }
10924    
10925  void  void

Legend:
Removed from v.1.691  
changed lines
  Added in v.1.692

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26