src/ChangeLog: 2002-06-05 Miles Bader * keyboard.c (Vkey_menu_prompt_function): New variable. (keys_of_keyboard): Initialize it. (read_char_minibuf_menu_prompt): Remove code which constructed a minibuffer prompt and interacted with the user. Add code to construct a list of menu entries and call the lisp function `key-menu-prompt-function' instead. (read_char_minibuf_menu_text, read_char_minibuf_menu_width): Variables removed. lisp/ChangeLog: 2002-06-05 Miles Bader * subr.el (key-menu-prompt): New function. (key-menu-prompt-function): Set to `key-menu-prompt'. (key-menu-event-face, key-menu-initial-separator) (key-menu-separator, key-menu-long-prompt-line-prefix): New variables. diff -c src/keyboard.c.~1.679.~ src/keyboard.c *** src/keyboard.c.~1.679.~ Sat May 25 13:38:14 2002 --- src/keyboard.c Wed Jun 5 01:30:26 2002 *************** *** 660,665 **** --- 660,670 ---- Lisp_Object Vglobal_disable_point_adjustment; + /* A function to display keyboard-menus, and read the user's response. + If nil, keyboard menus are disabled. */ + + Lisp_Object Vkey_menu_prompt_function; + /* The time when Emacs started being idle. */ static EMACS_TIME timer_idleness_start_time; *************** *** 7589,7600 **** return Qnil ; } - /* 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; - static Lisp_Object read_char_minibuf_menu_prompt (commandflag, nmaps, maps) int commandflag ; --- 7594,7599 ---- *************** *** 7603,7614 **** { int mapno; register Lisp_Object name; - int nlength; - int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4; int idx = -1; - int nobindings = 1; Lisp_Object rest, vector; ! char *menu; vector = Qnil; name = Qnil; --- 7602,7614 ---- { int mapno; register Lisp_Object name; int idx = -1; Lisp_Object rest, vector; ! /* This is a list of the prompt and individual menu entries passed to ! lisp for formatting and display. The format is: ! MENU_LIST : (MENU_PROMPT ENTRY...) ! ENTRY : (EVENT PROMPT [BINDING [TOGGLE_TYPE TOGGLE_STATE]]) */ ! Lisp_Object menu_list = Qnil; vector = Qnil; name = Qnil; *************** *** 7616,7635 **** if (! menu_prompting) return Qnil; - /* 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; - /* Get the menu name from the first map that has one (a prompt string). */ for (mapno = 0; mapno < nmaps; mapno++) { --- 7616,7621 ---- *************** *** 7642,7845 **** if (!STRINGP (name)) return Qnil; - /* 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; - /* Start prompting at start of first map. */ mapno = 0; rest = maps[mapno]; ! /* Present the documented bindings, a line at a time. */ ! while (1) { ! int notfirst = 0; ! 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]; ! } ! /* Look at the next element of the map. */ ! if (idx >= 0) ! elt = XVECTOR (vector)->contents[idx]; ! else ! elt = Fcar_safe (rest); ! if (idx < 0 && VECTORP (elt)) { ! /* If we found a dense table in the keymap, ! advanced past it, but start scanning its contents. */ ! rest = Fcdr_safe (rest); ! vector = elt; ! idx = 0; } else { ! /* An ordinary element. */ ! 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); } } ! /* Prompt with that and read response. */ ! message2_nolog (menu, strlen (menu), ! ! NILP (current_buffer->enable_multibyte_characters)); ! /* Make believe its not a keyboard macro in case the help char ! is pressed. Help characters are not recorded because menu prompting ! 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; ! if (!INTEGERP (obj)) ! return obj; ! else ! ch = XINT (obj); ! ! 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 */ ! } } /* Reading key sequences. */ --- 7628,7736 ---- if (!STRINGP (name)) return Qnil; /* Start prompting at start of first map. */ mapno = 0; rest = maps[mapno]; ! /* Loop over elements of map. */ ! for (;;) { ! Lisp_Object elt; ! /* If reached end of map, start at beginning of next map. */ ! if (NILP (rest)) ! { ! mapno++; ! if (mapno == nmaps) ! /* Done with all maps. */ ! break; ! rest = maps[mapno]; ! } ! ! /* Look at the next element of the map. */ ! if (idx >= 0) ! elt = AREF (vector, idx); ! else ! elt = Fcar_safe (rest); ! ! if (idx < 0 && VECTORP (elt)) ! { ! /* If we found a dense table in the keymap, ! advanced past it, but start scanning its contents. */ ! rest = Fcdr_safe (rest); ! vector = elt; ! idx = 0; ! } ! else ! { ! /* An ordinary element. */ ! 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)) + { + /* The list describing this entry. */ + Lisp_Object entry = Qnil; + Lisp_Object prop_val; + + prop_val = AREF (item_properties, ITEM_PROPERTY_TYPE); + if (EQ (prop_val, QCradio) || EQ (prop_val, QCtoggle)) + /* This is a `toggle-able' menu-entry, make the + tail of the list describe it. */ + entry + = Fcons (prop_val, + Fcons (AREF (item_properties, + ITEM_PROPERTY_SELECTED), + entry)); + + /* Equivalent keybinding. */ + prop_val = AREF (item_properties, ITEM_PROPERTY_KEYEQ); + if (!NILP (entry) || !NILP (prop_val)) + entry = Fcons (prop_val, entry); + + /* The string prompt. */ + prop_val = AREF (item_properties, ITEM_PROPERTY_NAME); + entry = Fcons (prop_val, entry); + + /* Finally, the car of the list is the event. */ + entry = Fcons (event, entry); + + /* Push this entry on the the list of entries. */ + menu_list = Fcons (entry, menu_list); + } + + /* 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); } + } ! /* Put the entries in the proper order for the display function. */ ! menu_list = Fnreverse (menu_list); ! /* The car of the entries list is the prompt for the whole menu. */ ! menu_list = Fcons (name, menu_list); ! /* Display the menu, and prompt for a key. */ ! if (NILP (Vkey_menu_prompt_function)) ! return Qnil; ! else ! return call1 (Vkey_menu_prompt_function, menu_list); } /* Reading key sequences. */ *************** *** 10955,10960 **** --- 10846,10868 ---- doc: /* *How long to display an echo-area message when the minibuffer is active. If the value is not a number, such messages don't time out. */); Vminibuffer_message_timeout = make_number (2); + + DEFVAR_LISP ("key-menu-prompt-function", &Vkey_menu_prompt_function, + doc: /* A function to display keyboard-menus, and read the user's response. + If nil, keyboard menus are disabled. + + It is called with single argument, which is a list describing the keyboard menu + and should return the key the user types. + + The argument is a list of the prompt and individual menu entries. + The format is as follows: + + MENU : (PROMPT ENTRY...) + ENTRY : (EVENT PROMPT [BINDING [TOGGLE_TYPE TOGGLE_STATE]]) + + Note that there is a prompt for the whole menu, and one for each + individual entry. */); + Vkey_menu_prompt_function = Qnil; } void diff -c lisp/subr.el.~1.305.~ lisp/subr.el *** lisp/subr.el.~1.305.~ Sat Jun 1 09:02:46 2002 --- lisp/subr.el Wed Jun 5 02:05:17 2002 *************** *** 656,661 **** --- 656,748 ---- (nth 3 position)) + ;;;; Keyboard menu prompting + + (defvar key-menu-event-face 'underline + "Face used to highlight the events in the keyboard-menu prompt. + Used by `key-menu-prompt'.") + (defvar key-menu-initial-separator " " + "String used to separate a keyboard-menu prompt from the first key description. + Used by `key-menu-prompt'.") + (defvar key-menu-separator ", " + "String used to separate adjacent keyboard-menu key descriptions. + Used by `key-menu-prompt'.") + (defvar key-menu-long-prompt-line-prefix " " + "A prefix for entry lines when the menu prompt is very long. + Used by `key-menu-prompt'.") + + (defun key-menu-prompt (menu) + "Display the keyboard-menu MENU, and read the user's response. + This function is appropiate for `key-menu-prompt-function', which see." + (let* ((prompt (concat (car menu) ":")) + (prompt-width (string-width prompt)) + (cur-line "") + (prefix nil) + (sep "") + (string prompt) + (cur-line-width prompt-width) + (max-width (frame-width))) + (dolist (entry (cdr menu)) + (let* ((entry-prompt + (if (eq (car entry) (aref (cadr entry) 0)) + (format "%s%s" + (propertize (char-to-string (car entry)) + 'face key-menu-event-face) + (substring (cadr entry) 1)) + (format "%s = %s" + (propertize (char-to-string (car entry)) + 'face key-menu-event-face) + (cadr entry)))) + (entry-width + (string-width entry-prompt)) + (appended-width + (+ cur-line-width (string-width sep) entry-width))) + ;; If this is the first line, first see if we'd be better off + ;; wrapping right after the prompt (because the prompt string is + ;; unusually long). Note that we only do so if there are (1) + ;; less than 4 entries already on the first line, and (2) the + ;; prompt is greater than 12 characters wide; these values are + ;; completely arbitrary. + (when (and (eq string prompt) + (>= appended-width max-width) + (> prompt-width (/ max-width 4))) + ;; Wrap after the prompt + (setq prefix key-menu-long-prompt-line-prefix + string (concat string "\n") + cur-line-width + (- cur-line-width (- prompt-width (string-width prefix))) + appended-width (+ cur-line-width entry-width))) + ;; See if we have to wrap before the current entry (note that + ;; this might happen even if we just wrapped after the prompt + ;; above). + (if (< appended-width max-width) + ;; It's OK to append the current entry, so do so + (setq cur-line (concat cur-line sep entry-prompt) + cur-line-width appended-width) + ;; We have to wrap the current line first, and then append it + (if prefix + (setq string (concat string prefix cur-line "\n")) + (setq string + (concat string key-menu-initial-separator cur-line "\n") + prefix + (make-string (+ prompt-width + (string-width key-menu-initial-separator)) + ? ))) + (setq cur-line entry-prompt + cur-line-width entry-width)) + ;; Update sep to the normal inter-entry value + (setq sep key-menu-separator))) + + ;; Finally, display the menu, and read the user's input + (unless prefix + (setq prefix key-menu-initial-separator)) + (setq string (concat string prefix cur-line)) + (read-char string))) + + ;; `key-menu-prompt-function' is defined in src/keyboard.c + (setq key-menu-prompt-function 'key-menu-prompt) + + ;;;; Obsolescent names for functions. (defalias 'dot 'point)