guix-commits
[Top][All Lists]
Advanced

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

15/21: installer: Add procedures to replace car/cdr since these are frou


From: John Darrington
Subject: 15/21: installer: Add procedures to replace car/cdr since these are frounded upon by Guile gurus.
Date: Thu, 22 Dec 2016 19:58:40 +0000 (UTC)

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

commit 2db7fe6323dc3e9f9b862cfc8015f8349eae4b5e
Author: John Darrington <address@hidden>
Date:   Thu Dec 22 07:47:59 2016 +0100

    installer: Add procedures to replace car/cdr since these
     are frounded upon by Guile gurus.
    
    * gnu/system/installer/utils.scm (inner, outer): New procedures.
    * gnu/system/installer/dialog.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/disks.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/file-browser.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/filesystems.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/hostname.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/mount-point.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/network.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/new.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/ping.scm: car -> inner, cdr -> outer.
    * gnu/system/installer/time-zone.scm: car -> inner, cdr -> outer.
---
 gnu/system/installer/dialog.scm       |   20 ++++++++++----------
 gnu/system/installer/disks.scm        |   26 +++++++++++++-------------
 gnu/system/installer/file-browser.scm |   30 +++++++++++++++---------------
 gnu/system/installer/filesystems.scm  |   24 ++++++++++++------------
 gnu/system/installer/hostname.scm     |   16 ++++++++--------
 gnu/system/installer/mount-point.scm  |   22 +++++++++++-----------
 gnu/system/installer/network.scm      |   24 ++++++++++++------------
 gnu/system/installer/new.scm          |    8 ++++----
 gnu/system/installer/ping.scm         |   20 ++++++++++----------
 gnu/system/installer/time-zone.scm    |   30 +++++++++++++++---------------
 gnu/system/installer/utils.scm        |   18 ++++++++++++++++++
 11 files changed, 128 insertions(+), 110 deletions(-)

diff --git a/gnu/system/installer/dialog.scm b/gnu/system/installer/dialog.scm
index 1324a9d..26064eb 100644
--- a/gnu/system/installer/dialog.scm
+++ b/gnu/system/installer/dialog.scm
@@ -52,8 +52,8 @@
        (buttons-select-next nav))))
 
      ((buttons-key-matches-symbol? nav ch 'ok)
-      (delwin (cdr (page-wwin page)))
-      (delwin (car (page-wwin page)))
+      (delwin (outer (page-wwin page)))
+      (delwin (inner (page-wwin page)))
 
       (delwin (page-datum page 'text-window))
       (set! page-stack (cdr page-stack))
@@ -72,15 +72,15 @@
                                    (- (getmaxy s) 5) (- (getmaxx s) 2)
                                    2 1
                                    #:title (page-title p)))
-        (button-window (derwin (car frame)
-                               3 (getmaxx (car frame))
-                               (- (getmaxy (car frame)) 3) 0
+        (button-window (derwin (inner frame)
+                               3 (getmaxx (inner frame))
+                               (- (getmaxy (inner frame)) 3) 0
                                #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (text-window (derwin (car frame)
-                             (- (getmaxy (car frame)) (getmaxy button-window))
-                             (getmaxx (car frame))
+        (text-window (derwin (inner frame)
+                             (- (getmaxy (inner frame)) (getmaxy 
button-window))
+                             (getmaxx (inner frame))
                              0 0 #:panel #f)))
 
     (let ((m (page-datum p 'message))
@@ -96,8 +96,8 @@
   (page-set-datum! p 'navigation buttons)
   (buttons-post buttons button-window)
   (buttons-select buttons 0)
-  (refresh (cdr frame))
-  (refresh (car frame))
+  (refresh (outer frame))
+  (refresh (inner frame))
   (refresh text-window)
   (refresh button-window)))
 
diff --git a/gnu/system/installer/disks.scm b/gnu/system/installer/disks.scm
index e81101d..43d6e29 100644
--- a/gnu/system/installer/disks.scm
+++ b/gnu/system/installer/disks.scm
@@ -53,9 +53,9 @@
                        (getmaxx win)))
       
       (menu-set-items! menu (volumes))
-      (touchwin (cdr (page-wwin page)))
-      (refresh (cdr (page-wwin page)))
-      (refresh (car (page-wwin page)))
+      (touchwin (outer (page-wwin page)))
+      (refresh (outer (page-wwin page)))
+      (refresh (inner (page-wwin page)))
       (menu-redraw menu)
       (menu-refresh menu)))
 
@@ -97,7 +97,7 @@
                 (disk-name (list-ref (menu-items menu) i)))))
 
      ((buttons-key-matches-symbol? nav ch 'continue)
-      (delwin (cdr (page-wwin page)))
+      (delwin (outer (page-wwin page)))
       (set! page-stack (cdr page-stack))
       ((page-refresh (car page-stack)) (car page-stack))))
     
@@ -118,20 +118,20 @@
              (- (getmaxy s) 4) (- (getmaxx s) 2)
              2 1
              #:title (page-title p)))
-        (button-window (derwin (car frame)
-                      3 (getmaxx (car frame))
-                      (- (getmaxy (car frame)) 3) 0
+        (button-window (derwin (inner frame)
+                      3 (getmaxx (inner frame))
+                      (- (getmaxy (inner frame)) 3) 0
                          #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (text-window (derwin (car frame)
+        (text-window (derwin (inner frame)
                              4
-                             (getmaxx (car frame))
+                             (getmaxx (inner frame))
                              0 0 #:panel #f))
                              
-        (menu-window (derwin (car frame)
-                      (- (getmaxy (car frame)) 3 (getmaxy text-window))
-                       (getmaxx (car frame))
+        (menu-window (derwin (inner frame)
+                      (- (getmaxy (inner frame)) 3 (getmaxy text-window))
+                       (getmaxx (inner frame))
                       (getmaxy text-window) 0 #:panel #f))
         (menu (make-menu  (volumes)
                           #:disp-proc
@@ -152,5 +152,5 @@
     (page-set-datum! p 'navigation buttons)
     (menu-post menu menu-window)
     (buttons-post buttons button-window)
-    (refresh (cdr frame))
+    (refresh (outer frame))
     (refresh button-window)))
diff --git a/gnu/system/installer/file-browser.scm 
b/gnu/system/installer/file-browser.scm
index 923bf74..87d8ef9 100644
--- a/gnu/system/installer/file-browser.scm
+++ b/gnu/system/installer/file-browser.scm
@@ -55,8 +55,8 @@
        (buttons-select-next nav))))
 
      ((buttons-key-matches-symbol? nav ch 'back)
-      (delwin (cdr (page-wwin page)))
-      (delwin (car (page-wwin page)))
+      (delwin (outer (page-wwin page)))
+      (delwin (inner (page-wwin page)))
 
       (set! page-stack (cdr page-stack)))
 
@@ -82,9 +82,9 @@
   (when (not (page-initialised? page))
     (file-browser-page-init page)
     (page-set-initialised! page #t))
-  (touchwin (cdr (page-wwin page)))
-  (refresh (cdr (page-wwin page)))
-  (refresh (car (page-wwin page)))
+  (touchwin (outer (page-wwin page)))
+  (refresh (outer (page-wwin page)))
+  (refresh (inner (page-wwin page)))
   (menu-refresh (page-datum page 'menu)))
 
 (define (file-browser-page-init p)
@@ -93,20 +93,20 @@
              (- (getmaxy s) 5) (- (getmaxx s) 2)
              2 1
              #:title (page-title p)))
-        (button-window (derwin (car frame)
-                      3 (getmaxx (car frame))
-                      (- (getmaxy (car frame)) 3) 0
+        (button-window (derwin (inner frame)
+                      3 (getmaxx (inner frame))
+                      (- (getmaxy (inner frame)) 3) 0
                          #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (text-window (derwin (car frame)
+        (text-window (derwin (inner frame)
                              4
-                             (getmaxx (car frame))
+                             (getmaxx (inner frame))
                              0 0 #:panel #f))
 
-        (menu-window (derwin (car frame)
-                             (- (getmaxy (car frame)) 3 (getmaxy text-window))
-                             (getmaxx (car frame))
+        (menu-window (derwin (inner frame)
+                             (- (getmaxy (inner frame)) 3 (getmaxy 
text-window))
+                             (getmaxx (inner frame))
                              (getmaxy text-window) 0 #:panel #f))
         
         (menu (make-menu
@@ -123,8 +123,8 @@
     (page-set-datum! p 'menu menu)
     (page-set-datum! p 'navigation buttons)
     (buttons-post buttons button-window)
-    (refresh (cdr frame))
-    (refresh (car frame))
+    (refresh (outer frame))
+    (refresh (inner frame))
     (refresh text-window)
     (refresh button-window)))
 
diff --git a/gnu/system/installer/filesystems.scm 
b/gnu/system/installer/filesystems.scm
index 5bbe3ca..79fb2a0 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -61,9 +61,9 @@
            (gettext "Select a partition to change its mount point or 
filesystem."))
 
     (menu-set-items! menu (partition-volume-pairs))
-    (touchwin (cdr (page-wwin page)))
-    (refresh (cdr (page-wwin page)))
-    (refresh (car (page-wwin page)))
+    (touchwin (outer (page-wwin page)))
+    (refresh (outer (page-wwin page)))
+    (refresh (inner (page-wwin page)))
     (menu-refresh menu)
     (menu-redraw menu)))
 
@@ -143,7 +143,7 @@
          ((page-refresh next) next)))
        
        (else
-       (delwin (cdr (page-wwin page)))
+       (delwin (outer (page-wwin page)))
        (set! page-stack (cdr page-stack))
        ((page-refresh (car page-stack)) (car page-stack))
        ))))
@@ -158,18 +158,18 @@
              2 1
              #:title (page-title p)))
 
-        (text-window (derwin (car pr) 3 (getmaxx (car pr))
+        (text-window (derwin (inner pr) 3 (getmaxx (inner pr))
                              0 0))
         
-        (bwin (derwin (car pr)
-                      3 (getmaxx (car pr))
-                      (- (getmaxy (car pr)) 3) 0
+        (bwin (derwin (inner pr)
+                      3 (getmaxx (inner pr))
+                      (- (getmaxy (inner pr)) 3) 0
                          #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (mwin (derwin (car pr)
-                      (- (getmaxy (car pr)) 3 (getmaxy text-window))
-                      (- (getmaxx (car pr)) 0)
+        (mwin (derwin (inner pr)
+                      (- (getmaxy (inner pr)) 3 (getmaxy text-window))
+                      (- (getmaxx (inner pr)) 0)
                       (getmaxy text-window)  0 #:panel #f))
         
         (menu (make-menu  (partition-volume-pairs)
@@ -192,7 +192,7 @@
     (page-set-datum! p 'text-window text-window)
     (menu-post menu mwin)
     (buttons-post buttons bwin)
-    (refresh (cdr pr))
+    (refresh (outer pr))
     (refresh bwin)))
                              
 
diff --git a/gnu/system/installer/hostname.scm 
b/gnu/system/installer/hostname.scm
index f3bfe78..f71da81 100644
--- a/gnu/system/installer/hostname.scm
+++ b/gnu/system/installer/hostname.scm
@@ -46,7 +46,7 @@
      text-window
      (gettext "Enter the host name for the new system.  Only letters, digits 
and hyphens are allowed. The first character may not be a hyphen.  A maximum of 
64 characters are allowed."))
     (refresh text-window)
-    (refresh (cdr (page-wwin page)))
+    (refresh (outer (page-wwin page)))
     (refresh (form-window form))))
 
 (define (host-name-key-handler page ch)
@@ -104,19 +104,19 @@
              2 1
              #:title (page-title p)))
         
-        (text-window (derwin (car pr) 5 (getmaxx (car pr))
+        (text-window (derwin (inner pr) 5 (getmaxx (inner pr))
                              0 0))
         
-        (bwin (derwin (car pr)
-                      3 (getmaxx (car pr))
-                      (- (getmaxy (car pr)) 3) 0
+        (bwin (derwin (inner pr)
+                      3 (getmaxx (inner pr))
+                      (- (getmaxy (inner pr)) 3) 0
                       #:panel #f))
         
         (nav (make-buttons my-buttons 1))
         
-        (fw (derwin (car pr)
+        (fw (derwin (inner pr)
                     2
-                    (getmaxx (car pr))
+                    (getmaxx (inner pr))
                     (getmaxy text-window) 0))
 
 
@@ -129,5 +129,5 @@
     (form-post form fw)
     (buttons-post nav bwin)
     (page-set-wwin! p pr)
-    (refresh (cdr pr))))
+    (refresh (outer pr))))
 
diff --git a/gnu/system/installer/mount-point.scm 
b/gnu/system/installer/mount-point.scm
index 67d048b..5ea0235 100644
--- a/gnu/system/installer/mount-point.scm
+++ b/gnu/system/installer/mount-point.scm
@@ -49,7 +49,7 @@
     (mount-point-page-init page)
     (page-set-initialised! page #t))
   (let ((form  (page-datum page 'form)))
-    (refresh (cdr (page-wwin page)))
+    (refresh (outer (page-wwin page)))
     (refresh (form-window form))))
 
 (define (mount-point-page-key-handler page ch)
@@ -124,25 +124,25 @@
              2 1
              #:title (page-title p)))
         
-        (text-window (derwin (car pr) 3 (getmaxx (car pr))
+        (text-window (derwin (inner pr) 3 (getmaxx (inner pr))
                              0 0))
         
-        (bwin (derwin (car pr)
-                      3 (getmaxx (car pr))
-                      (- (getmaxy (car pr)) 3) 0
+        (bwin (derwin (inner pr)
+                      3 (getmaxx (inner pr))
+                      (- (getmaxy (inner pr)) 3) 0
                       #:panel #f))
         
         (nav (make-buttons my-buttons 1))
         
-        (fw (derwin (car pr)
+        (fw (derwin (inner pr)
                     2
-                    (getmaxx (car pr))
+                    (getmaxx (inner pr))
                     (getmaxy text-window) 0))
 
 
-        (out (derwin (car pr)
-                    (- (getmaxy (car pr)) (getmaxy bwin) (getmaxy text-window) 
(getmaxy fw))
-                    (getmaxx (car pr))
+        (out (derwin (inner pr)
+                    (- (getmaxy (inner pr)) (getmaxy bwin) (getmaxy 
text-window) (getmaxy fw))
+                    (getmaxx (inner pr))
                     (+ (getmaxy text-window) (getmaxy fw))
                     0))
         
@@ -174,5 +174,5 @@
     (page-set-datum! p 'form form)
 
     (page-set-wwin! p pr)
-    (refresh (cdr pr))))
+    (refresh (outer pr))))
 
diff --git a/gnu/system/installer/network.scm b/gnu/system/installer/network.scm
index d638562..0330164 100644
--- a/gnu/system/installer/network.scm
+++ b/gnu/system/installer/network.scm
@@ -81,7 +81,7 @@
  
 
      ((buttons-key-matches-symbol? nav ch 'continue)
-       (delwin (cdr (page-wwin page)))
+       (delwin (outer (page-wwin page)))
        (set! page-stack (cdr page-stack))
        ((page-refresh (car page-stack)) (car page-stack)))
 
@@ -103,9 +103,9 @@
   (when (not (page-initialised? page))
     (network-page-init page)
     (page-set-initialised! page #t))
-  (touchwin (cdr (page-wwin page)))
-  (refresh (cdr (page-wwin page)))
-  (refresh (car (page-wwin page)))
+  (touchwin (outer (page-wwin page)))
+  (refresh (outer (page-wwin page)))
+  (refresh (inner (page-wwin page)))
   (menu-refresh (page-datum page 'menu)))
 
 
@@ -117,19 +117,19 @@
              #:title (page-title p)))
         (text-window (derwin
                       (car pr)
-                      5 (getmaxx (car pr))
+                      5 (getmaxx (inner pr))
                       0 0
                       #:panel #f))
                              
-        (bwin (derwin (car pr)
-                      3 (getmaxx (car pr))
-                      (- (getmaxy (car pr)) 3) 0
+        (bwin (derwin (inner pr)
+                      3 (getmaxx (inner pr))
+                      (- (getmaxy (inner pr)) 3) 0
                          #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (mwin (derwin (car pr)
-                      (- (getmaxy (car pr)) (getmaxy text-window) 3)
-                      (- (getmaxx (car pr)) 0)
+        (mwin (derwin (inner pr)
+                      (- (getmaxy (inner pr)) (getmaxy text-window) 3)
+                      (- (getmaxx (inner pr)) 0)
                       (getmaxy text-window) 0 #:panel #f))
         
         (menu (make-menu
@@ -165,7 +165,7 @@
     (page-set-datum! p 'navigation buttons)
     (menu-post menu mwin)
     (buttons-post buttons bwin)
-    (refresh (cdr pr))
+    (refresh (outer pr))
     (refresh text-window)
     (refresh bwin)))
                              
diff --git a/gnu/system/installer/new.scm b/gnu/system/installer/new.scm
index 5646dfb..5d37e58 100644
--- a/gnu/system/installer/new.scm
+++ b/gnu/system/installer/new.scm
@@ -206,7 +206,7 @@
 (define (main-page-init page)
   (let* ((frame (make-boxed-window (page-surface page) (lines) (cols) 0 0
                                    #:title (page-title page)))
-         (background (car frame)))
+         (background (inner frame)))
 
     (let ((win (derwin background (- (getmaxy background) 3)
                       (- (getmaxx background) 2) 0 1 #:panel #f))
@@ -238,9 +238,9 @@
     (main-page-init page)
     (page-set-initialised! page #t))
   
-  (touchwin (cdr (page-wwin page)))
-  (refresh (cdr (page-wwin page)))
-  (refresh (car (page-wwin page)))
+  (touchwin (outer (page-wwin page)))
+  (refresh (outer (page-wwin page)))
+  (refresh (inner (page-wwin page)))
   (menu-refresh (page-datum page 'menu))
   (menu-redraw (page-datum page 'menu)))
 
diff --git a/gnu/system/installer/ping.scm b/gnu/system/installer/ping.scm
index fcf5827..f7956e1 100644
--- a/gnu/system/installer/ping.scm
+++ b/gnu/system/installer/ping.scm
@@ -58,8 +58,8 @@
       (buttons-unselect-all nav))
 
      ((buttons-key-matches-symbol? nav ch 'continue)
-      (delwin (cdr (page-wwin page)))
-      (delwin (car (page-wwin page)))
+      (delwin (outer (page-wwin page)))
+      (delwin (inner (page-wwin page)))
 
       (delwin (page-datum page 'test-window))
       (set! page-stack (cdr page-stack))
@@ -89,20 +89,20 @@
              (- (getmaxy s) 5) (- (getmaxx s) 2)
              2 1
              #:title (page-title p)))
-        (button-window (derwin (car frame)
-                      3 (getmaxx (car frame))
-                      (- (getmaxy (car frame)) 3) 0
+        (button-window (derwin (inner frame)
+                      3 (getmaxx (inner frame))
+                      (- (getmaxy (inner frame)) 3) 0
                          #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (text-window (derwin (car frame)
+        (text-window (derwin (inner frame)
                              4
-                             (getmaxx (car frame))
+                             (getmaxx (inner frame))
                              0 0 #:panel #f))
 
-        (test-window (derwin (car frame)
-                             (- (getmaxy (car frame)) (getmaxy text-window) 
(getmaxy button-window))
-                             (getmaxx (car frame))
+        (test-window (derwin (inner frame)
+                             (- (getmaxy (inner frame)) (getmaxy text-window) 
(getmaxy button-window))
+                             (getmaxx (inner frame))
                              (getmaxy text-window) 0 #:panel #f))
         )
 
diff --git a/gnu/system/installer/time-zone.scm 
b/gnu/system/installer/time-zone.scm
index 9428624..c7e6d08 100644
--- a/gnu/system/installer/time-zone.scm
+++ b/gnu/system/installer/time-zone.scm
@@ -55,8 +55,8 @@
        (buttons-select-next nav))))
 
      ((buttons-key-matches-symbol? nav ch 'back)
-      (delwin (cdr (page-wwin page)))
-      (delwin (car (page-wwin page)))
+      (delwin (outer (page-wwin page)))
+      (delwin (inner (page-wwin page)))
 
       (set! page-stack (cdr page-stack)))
 
@@ -91,9 +91,9 @@
   (when (not (page-initialised? page))
     (file-browser-page-init page)
     (page-set-initialised! page #t))
-  (touchwin (cdr (page-wwin page)))
-  (refresh (cdr (page-wwin page)))
-  (refresh (car (page-wwin page)))
+  (touchwin (outer (page-wwin page)))
+  (refresh (outer (page-wwin page)))
+  (refresh (inner (page-wwin page)))
   (menu-refresh (page-datum page 'menu)))
 
 (define (file-browser-page-init p)
@@ -102,20 +102,20 @@
              (- (getmaxy s) 5) (- (getmaxx s) 2)
              2 1
              #:title (page-title p)))
-        (button-window (derwin (car frame)
-                      3 (getmaxx (car frame))
-                      (- (getmaxy (car frame)) 3) 0
+        (button-window (derwin (inner frame)
+                      3 (getmaxx (inner frame))
+                      (- (getmaxy (inner frame)) 3) 0
                          #:panel #f))
         (buttons (make-buttons my-buttons 1))
 
-        (text-window (derwin (car frame)
+        (text-window (derwin (inner frame)
                              4
-                             (getmaxx (car frame))
+                             (getmaxx (inner frame))
                              0 0 #:panel #f))
 
-        (menu-window (derwin (car frame)
-                             (- (getmaxy (car frame)) 3 (getmaxy text-window))
-                             (getmaxx (car frame))
+        (menu-window (derwin (inner frame)
+                             (- (getmaxy (inner frame)) 3 (getmaxy 
text-window))
+                             (getmaxx (inner frame))
                              (getmaxy text-window) 0 #:panel #f))
         
         (menu (make-menu
@@ -143,7 +143,7 @@
     (page-set-datum! p 'menu menu)
     (page-set-datum! p 'navigation  buttons)
     (buttons-post buttons button-window)
-    (refresh (cdr frame))
-    (refresh (car frame))
+    (refresh (outer frame))
+    (refresh (inner frame))
     (refresh text-window)
     (refresh button-window)))
diff --git a/gnu/system/installer/utils.scm b/gnu/system/installer/utils.scm
index bcecb07..3aa2bc8 100644
--- a/gnu/system/installer/utils.scm
+++ b/gnu/system/installer/utils.scm
@@ -31,6 +31,8 @@
            standard-menu-keystrokes
 
            make-boxed-window
+            inner
+            outer
            
            open-input-pipe-with-fallback
 
@@ -44,6 +46,7 @@
 
 (use-modules (ice-9 popen)
             (ice-9 rdelim)
+             (ice-9 match)
             (ncurses menu)
             (gnu system installer misc)
             (ncurses form)
@@ -243,6 +246,21 @@ which will process each string before returning it."
 
 
 
+(define (inner boxed-window)
+  (match boxed-window
+    ((inside . _)
+     (if (not (window? inside))
+         (error "~s is not a window" inside))
+     inside)))
+
+(define (outer boxed-window)
+  (match boxed-window
+    ((_ . outside)
+     (if (not (window? outside))
+         (error "~s is not a window" outside))
+     outside)))
+
+
 (define* (make-boxed-window orig height width starty startx #:key (title #f))
   "Create a window with a frame around it, and optionally a TITLE.  Returns a
 pair whose car is the inner window and whose cdr is the frame."



reply via email to

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