Re: Assignment of misc packages for emacs

[Miles Bader <miles@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 439 bytes --]

Richard Stallman <rms@gnu.org> writes:
>     Is there any reason we couldn't make it call out to lisp to do the
>     formatting?
> 
> It's ok with me if someone finds it easy to do.

What do you think of the appended patch?  It moves all the formatting
and prompting for keyboard-menus to lisp (and in the process gets rid
of the one-line-at-a-time interface, since the lisp code just displays
the whole menu at once).

-Miles


Patch:



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch to move keyboard-menu prompting to lisp --]
[-- Type: text/x-patch, Size: 16743 bytes --]

src/ChangeLog:
2002-06-05  Miles Bader  <miles@gnu.org>

	* 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  <miles@gnu.org>

	* 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 */
!     }
  }
  \f
  /* 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);
  }
  \f
  /* 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))
  
  \f
+ ;;;; 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)
+ 
+ \f
  ;;;; Obsolescent names for functions.
  
  (defalias 'dot 'point)

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]



-- 
"Most attacks seem to take place at night, during a rainstorm, uphill,
 where four map sheets join."   -- Anon. British Officer in WW I