diff --git a/menu.lisp b/menu.lisp index 4474ff5..00cc73f 100644 --- a/menu.lisp +++ b/menu.lisp @@ -27,7 +27,8 @@ (in-package #:stumpwm) -(export '()) +(export '(*menu-maximum-height* + *menu-scrolling-step*)) (defvar *menu-map* nil "The keymap used by the interactive menu.") @@ -52,51 +53,26 @@ (defstruct menu-state table prompt selected view-start view-end) -(defun menu-scrolling-required-p (menu) - (and *menu-maximum-height* - (> (length (menu-state-table menu)) - *menu-maximum-height*))) - (defun bound-check-menu (menu) "Adjust the menu view and selected item based on current view and new selection." - (setf (menu-state-selected menu) - (cond ((< (menu-state-selected menu) 0) - (1- (length (menu-state-table menu)))) - ((>= (menu-state-selected menu) (length (menu-state-table menu))) - 0) - (t (menu-state-selected menu)))) - (when (menu-scrolling-required-p menu) - (progn (cond ((< (menu-state-selected menu) *menu-maximum-height*) - (progn (setf (menu-state-view-start menu) 0) - (setf (menu-state-view-end menu) - *menu-maximum-height*))) - ((> (menu-state-selected menu) - (- (length (menu-state-table menu)) - *menu-maximum-height*)) - (progn (setf (menu-state-view-start menu) - (- (length (menu-state-table menu)) - *menu-maximum-height*)) - (setf (menu-state-view-end menu) - (length (menu-state-table menu))))) - ((< (menu-state-selected menu) - (menu-state-view-start menu)) - (progn (setf (menu-state-view-start menu) - (- (menu-state-selected menu) - *menu-scrolling-step*)) - (setf (menu-state-view-end menu) - (- (+ (menu-state-selected menu) - *menu-maximum-height*) - *menu-scrolling-step*)))) - ((>= (menu-state-selected menu) - (menu-state-view-end menu)) - (progn (setf (menu-state-view-start menu) - (+ (- (menu-state-selected menu) - *menu-maximum-height*) - *menu-scrolling-step*)) - (setf (menu-state-view-end menu) - (+ (menu-state-selected menu) - *menu-scrolling-step*)))))))) + (let* ((len (length (menu-state-table menu))) + (max (or *menu-maximum-height* len))) + (setf (menu-state-selected menu) + (cond ((< (menu-state-selected menu) 0) (1- len)) + ((>= (menu-state-selected menu) len) 0) + (t (menu-state-selected menu))) + (menu-state-view-start menu) + (cond ((< (menu-state-selected menu) max) 0) + ((> (menu-state-selected menu) (- len max)) + (- len max)) + ((< (menu-state-selected menu) (menu-state-view-start menu)) + (- (menu-state-selected menu) *menu-scrolling-step*)) + ((>= (menu-state-selected menu) (menu-state-view-end menu)) + (+ (- (menu-state-selected menu) *menu-maximum-height*) *menu-scrolling-step*)) + (t (menu-state-view-start menu))) + (menu-state-view-end menu) + (min (+ (menu-state-view-start menu) max) len)))) (defun menu-up (menu) (setf *current-menu-input* "") @@ -156,10 +132,7 @@ backspace or F9), return it otherwise return nil" (bound-check-menu menu) (return)))))) -;; TODO: The maximum lines-number should be customizable or at least based on -;; TODO: screen height -(defun select-from-menu (screen table &optional prompt - (initial-selection 0)) +(defun select-from-menu (screen table &optional prompt (initial-selection 0)) "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 @@ -170,56 +143,44 @@ See *menu-map* for menu bindings." (check-type table list) (check-type prompt (or null string)) (check-type initial-selection integer) - (let* ((menu-options (mapcar (lambda (elt) - (if (listp elt) - (first elt) - elt)) - table)) - (menu-require-scrolling (and *menu-maximum-height* - (> (length menu-options) - *menu-maximum-height*))) + (let* ((menu-require-scrolling (and *menu-maximum-height* + (> (length table) + *menu-maximum-height*))) (menu (make-menu-state :table table :prompt prompt - :view-start (if menu-require-scrolling - initial-selection - 0) + :view-start (if menu-require-scrolling initial-selection 0) :view-end (if menu-require-scrolling - (if (< (+ initial-selection - *menu-maximum-height*) - (length menu-options)) - (+ initial-selection - *menu-maximum-height*) - (- (length menu-options) - *menu-maximum-height*)) - (length menu-options)) + (min (+ initial-selection *menu-maximum-height*) + (length table)) + (length table)) :selected initial-selection)) + (menu-options (mapcar #'menu-element-name + table)) (*record-last-msg-override* t) - (*suppress-echo-timeout* t)) + (*suppress-echo-timeout* t) + (*current-menu-input* "")) (bound-check-menu menu) (catch :menu-quit (unwind-protect (with-focus (screen-key-window screen) (loop - (let* ((menu-view (subseq menu-options (menu-state-view-start menu) (menu-state-view-end menu))) - (menu-text (let ((view-text menu-view)) - (unless (= 0 (menu-state-view-start menu)) - (setf view-text - (cons "..." view-text))) - (unless (= (length menu-options) (menu-state-view-end menu)) - (setf view-text (append view-text '("...")))) - (when prompt - (setf view-text - (cons prompt view-text))) - view-text)) - (menu-highlight (+ (- (menu-state-selected menu) - (menu-state-view-start menu)) - (if prompt 1 0) - (if (= 0 (menu-state-view-start menu)) 0 1)))) - (echo-string-list screen menu-text menu-highlight)) + (let ((strings (subseq menu-options + (menu-state-view-start menu) + (menu-state-view-end menu))) + (highlight (- (menu-state-selected menu) + (menu-state-view-start menu)))) + (unless (= 0 (menu-state-view-start menu)) + (setf strings (cons "..." strings)) + (incf highlight)) + (unless (= (length menu-options) (menu-state-view-end menu)) + (setf strings (nconc strings '("...")))) + (when prompt + (setf strings (cons prompt strings)) + (incf highlight)) + (echo-string-list screen strings highlight)) (multiple-value-bind (action key-seq) (read-from-keymap (list *menu-map*)) (if action (funcall action menu) (check-menu-complete menu (first key-seq)))))) (unmap-all-message-windows))))) -