(defconst hierarkey-help-char ??)

(defun prompt (local global)
  (let ((map (or local global))
	(width (- (screen-width) 4))
	value done tem rest name prompt notfirst)
    (setq tem map)
    (while (and tem (not (stringp (car tem))))
      (setq tem (cdr tem)))
    (if (null tem)
	(read-char)
      (setq name (car tem))
      (setq rest map)
      (while (null value)
	(setq prompt name)
	(setq done nil)
	(if (null rest) (setq rest map))
	(setq notfirst nil)
	(while (and rest (not done) (< (length prompt) width))
	  (let ((string (car-safe (cdr-safe (car-safe rest)))))
	    (if (stringp string)
		(if (< (+ (length string) (length prompt)) width)
		    (setq prompt (concat prompt (and notfirst ", ") string)
			  notfirst t
			  rest (cdr rest))
		  (setq prompt (concat prompt "...")
			done t))
	      (setq rest (cdr rest)))))
	(and (null rest) (string= (substring prompt -2) ", ")
	     (setq prompt (substring prompt 0 -2)))
	(message prompt)
	(setq char (read-char))
	(if (and (/= char hierarkey-help-char))
	    (setq value char)))
      value)))

(defconst foo-map
  '(keymap "foo:"
	   (?a "adjust" . adjust)
	   (?b "backward" . backward-char)
	   (?c "change" . change)
	   (?d "delete" . delete-char)
	   (?e "end" . end-of-line)
	   (?f "forward" . forward-char)
	   (?g "gobble" . gobble)
	   (?h "help" . help-map)
	   (?i "insert" . insert-file)
	   (?j "jump" . register-to-point)
	   (?k "kill" . kill-line)
	   (?l "load" . load-library)
	   (?m "mail" . mail)
	   (?n "next" . next-line)
	   (?o "open" . open-line)
	   (?p "previous" . previous-line)
	   (?q "quote" . quoted-insert)
	   (?r "replace" . query-replace)
	   (?s "save" . save-buffer)
	   (?t "transpose" . transpose-chars)
	   (?u "undo" . undo)
	   (?v "view" . view-file)
	   (?w "write" . write-file)
	   (?x "exchange" . exchange-point-and-mark)
	   (?y "yank" . yank)
	   (?z "zap" . zap-to-char)))
