guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/06: gurses: Add std-menu-mouse-handler.


From: Danny Milosavljevic
Subject: 01/06: gurses: Add std-menu-mouse-handler.
Date: Tue, 4 Jul 2017 14:27:48 -0400 (EDT)

dannym pushed a commit to branch wip-installer-2
in repository guix.

commit b66885f23906a6c8ad0cd449e8a91b277eec4970
Author: Danny Milosavljevic <address@hidden>
Date:   Tue Jul 4 17:01:06 2017 +0200

    gurses: Add std-menu-mouse-handler.
    
    * gurses/menu.scm (std-menu-mouse-handler): New variable.  Export it.
---
 gurses/menu.scm | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/gurses/menu.scm b/gurses/menu.scm
index 36f5b42..e572568 100644
--- a/gurses/menu.scm
+++ b/gurses/menu.scm
@@ -37,10 +37,12 @@
   #:export (menu-get-current-item)
 
   #:export (std-menu-key-handler)
+  #:export (std-menu-mouse-handler)
 
   #:use-module (ncurses curses)
   #:use-module (ncurses panel)
-  #:use-module (srfi srfi-9))
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match))
 
 (define-record-type <menu>
   (make-menu' current-item items top-item active active-attr active-color disp)
@@ -177,3 +179,20 @@
        (eq? ch #\dle))
     (if (menu-active menu)
        (menu-up menu)))))
+
+(define (std-menu-mouse-handler menu device-id g-x g-y z button-state)
+  (if (logtest BUTTON1_CLICKED button-state)
+      (let* ((win (menu-window menu))
+             (top-item-index (menu-top-item menu))
+             (item-count (length (menu-items menu))))
+        (match (mouse-trafo win g-y g-x #f)
+         ((y x)
+          (menu-set-active! menu #f)
+          (let ((selected-item-index (+ y top-item-index)))
+            (if (and (>= selected-item-index 0) (< selected-item-index 
item-count))
+                (begin
+                  (menu-set-current-item! menu selected-item-index)
+                  (menu-redraw menu)
+                  'activated))))
+         (_ 'ignored)))
+      'ignored))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]