>From 2f0d9fee347045ef17489a2695ca66068eaaabdf Mon Sep 17 00:00:00 2001 From: Morgan Veyret Date: Fri, 24 Oct 2008 10:34:52 +0200 Subject: [PATCH 01/14] Added scrolling to select-from-menu. News variables added in primitives.lisp: *menu-maximum-height* and *menu-scrolling-step* --- menu.lisp | 94 +++++++++++++++++++++++++++++++++++++++++++++++------- primitives.lisp | 7 ++++ 2 files changed, 88 insertions(+), 13 deletions(-) diff --git a/menu.lisp b/menu.lisp index 4f77a04..0905945 100644 --- a/menu.lisp +++ b/menu.lisp @@ -50,15 +50,51 @@ (defvar *current-menu-input* nil) (defstruct menu-state - table prompt selected) + 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))))) + (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-view-start menu) + *menu-scrolling-step*)) + (setf (menu-state-view-end menu) + (- (menu-state-view-end menu) + *menu-scrolling-step*)))) + ((>= (menu-state-selected menu) + (menu-state-view-end menu)) + (progn (setf (menu-state-view-start menu) + (+ (menu-state-view-start menu) + *menu-scrolling-step*)) + (setf (menu-state-view-end menu) + (+ (menu-state-selected menu) + *menu-scrolling-step*)))))))) (defun menu-up (menu) (setf *current-menu-input* "") @@ -117,7 +153,10 @@ backspace or F9), return it otherwise return nil" (setf (menu-state-selected menu) cur-pos) (return)))))) -(defun select-from-menu (screen table &optional prompt (initial-selection 0)) +;; 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)) "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 @@ -128,27 +167,56 @@ See *menu-map* for menu bindings." (check-type table list) (check-type prompt (or null string)) (check-type initial-selection integer) - (let* ((menu (make-menu-state + (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*))) + (menu (make-menu-state :table table :prompt prompt + :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)) :selected initial-selection)) - (menu-options (mapcar #'menu-element-name - table)) - (menu-text (if prompt - (cons prompt menu-options) - menu-options)) (*record-last-msg-override* t) - (*suppress-echo-timeout* t) - (*current-menu-input* "")) + (*suppress-echo-timeout* t)) (bound-check-menu menu) (catch :menu-quit (unwind-protect (with-focus (screen-key-window screen) (loop - (echo-string-list screen menu-text - (+ (menu-state-selected menu) (if prompt 1 0))) + (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)) (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))))) + diff --git a/primitives.lisp b/primitives.lisp index 10ca8df..ee505ab 100644 --- a/primitives.lisp +++ b/primitives.lisp @@ -235,6 +235,13 @@ the mode-line, the button clicked, and the x and y of the pointer.") (defvar *text-color* "white" "The color of message text.") +(defvar *menu-maximum-height* nil + "Defines the maxium number of lines to display in the menu before enabling + scrolling. If NIL scrolling is disabled.") + +(defvar *menu-scrolling-step* 1 + "Number of lines to scroll when hitting the menu list limit.") + (defparameter +netwm-supported+ '(:_NET_SUPPORTING_WM_CHECK :_NET_NUMBER_OF_DESKTOPS -- 1.7.4