(defun check-menu-complete (menu key-seq)
  "If the user entered a key not mapped in @var{*menu-map}, check if
  he's trying to type an entry's name. Match is case insensitive. If
  @var{key-seq} is nil, some other function has manipulated the
  current-input and is requesting a re-computation of the match."
  (let ((input-char (and key-seq (get-input-char key-seq))))
    (when input-char
      (vector-push-extend input-char (menu-state-current-input menu)))
    (handler-case
        (when (or input-char (not key-seq))
          (labels ((match-p (table-item)
                     (funcall (menu-state-filter-pred menu)
                              (car table-item)
                              (second table-item)
                              (menu-state-current-input menu))))
            (setf (menu-state-table menu) (remove-if-not #'match-p (menu-state-unfiltered-table menu))
                  (menu-state-selected menu) 0)
            (bound-check-menu menu)))
      (cl-ppcre:ppcre-syntax-error ()))))

(defun select-from-menu (screen table &optional (prompt "Search:")
                                        (initial-selection 0)
                                        extra-keymap
                                        (filter-pred #'menu-item-matches-regexp))
  "Prompt the user to select from a menu on SCREEN. TABLE can be
a list of values or an alist. If it's an alist, the CAR of each
element is displayed in the menu. What is displayed as menu items
must be strings.
EXTRA-KEYMAP can be a keymap whose bindings will take precedence
over the default bindings.
FILTER-PRED should be a a function returning T when a certain menu
item should be visible to the user.  It should accept arguments
ITEM-STRING (the string shown to the user), ITEM-OBJECT (the object
corresponding to the menu item), and USER-INPUT (the current user
input). The default is MENU-ITEM-MATCHES-REGEXP.
Returns the selected element in TABLE or nil if aborted. "
  (check-type screen screen)
  (check-type table list)
  (check-type prompt (or null string))
  (check-type initial-selection integer)

  (when table
    (let* ((*record-last-msg-override* t)
           (*suppress-echo-timeout* t)
           (menu (make-menu-state
                  :unfiltered-table table
                  :table table
                  :filter-pred filter-pred
                  :prompt prompt
                  :view-start 0
                  :view-end 0
                  :selected initial-selection))
           (keymap (if extra-keymap
                       (list extra-keymap *menu-map*)
                       (list *menu-map*))))
      (bound-check-menu menu)
      (catch :menu-quit
        (unwind-protect
             (with-focus (screen-key-window screen)
               (loop
                  (let* ((sel (menu-state-selected menu))
                         (start (menu-state-view-start menu))
                         (end (menu-state-view-end menu))
                         (len (length (menu-state-table menu)))
                         (prompt-line (when (menu-prompt-visible menu)
                                        (format nil "~@[~A ~]~A"
                                                prompt (menu-state-current-input menu))))
                         (strings (mapcar #'menu-element-name
                                          (subseq (menu-state-table menu)
                                                  start end)))
                         (highlight (- sel start)))
                    (unless (zerop start)
                      (setf strings (cons "..." strings))
                      (incf highlight))
                    (unless (= len end)
                      (setf strings (nconc strings '("..."))))
                    (when prompt-line
                      (push prompt-line strings)
                      (incf highlight))
                    (echo-string-list screen strings highlight))
                  (multiple-value-bind (action key-seq) (read-from-keymap keymap)
                    (if action
                        (progn (funcall action menu)
                               (bound-check-menu menu))
                        (check-menu-complete menu (first key-seq))))))
          (unmap-all-message-windows))))))