From 0288287f06e3afb4f40459da412206dceaf8067e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 30 Apr 2019 01:10:00 +0200
Subject: Replace 'when' and 'unless'.

---
 module/output/html.scm | 14 +++++++-------
 module/output/text.scm |  8 ++++----
 module/util.scm        | 11 ++++++++++-
 module/util/tree.scm   | 20 ++++++++++----------
 4 files changed, 31 insertions(+), 22 deletions(-)

diff --git a/module/output/html.scm b/module/output/html.scm
index f72122bb..a26f05e6 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -32,13 +32,13 @@
   (let inner ((x 0)
               (tree (make-tree overlapping?
                                (sort* lst time>? (lambda (e) (event-length/day e start-of-day))))))
-    (if (null? tree) #f
-        (let ((w (/ (- 1 x)
-                    (+ 1 (length-of-longst-branch (left-subtree tree))))))
-          (set! (width (car tree)) w
-                (x-pos (car tree)) x)
-          (inner (+ x w) (left-subtree tree))
-          (inner x (right-subtree tree))))))
+    (unless (null? tree)
+      (let ((w (/ (- 1 x)
+                  (+ 1 (length-of-longst-branch (left-subtree tree))))))
+        (set! (width (car tree)) w
+              (x-pos (car tree)) x)
+        (inner (+ x w) (left-subtree tree))
+        (inner x (right-subtree tree))))))
 
 ;; This should only be used on time intervals, never on absolute times.
 ;; For that see @var{date->decimal-hour}.
diff --git a/module/output/text.scm b/module/output/text.scm
index 5d8248f4..3b83e115 100644
--- a/module/output/text.scm
+++ b/module/output/text.scm
@@ -16,10 +16,10 @@
          (slots (1- (length words)))
          (space-list
           (let loop ((n needed-spaces) (d slots))
-            (if (zero? d) '()
-                (let ((v (round (/ n d))))
-                  (cons v (loop (- n v)
-                                (1- d))))))))
+            (unless (zero? d)
+              (let ((v (round (/ n d))))
+                (cons v (loop (- n v)
+                              (1- d))))))))
     (string-concatenate/shared
      (merge words (map (lambda (n) (make-string n #\space))
                        space-list)
diff --git a/module/util.scm b/module/util.scm
index 97483222..2a995777 100644
--- a/module/util.scm
+++ b/module/util.scm
@@ -9,7 +9,8 @@
                 catch-multiple
                 quote?
                 tree-map let-lazy)
-  #:replace (let* set! define-syntax))
+  #:replace (let* set! define-syntax
+                  when unless))
 
 ((@ (guile) define-syntax) define-syntax
   (syntax-rules ()
@@ -141,6 +142,14 @@
 
 
 
+(define-syntax-rule (when pred body ...)
+  (if pred (begin body ...) '()))
+
+(define-syntax-rule (unless pred body ...)
+  (if pred '() (begin body ...)))
+
+
+
 ;; Allow set to work on multiple values at once,
 ;; similar to Common Lisp's @var{setf}
 ;; @example
diff --git a/module/util/tree.scm b/module/util/tree.scm
index 8d3e7805..474dc272 100644
--- a/module/util/tree.scm
+++ b/module/util/tree.scm
@@ -11,12 +11,12 @@
 ;; Has thee form @var{(node left-subtree right-subtree)}. A leaf has
 ;; both it's children equal to @var{null}.
 (define (make-tree pred? lst)
-  (if (null? lst) '()
-      (let* ((head tail (partition (lambda (el) (pred? (car lst) el))
-                                   (cdr lst))))
-        (list (car lst)
-              (make-tree pred? head)
-              (make-tree pred? tail)))))
+  (unless (null? lst)
+    (let* ((head tail (partition (lambda (el) (pred? (car lst) el))
+                                 (cdr lst))))
+      (list (car lst)
+            (make-tree pred? head)
+            (make-tree pred? tail)))))
 
 (define (left-subtree tree)
   (list-ref tree 1))
@@ -34,7 +34,7 @@
              (length-of-longst-branch (right-subtree tree)))))
 
 (define (tree-map proc tree)
-  (if (null? tree) '()
-      (list (proc (car tree))
-            (tree-map proc (left-subtree tree))
-            (tree-map proc (right-subtree tree)))))
+  (unless (null? tree)
+    (list (proc (car tree))
+          (tree-map proc (left-subtree tree))
+          (tree-map proc (right-subtree tree)))))
-- 
cgit v1.2.3