From feefb97cf9118c8e5d7018e33887a371dadc5eab Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sun, 6 Oct 2019 13:35:20 +0200
Subject: Minor cleanup in scheme code.

---
 module/output/terminal.scm      |  2 +-
 module/server/macro.scm         | 10 ++--------
 module/vcomponent.scm           | 36 +++++++-----------------------------
 module/vcomponent/base.scm      | 27 +++++----------------------
 module/vcomponent/primitive.scm | 22 ++++------------------
 module/vcomponent/timezone.scm  |  3 ++-
 6 files changed, 21 insertions(+), 79 deletions(-)

diff --git a/module/output/terminal.scm b/module/output/terminal.scm
index 37fe1b86..16ba31e9 100644
--- a/module/output/terminal.scm
+++ b/module/output/terminal.scm
@@ -138,7 +138,7 @@
                    (let ((ev ((@ (vcomponent primitive) %vcomponent-make) fname)))
                      (serialize-vcomponent ev (current-error-port))
 
-                     (push-child! (parent (list-ref events cur-event)) ev)
+                     (add-child! (parent (list-ref events cur-event)) ev)
                      (format (current-error-port) "Children: ~a~%start: ~a~%" (children ev)
                              (attr ev 'DTSTART))
                      (set! event-stream (stream-insert ev-time<? ev event-stream)))))))
diff --git a/module/server/macro.scm b/module/server/macro.scm
index 71452d0f..123fc468 100644
--- a/module/server/macro.scm
+++ b/module/server/macro.scm
@@ -7,14 +7,6 @@
 
 (use-modules* (web (response uri)))
 
-(define (not-null? obj)
-  (if (null? obj) #f obj))
-
-(define (match-count pattern str)
-  (fold-matches pattern str 0
-                (lambda (_ count)
-                  (1+ count))))
-
 
 
 (define-public (parse-endpoint-string str)
@@ -53,6 +45,8 @@
 (define-macro (make-routes . routes)
 
   `(lambda* (request body #:optional state)
+     ;; ALl these bindings generate compile time warnings since the expansion
+     ;; of the macro might not use them. This isn't really a problem.
      (let ((r:method  (request-method  request))
            (r:uri     (request-uri     request))
            (r:version (request-version request))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index e7ffb785..4d13dbc8 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -32,13 +32,7 @@
 
        ;; TZSET is the generated recurrence set of a timezone
        (set! (attr tz 'X-HNH-TZSET)
-             (make-tz-set tz)
-             #;
-             ((@ (srfi srfi-41) stream)
-              (list
-               (car (children tz))
-               (cadr (children tz))))
-             ))
+             (make-tz-set tz)))
 
   (for ev in (filter (lambda (o) (eq? 'VEVENT (type o))) (children cal))
        (define dptr (attr* ev 'DTSTART))
@@ -50,12 +44,10 @@
                 (let ((d (set (date-hour date) = (+ 1))))
                   (set! (attr ev 'DTEND) d
                         eptr (attr* ev 'DTEND))
-                  d
-                  )]
+                  d)]
                [(value eptr) => parse-datetime]
                [else
-                (set (date-hour date) = (+ 1))])
-         )
+                (set (date-hour date) = (+ 1))]))
 
        (set! (value dptr) (date->time-utc date)
              (value eptr) (date->time-utc end-date))
@@ -70,21 +62,6 @@
                (value eptr) (date->time-utc end-date)))))
 
 
-;; (define-public value caar)
-;; (define-public next cdr)
-;; (define-public next! pop!)
-
-
-;; (define-public (reset! attr-list)
-;;   (while (not (car attr-list))
-;;     (next! attr-list))
-;;   (next! attr-list))
-
-;; value
-;; (define-public v
-;;   (make-procedure-with-setter car set-car!))
-
-
 (define* (make-vcomponent #:optional path)
   (if (not path)
       (primitive-make-vcomponent)
@@ -121,9 +98,10 @@
                                         (unless (find (lambda (z)
                                                         (string=? (attr z "TZID")
                                                                   (attr component "TZID")))
-                                                      (filter (lambda (o) (eq? 'VTIMEZONE (type o))) (children accum)))
-                                          (push-child! accum component)))
-                                       (else (push-child! accum component)))))
+                                                      (filter (lambda (o) (eq? 'VTIMEZONE (type o)))
+                                                              (children accum)))
+                                          (add-child! accum component)))
+                                       (else (add-child! accum component)))))
                            ;; return
                            accum))
 
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm
index 246566ee..69fab656 100644
--- a/module/vcomponent/base.scm
+++ b/module/vcomponent/base.scm
@@ -6,6 +6,8 @@
   :use-module (ice-9 hash-table)
   :use-module ((ice-9 optargs) :select (define*-public)))
 
+(export add-child!)
+
 ;; vline → value
 (define-public value
   (make-procedure-with-setter
@@ -29,25 +31,10 @@
                   (as-string attr)
                   (make-vline value))))
 
-;; (define-public (values-left-count attr-list)
-;;   (length (take-while identity attr-list)))
-
-;; (define-public (value-count attr-list)
-;;   (length (take-while identity (cdr (drop-while identity attr-list)))))
-
-;; (define (get-first c a)
-;;   (and=> (car (get-attr c a)) car))
-
-;; (define (set-first! c a v)
-;;   (and=> (car (get-attr c a))
-;;          (lambda (f) (set! (car f) v))))
-
 (define-public attr
   (make-procedure-with-setter
-;    get-first set-first!
    get-attr
-   set-attr!
-   ))
+   set-attr!))
 
 
 (define-public prop
@@ -68,11 +55,9 @@
                     ))
 
 (define-public (parent c) (struct-ref c 2))
-(define-public push-child! add-child!)
+
 (define-public (attributes component)
-  (hash-map->list cons (struct-ref component 3))
-  #; (map string->symbol (%vcomponent-attribute-list component))
-  )
+  (hash-map->list cons (struct-ref component 3)))
 
 (define*-public (children component)
   (struct-ref component 1))
@@ -92,8 +77,6 @@
                         (hash-map->list (lambda (key value) (cons key (copy-vline value)))
                                         (struct-ref component 3)))))
 
-;; (define-public filter-children! %vcomponent-filter-children!)
-
 (define-public (extract field)
   (lambda (e) (attr e field)))
 
diff --git a/module/vcomponent/primitive.scm b/module/vcomponent/primitive.scm
index 2cf12508..5fef08cc 100644
--- a/module/vcomponent/primitive.scm
+++ b/module/vcomponent/primitive.scm
@@ -1,23 +1,9 @@
 ;;; Primitive export of symbols linked from C binary.
 
 (define-module (vcomponent primitive)
-  #:export #; 
-  (%vcomponent-children                 ;
-  %vcomponent-push-child!               ;
-  %vcomponent-filter-children!          ;
-                                        ;
-  %vcomponent-parent                    ;
-                                        ;
-  %vcomponent-make                      ;
-  %vcomponent-get-type                  ;
-  %vcomponent-set-type!                 ;
-                                        ;
-  %vcomponent-get-attribute             ;
-  %vcomponent-attribute-list            ;
-                                        ;
-  %vcomponent-shallow-copy)
-
-  (make-vcomponent add-line! add-child! make-vline add-attribute! parse-cal-path)
-  )
+  #:export (make-vcomponent
+            add-line! add-child!
+            make-vline add-attribute!
+            parse-cal-path))
 
 (load-extension "libguile-calendar" "init_lib")
diff --git a/module/vcomponent/timezone.scm b/module/vcomponent/timezone.scm
index 4a312288..dde32cc2 100644
--- a/module/vcomponent/timezone.scm
+++ b/module/vcomponent/timezone.scm
@@ -68,7 +68,8 @@
 ;; Crashes on error.
 (define (find-tz cal tzid)
   (let ((ret (find (lambda (tz) (string=? tzid (attr tz 'TZID)))
-                   (children cal 'VTIMEZONE))))
+                   (filter (lambda (o) (eq? 'VTIMEZONE (type o)))
+                           (children cal)))))
     ret))
 
 ;; Takes a VEVENT.
-- 
cgit v1.2.3