[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [STUMP] [PATCH] select-from-menu, scrolling fixed
|
From: |
Morgan Veyret |
|
Subject: |
Re: [STUMP] [PATCH] select-from-menu, scrolling fixed |
|
Date: |
Sat, 8 Nov 2008 14:14:33 +0100 |
|
User-agent: |
Mutt/1.4.2.3i |
On 00:59 Thu 14 Feb , Morgan Veyret wrote:
> I fixed my menu scrolling code.
> Now it should work better and is controlled with *menu-maximum-height*.
> When nil scrolling is disabled.
> You can also set the scrolling step with *menu-scrolling-step*
>
Attached is a new version of the patch for current master.
>
>
> --
>
> Morgan Veyret (address@hidden)
> ------------------------------------------------------------------------------
> Centre Européen de Réalité Virtuelle (CERV)
> 25, rue Claude Chappe
> BP 38 F-29280 Plouzané (France)
> ------------------------------------------------------------------------------
> Tél: +33 (0)2 98 05 89 43
> Fax: +33 (0)2 98 05 89 79
> http://www.cerv.fr
> ------------------------------------------------------------------------------
>
> ,'``.._ ,'``.
> :,--._:)\,:,._,.: All Glory to
> :`--,'' :`...';\ the HYPNO TOAD!
> `,' `---' `.
> / :
> / \
> ,' :\.___,-.
> `...,---'``````-..._ |: \
> ( ) ;: ) \ _,-.
> `. ( // `' \
> : `.// ) ) , ;
> ,-|`. _,'/ ) ) ,' ,'
> ( :`.`-..____..=:.-': . _,' ,'
> `,'\ ``--....-)=' `._, \ ,') _ '``._
> _.-/ _ `. (_) / )' ; / \ \`-.'
> `--( `-:`. `' ___..' _,-' |/ `.)
> `-. `.`.``-----``--, .'
> |/`.\`' ,',');
> ` (/ (/
> From d65052015200abbe11745978241688aa1796a6b0 Mon Sep 17 00:00:00 2001
> From: Morgan Veyret <address@hidden>
> Date: Thu, 14 Feb 2008 00:57:42 +0100
> Subject: [PATCH] Added scrolling to select-from-menu.
> News variables added in primitives.lisp: *menu-maximum-height* and
> *menu-scrolling-step*
> ---
> primitives.lisp | 7 ++++
> stumpwm.asd | 30 ++++++++--------
> user.lisp | 104
> +++++++++++++++++++++++++++++++++++++++++++++++--------
> 3 files changed, 111 insertions(+), 30 deletions(-)
>
> diff --git a/primitives.lisp b/primitives.lisp
> index 4fc07dc..2dfd1bf 100644
> --- a/primitives.lisp
> +++ b/primitives.lisp
> @@ -214,6 +214,13 @@ run before the error is dealt with according to
> (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
> diff --git a/stumpwm.asd b/stumpwm.asd
> index 3e863ad..eb6ef3e 100644
> --- a/stumpwm.asd
> +++ b/stumpwm.asd
> @@ -8,8 +8,8 @@
> ;; cmucl-clx. *very* annoying. I don't actually know if debian still
> ;; does this.
> #+cmu (progn
> - (ignore-errors (require :cmucl-clx))
> - (ignore-errors (require :clx)))
> + (ignore-errors (require :cmucl-clx))
> + (ignore-errors (require :clx)))
> ;; Otherwise just load clx
> #+sbcl(require :clx)
>
> @@ -25,18 +25,18 @@
> :serial t
> :depends-on (:cl-ppcre)
> :components ((:file "package")
> - (:file "primitives")
> - (:file "keysyms")
> - (:file "keytrans")
> - (:file "kmap")
> - (:file "input")
> - (:file "core")
> - (:file "user")
> + (:file "primitives")
> + (:file "keysyms")
> + (:file "keytrans")
> + (:file "kmap")
> + (:file "input")
> + (:file "core")
> + (:file "user")
> (:file "fdump")
> - (:file "mode-line")
> - (:file "color")
> - (:file "stumpwm")
> - ;; keep this last so it always gets recompiled if
> - ;; anything changes
> - (:file "version")))
> + (:file "mode-line")
> + (:file "color")
> + (:file "stumpwm")
> + ;; keep this last so it always gets recompiled if
> + ;; anything changes
> + (:file "version")))
>
> diff --git a/user.lisp b/user.lisp
> index 34e1360..73f3412 100644
> --- a/user.lisp
> +++ b/user.lisp
> @@ -1586,26 +1586,63 @@ to the next group."
> (define-key m (kbd "C-p") 'menu-up)
> (define-key m (kbd "Up") 'menu-up)
> (define-key m (kbd "k") 'menu-up)
> + (define-key m (kbd "Page_Up") 'menu-page-up)
>
> (define-key m (kbd "C-n") 'menu-down)
> (define-key m (kbd "Down") 'menu-down)
> (define-key m (kbd "j") 'menu-down)
> + (define-key m (kbd "Page_Down") 'menu-page-down)
> (define-key m (kbd "C-g") 'menu-abort)
> (define-key m (kbd "ESC") 'menu-abort)
> (define-key m (kbd "RET") 'menu-finish)
> m)))
>
> (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)
> (decf (menu-state-selected menu))
> (bound-check-menu menu))
> @@ -1614,6 +1651,14 @@ to the next group."
> (incf (menu-state-selected menu))
> (bound-check-menu menu))
>
> +(defun menu-page-up (menu)
> + (decf (menu-state-selected menu))
> + (bound-check-menu menu))
> +
> +(defun menu-page-down (menu)
> + (incf (menu-state-selected menu))
> + (bound-check-menu menu))
> +
> (defun menu-finish (menu)
> (throw :menu-quit (nth (menu-state-selected menu) (menu-state-table
> menu))))
>
> @@ -1621,7 +1666,10 @@ to the next group."
> (declare (ignore menu))
> (throw :menu-quit nil))
>
> -(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
> @@ -1632,18 +1680,30 @@ 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
> - :table table
> - :prompt prompt
> - :selected initial-selection))
> - (menu-options (mapcar (lambda (elt)
> + (let* ((menu-options (mapcar (lambda (elt)
> (if (listp elt)
> (first elt)
> - elt))
> + elt))
> table))
> - (menu-text (if prompt
> - (cons prompt menu-options)
> - menu-options))
> + (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))
> (*record-last-msg-override* t)
> (*suppress-echo-timeout* t))
> (bound-check-menu menu)
> @@ -1651,8 +1711,22 @@ See *menu-map* for menu bindings."
> (grab-keyboard screen)
> (unwind-protect
> (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))
> (let ((action (read-from-keymap *menu-map*)))
> (when action
> (funcall action menu))))
> --
> 1.5.2.2
>
> _______________________________________________
> Stumpwm-devel mailing list
> address@hidden
> http://lists.nongnu.org/mailman/listinfo/stumpwm-devel
--
Morgan Veyret (address@hidden)
http://appart.kicks-ass.net/patzy
0001-Added-scrolling-to-select-from-menu.patch
Description: Text document
- Re: [STUMP] [PATCH] select-from-menu, scrolling fixed,
Morgan Veyret <=