[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/06: installer: Add mouse support.
|
From: |
Danny Milosavljevic |
|
Subject: |
02/06: installer: Add mouse support. |
|
Date: |
Tue, 4 Jul 2017 14:27:48 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit dfa33bf530de75a82dec50fc18a4ac5bc10812d6
Author: Danny Milosavljevic <address@hidden>
Date: Tue Jul 4 17:22:38 2017 +0200
installer: Add mouse support.
* gnu/system/installer/page.scm (<page>): Add field "mouse-handler".
(make-page'): Add parameter "mouse-handler".
(page-mouse-handler): New variable. Export it.
(make-page-surface): Add parameter "mouse-handler".
* gnu/system/installer/guixsd-installer.scm (main-page-mouse-handler): New
variable.
(guixsd-installer): Modify.
* gnu/system/installer/configure.scm (configure-page-mouse-handler): New
variable.
(make-configure-page): Use it.
* gnu/system/installer/dialog.scm (dialog-page-mouse-handler): New variable.
(make-dialog): Use it.
* gnu/system/installer/disks.scm (disk-page-mouse-handler): New variable.
(make-disk-page): Use it.
* gnu/system/installer/mount-point.scm (mount-point-page-mouse-handler): New
variable. Export it.
* gnu/system/installer/filesystems.scm (filesystem-page-mouse-handler): New
variable.
(make-file-system-page): Use it.
(file-system-page-key-handler): Pass mount-point-page-mouse-handler.
* gnu/system/installer/format.scm (format-page-mouse-handler): New variable.
(make-format-page): Use it.
* gnu/system/installer/hostname.scm (host-name-mouse-handler): New variable.
(make-host-name-page): Use it.
* gnu/system/installer/install.scm (install-page-mouse-handler): New
variable.
(make-install-page): Use it.
* gnu/system/installer/key-map.scm (key-map-page-mouse-handler): New
variable.
(make-key-map): Use it.
* gnu/system/installer/locale.scm (locale-page-mouse-handler): New variable.
(make-locale-page): Use it.
* gnu/system/installer/network.scm (network-page-mouse-handler): New
variable.
(make-network-page): Use it.
* gnu/system/installer/passphrase.scm (passphrase-mouse-handler): New
variable.
(make-passphrase-page): Use it.
* gnu/system/installer/ping.scm (ping-page-mouse-handler): New variable.
Export it.
* gnu/system/installer/role.scm (role-page-mouse-handler): New variable.
(make-role-page): Use it.
* gnu/system/installer/time-zone.scm (time-zone-page-mouse-handler): New
variable.
(make-tz-browser): Use it.
* gnu/system/installer/user-edit.scm (user-edit-page-mouse-handler): New
variable.
(make-user-edit-page): Use it.
* gnu/system/installer/users.scm (users-page-mouse-handler): New variable.
(make-users-page): Use it.
* gnu/system/installer/wireless.scm (wireless-page-mouse-handler): New
variable.
(make-wireless-page): Use it.
---
gnu/system/installer/configure.scm | 6 +++++-
gnu/system/installer/dialog.scm | 6 +++++-
gnu/system/installer/disks.scm | 10 ++++++---
gnu/system/installer/filesystems.scm | 13 +++++++-----
gnu/system/installer/format.scm | 6 +++++-
gnu/system/installer/guixsd-installer.scm | 35 ++++++++++++++++++++++++-------
gnu/system/installer/hostname.scm | 10 ++++++---
gnu/system/installer/install.scm | 6 +++++-
gnu/system/installer/key-map.scm | 6 +++++-
gnu/system/installer/locale.scm | 10 ++++++---
gnu/system/installer/mount-point.scm | 6 +++++-
gnu/system/installer/network.scm | 15 ++++++++-----
gnu/system/installer/page.scm | 8 ++++---
gnu/system/installer/passphrase.scm | 6 +++++-
gnu/system/installer/ping.scm | 6 +++++-
gnu/system/installer/role.scm | 10 ++++++---
gnu/system/installer/time-zone.scm | 6 +++++-
gnu/system/installer/user-edit.scm | 6 +++++-
gnu/system/installer/users.scm | 11 ++++++----
gnu/system/installer/wireless.scm | 5 ++++-
20 files changed, 139 insertions(+), 48 deletions(-)
diff --git a/gnu/system/installer/configure.scm
b/gnu/system/installer/configure.scm
index bdb138f..a189e86 100644
--- a/gnu/system/installer/configure.scm
+++ b/gnu/system/installer/configure.scm
@@ -45,7 +45,8 @@
title
configure-page-refresh
0
- configure-page-key-handler)))
+ configure-page-key-handler
+ configure-page-mouse-handler)))
page))
@@ -75,6 +76,9 @@
""
"/tmp"))
+(define (configure-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (configure-page-key-handler page ch)
(let ((nav (page-datum page 'navigation))
diff --git a/gnu/system/installer/dialog.scm b/gnu/system/installer/dialog.scm
index 30584fa..5f152df 100644
--- a/gnu/system/installer/dialog.scm
+++ b/gnu/system/installer/dialog.scm
@@ -34,7 +34,8 @@
(gettext "Information")
dialog-page-refresh
0
- dialog-page-key-handler)))
+ dialog-page-key-handler
+ dialog-page-mouse-handler)))
(page-set-datum! page 'message message)
(page-set-datum! page 'justify justify)
page))
@@ -42,6 +43,9 @@
(define my-buttons `((ok ,(M_ "_OK") #t)))
+(define (dialog-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (dialog-page-key-handler page ch)
(let ((nav (page-datum page 'navigation)))
diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm
index e5aef4e..a7164b7 100644
--- a/gnu/system/installer/disks.scm
+++ b/gnu/system/installer/disks.scm
@@ -33,10 +33,11 @@
(define (make-disk-page parent title)
(make-page (page-surface parent)
- title
- disk-page-refresh
+ title
+ disk-page-refresh
0
- disk-page-key-handler))
+ disk-page-key-handler
+ disk-page-mouse-handler))
(define (disk-page-refresh page)
(when (not (page-initialised? page))
@@ -57,6 +58,9 @@
(menu-redraw menu)
(menu-refresh menu)))
+(define (disk-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (disk-page-key-handler page ch)
(let ((menu (page-datum page 'menu))
(nav (page-datum page 'navigation)))
diff --git a/gnu/system/installer/filesystems.scm
b/gnu/system/installer/filesystems.scm
index 02573e2..b8fde7a 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -128,11 +128,11 @@
(define (make-filesystem-page parent title)
(make-page (page-surface parent)
- title
- filesystem-page-refresh
+ title
+ filesystem-page-refresh
0
- filesystem-page-key-handler))
-
+ filesystem-page-key-handler
+ filesystem-page-mouse-handler))
(define my-buttons `((continue ,(M_ "_Continue") #t)
(cancel ,(M_ "Canc_el") #t)))
@@ -172,6 +172,8 @@
(error (format #f "~s is not a partition" p)))
p)))
+(define (filesystem-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
(define (filesystem-page-key-handler page ch)
(let* ((menu (page-datum page 'menu))
@@ -210,7 +212,8 @@
(gettext "Choose the mount
point for device ~s") name)
mount-point-refresh
1
- mount-point-page-key-handler)))
+ mount-point-page-key-handler
+ mount-point-page-mouse-handler)))
(page-set-datum! next 'device name)
(page-enter next)))
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index 5a487c3..9ff9682 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -65,7 +65,8 @@ match those uuids read from the respective partitions"
title
format-page-refresh
0
- format-page-key-handler)))
+ format-page-key-handler
+ format-page-mouse-handler)))
page))
@@ -73,6 +74,9 @@ match those uuids read from the respective partitions"
(cancel ,(M_ "Canc_el") #t)))
+(define (format-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (format-page-key-handler page ch)
(let ((nav (page-datum page 'navigation))
(config-window (page-datum page 'config-window)))
diff --git a/gnu/system/installer/guixsd-installer.scm
b/gnu/system/installer/guixsd-installer.scm
index 7bfb060..599407d 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -205,6 +205,13 @@
(do-task task-name page))))
task-name-list))
+(define (main-page-mouse-handler page device-id x y z button-state)
+ (let ((main-menu (page-datum page 'menu)))
+ (if (eq? 'activated (std-menu-mouse-handler main-menu device-id x y z
button-state))
+ (let ((item (menu-get-current-item main-menu)))
+ (do-task (car item) page)
+ (page-uniquify)
+ ((page-refresh (car stack)) (car stack))))))
(define (main-page-key-handler page ch)
(let ((main-menu (page-datum page 'menu)))
@@ -285,7 +292,6 @@
(define-public (guixsd-installer)
(catch #t
(lambda ()
-
(define stdscr
;; initscr must be called whilst the UTF-8 encoding is in the locale.
;; Otherwise, on certain terminal types, bad things will happen when
@@ -299,6 +305,9 @@
;; crafted display.
(system* "dmesg" "--console-off")
+ ;; Set up mouse
+ (mousemask (logior BUTTON1_CLICKED BUTTON1_PRESSED BUTTON1_RELEASED))
+
(cbreak!) ; Line buffering disabled
(keypad! stdscr #t) ; Check for function keys
(noecho!)
@@ -312,16 +321,26 @@
(let ((page (make-page
stdscr (gettext "GuixSD Installer")
- main-page-refresh 0 main-page-key-handler)))
+ main-page-refresh 0 main-page-key-handler
+ main-page-mouse-handler)))
(page-enter page)
(page-push #f)
(let loop ((ch (getch stdscr)))
- (let* ((current-page (page-top))
- (ret ((page-key-handler current-page) current-page ch)))
- (when (eq? ret 'cancelled)
- (page-ppop))
- (base-page-key-handler current-page ch))
- ((page-refresh (page-top)) (page-top))
+ (let ((current-page (page-top)))
+ (if (eqv? ch KEY_MOUSE)
+ (match (or (getmouse) '())
+ ((device-id x y z button-state)
+ ;(match (mouse-trafo win y x #t)
+ ; ((y x) ...)
+ ; (#f ...))
+ ((page-mouse-handler current-page) current-page device-id x y
z button-state))
+ (_ ((base-page-key-handler current-page) current-page
KEY_DOWN)))
+ (let* ((current-page (page-top))
+ (ret ((page-key-handler current-page) current-page
ch)))
+ (when (eq? ret 'cancelled)
+ (page-ppop))
+ (base-page-key-handler current-page ch)))
+ ((page-refresh current-page) current-page))
(loop (getch stdscr)))
(endwin)))
diff --git a/gnu/system/installer/hostname.scm
b/gnu/system/installer/hostname.scm
index 7f9668f..3e8317d 100644
--- a/gnu/system/installer/hostname.scm
+++ b/gnu/system/installer/hostname.scm
@@ -45,10 +45,11 @@
(define (make-host-name-page parent title)
(make-page (page-surface parent)
- title
- host-name-refresh
+ title
+ host-name-refresh
1
- host-name-key-handler))
+ host-name-key-handler
+ host-name-mouse-handler))
(define (host-name-refresh page)
(when (not (page-initialised? page))
@@ -68,6 +69,9 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
+(define (host-name-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (host-name-key-handler page ch)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
diff --git a/gnu/system/installer/install.scm b/gnu/system/installer/install.scm
index 8e5deb1..00656fe 100644
--- a/gnu/system/installer/install.scm
+++ b/gnu/system/installer/install.scm
@@ -41,7 +41,8 @@
title
install-page-refresh
0
- install-page-key-handler)))
+ install-page-key-handler
+ install-page-mouse-handler)))
page))
@@ -71,6 +72,9 @@
#f)))
+(define (install-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (install-page-key-handler page ch)
(let ((nav (page-datum page 'navigation))
(config-window (page-datum page 'config-window)))
diff --git a/gnu/system/installer/key-map.scm b/gnu/system/installer/key-map.scm
index 5fbedd5..ee64d95 100644
--- a/gnu/system/installer/key-map.scm
+++ b/gnu/system/installer/key-map.scm
@@ -34,13 +34,17 @@
(gettext "Keyboard Mapping")
key-map-page-refresh
0
- key-map-page-key-handler)))
+ key-map-page-key-handler
+ key-map-page-mouse-handler)))
(page-set-datum! page 'directory directory)
page))
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
+(define (key-map-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (key-map-page-key-handler page ch)
(let ((nav (page-datum page 'navigation))
(menu (page-datum page 'menu))
diff --git a/gnu/system/installer/locale.scm b/gnu/system/installer/locale.scm
index 4136010..7ec384f 100644
--- a/gnu/system/installer/locale.scm
+++ b/gnu/system/installer/locale.scm
@@ -33,10 +33,11 @@
(define (make-locale-page parent title)
(make-page (page-surface parent)
- title
- locale-page-refresh
+ title
+ locale-page-refresh
0
- locale-page-key-handler))
+ locale-page-key-handler
+ locale-page-mouse-handler))
(define (locale-page-refresh page)
(when (not (page-initialised? page))
@@ -56,6 +57,9 @@
(menu-redraw menu)
(menu-refresh menu)))
+(define (locale-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (locale-page-key-handler page ch)
(let ((menu (page-datum page 'menu))
(nav (page-datum page 'navigation)))
diff --git a/gnu/system/installer/mount-point.scm
b/gnu/system/installer/mount-point.scm
index 391d809..a124bae 100644
--- a/gnu/system/installer/mount-point.scm
+++ b/gnu/system/installer/mount-point.scm
@@ -27,7 +27,8 @@
#:use-module (ncurses curses)
#:export (mount-point-refresh)
- #:export (mount-point-page-key-handler))
+ #:export (mount-point-page-key-handler)
+ #:export (mount-point-page-mouse-handler))
(include "i18n.scm")
@@ -44,6 +45,9 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
+(define (mount-point-page-mouse-handler page)
+ 'ignored)
+
(define (mount-point-page-key-handler page ch)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
diff --git a/gnu/system/installer/network.scm b/gnu/system/installer/network.scm
index a4ffbff..6dbcc41 100644
--- a/gnu/system/installer/network.scm
+++ b/gnu/system/installer/network.scm
@@ -44,10 +44,11 @@
(define (make-network-page parent title)
(make-page (page-surface parent)
- title
- network-page-refresh
+ title
+ network-page-refresh
0
- network-page-key-handler))
+ network-page-key-handler
+ network-page-mouse-handler))
(define (interfaces)
(map (lambda (ifce)
@@ -89,7 +90,10 @@
"Device"))))))
(define my-buttons `((continue ,(M_ "_Continue") #t)
- (test ,(M_ "_Test") #t)))
+ (test ,(M_ "_Test") #t)))
+
+(define (network-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
(define (network-page-key-handler page ch)
(let ((menu (page-datum page 'menu))
@@ -139,7 +143,8 @@
"Ping"
ping-page-refresh
0
- ping-page-key-handler)))
+ ping-page-key-handler
+ ping-page-mouse-handler)))
(page-enter next)))
((buttons-key-matches-symbol? nav ch 'continue)
diff --git a/gnu/system/installer/page.scm b/gnu/system/installer/page.scm
index a18cde8..f5ddade 100644
--- a/gnu/system/installer/page.scm
+++ b/gnu/system/installer/page.scm
@@ -31,13 +31,14 @@
#:export (page-datum)
#:export (page-set-datum!)
#:export (page-key-handler)
+ #:export (page-mouse-handler)
#:use-module (gnu system installer utils)
#:use-module (gnu system installer levelled-stack)
#:use-module (srfi srfi-9))
(define-record-type <page>
- (make-page' surface title inited refresh cursor-visibility key-handler data)
+ (make-page' surface title inited refresh cursor-visibility key-handler
mouse-handler data)
page?
(title page-title)
(surface page-surface)
@@ -45,11 +46,12 @@
(refresh page-refresh)
(cursor-visibility page-cursor-visibility)
(key-handler page-key-handler)
+ (mouse-handler page-mouse-handler)
(wwin page-wwin page-set-wwin!)
(data page-data page-set-data!))
-(define (make-page surface title refresh cursor-visibility key-handler)
- (make-page' surface title #f refresh cursor-visibility key-handler '()))
+(define (make-page surface title refresh cursor-visibility key-handler
mouse-handler)
+ (make-page' surface title #f refresh cursor-visibility key-handler
mouse-handler '()))
(define (page-set-datum! page key value)
(page-set-data! page (acons key value (page-data page))))
diff --git a/gnu/system/installer/passphrase.scm
b/gnu/system/installer/passphrase.scm
index b222e90..48ba14f 100644
--- a/gnu/system/installer/passphrase.scm
+++ b/gnu/system/installer/passphrase.scm
@@ -41,7 +41,8 @@
title
passphrase-refresh
1
- passphrase-key-handler)))
+ passphrase-key-handler
+ passphrase-mouse-handler)))
(page-set-datum! page 'access-point access-point)
(page-set-datum! page 'ifce ifce)
page))
@@ -66,6 +67,9 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
+(define (passphrase-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (passphrase-key-handler page ch)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
diff --git a/gnu/system/installer/ping.scm b/gnu/system/installer/ping.scm
index 8e22ac6..a013527 100644
--- a/gnu/system/installer/ping.scm
+++ b/gnu/system/installer/ping.scm
@@ -30,7 +30,8 @@
#:export (substitute-is-reachable?)
#:export (ping-page-refresh)
- #:export (ping-page-key-handler))
+ #:export (ping-page-key-handler)
+ #:export (ping-page-mouse-handler))
(include "i18n.scm")
@@ -51,6 +52,9 @@
(continue ,(M_ "_Continue") #t)
(cancel ,(M_ "Canc_el") #t)))
+(define (ping-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (ping-page-key-handler page ch)
(let ((nav (page-datum page 'navigation))
(test-window (page-datum page 'test-window)))
diff --git a/gnu/system/installer/role.scm b/gnu/system/installer/role.scm
index 37f30aa..aa4fcda 100644
--- a/gnu/system/installer/role.scm
+++ b/gnu/system/installer/role.scm
@@ -48,14 +48,18 @@
(define (make-role-page parent title)
(make-page (page-surface parent)
- title
- role-page-refresh
+ title
+ role-page-refresh
0
- role-page-key-handler))
+ role-page-key-handler
+ role-page-mouse-handler))
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
+(define (role-page-mouse-handler device-id x y z button-state)
+ 'ignored)
+
(define (role-page-key-handler page ch)
(let* ((menu (page-datum page 'menu))
(nav (page-datum page 'navigation))
diff --git a/gnu/system/installer/time-zone.scm
b/gnu/system/installer/time-zone.scm
index 6ad33d1..7663711 100644
--- a/gnu/system/installer/time-zone.scm
+++ b/gnu/system/installer/time-zone.scm
@@ -34,13 +34,17 @@
(gettext "Time Zone")
time-zone-page-refresh
0
- time-zone-page-key-handler)))
+ time-zone-page-key-handler
+ time-zone-page-mouse-handler)))
(page-set-datum! page 'directory directory)
page))
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
+(define (time-zone-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (time-zone-page-key-handler page ch)
(let* ((nav (page-datum page 'navigation))
(menu (page-datum page 'menu))
diff --git a/gnu/system/installer/user-edit.scm
b/gnu/system/installer/user-edit.scm
index 7adf88a..fafd2e3 100644
--- a/gnu/system/installer/user-edit.scm
+++ b/gnu/system/installer/user-edit.scm
@@ -40,7 +40,8 @@
title
user-edit-refresh
1
- user-edit-page-key-handler)))
+ user-edit-page-key-handler
+ user-edit-page-mouse-handler)))
(page-set-datum! page 'account account)
(page-set-datum! page 'parent parent)
@@ -55,6 +56,9 @@
(refresh* (outer (page-wwin page)))
(refresh* (form-window form))))
+(define (user-edit-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (user-edit-page-key-handler page ch)
(let ((form (page-datum page 'form))
(nav (page-datum page 'navigation))
diff --git a/gnu/system/installer/users.scm b/gnu/system/installer/users.scm
index 8316cbc..b70aafd 100644
--- a/gnu/system/installer/users.scm
+++ b/gnu/system/installer/users.scm
@@ -37,16 +37,19 @@
(define (make-users-page parent title)
(make-page (page-surface parent)
- title
- users-page-refresh
+ title
+ users-page-refresh
0
- users-page-key-handler))
-
+ users-page-key-handler
+ users-page-mouse-handler))
(define my-buttons `((add ,(M_ "_Add") #t)
(delete ,(M_ "_Delete") #t)
(continue ,(M_ "_Continue") #t)))
+(define (users-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
+
(define (users-page-key-handler page ch)
(let ((menu (page-datum page 'menu))
(nav (page-datum page 'navigation)))
diff --git a/gnu/system/installer/wireless.scm
b/gnu/system/installer/wireless.scm
index 42b1a8f..4726fdb 100644
--- a/gnu/system/installer/wireless.scm
+++ b/gnu/system/installer/wireless.scm
@@ -42,7 +42,8 @@
title
wireless-page-refresh
0
- wireless-page-key-handler)))
+ wireless-page-key-handler
+ wireless-page-mouse-handler)))
(page-set-datum! page 'ifce interface)
page))
@@ -50,6 +51,8 @@
(define my-buttons `((cancel ,(M_ "Canc_el") #t)))
+(define (wireless-page-mouse-handler page device-id x y z button-state)
+ 'ignored)
(define (wireless-page-key-handler page ch)
(let ((nav (page-datum page 'navigation))
- branch wip-installer-2 updated (ff63588 -> f327663), Danny Milosavljevic, 2017/07/04
- 01/06: gurses: Add std-menu-mouse-handler., Danny Milosavljevic, 2017/07/04
- 04/06: installer: Ignore strange mouse events., Danny Milosavljevic, 2017/07/04
- 05/06: installer: Use select-key? for checking the key for selection., Danny Milosavljevic, 2017/07/04
- 06/06: installer: Also allow the clicking of buttons., Danny Milosavljevic, 2017/07/04
- 03/06: installer: Factor out item activation and use it for mouse, too., Danny Milosavljevic, 2017/07/04
- 02/06: installer: Add mouse support.,
Danny Milosavljevic <=