From b796bada21a3a16b4fec71beb1ecb8ea28fa25de Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 25 Mar 2019 14:24:27 +0100
Subject: Fix #\q in main loop.

---
 module/main.scm | 156 ++++++++++++++++++++++++++++----------------------------
 1 file changed, 78 insertions(+), 78 deletions(-)

(limited to 'module')

diff --git a/module/main.scm b/module/main.scm
index e97b5f12..0ad4da63 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -11,6 +11,7 @@
              (srfi srfi-41)
              (srfi srfi-41 util)
              (ice-9 format)
+             (ice-9 control)            ; call-with-escape-continuation
              (texinfo string-utils)     ; string->wrapped-lines
              (util)
              (vcalendar)
@@ -40,85 +41,84 @@
 (define (main-loop regular-events repeating-events)
   (define time (date->time-utc (current-date)))
   (define cur-event 0)
-  (let loop ((char #\nul))
-    (let ((events
-           ;; TODO change back to filter-sorted once it's fixed
-           (merge (filter ;-sorted
-                   (cut event-in? <> time)
-                   regular-events)
-
-                  (stream->list
-                   (filter-sorted-stream
-                    (cut event-in? <> time)
-                    repeating-events))
-
-                  ev-time<?)))
-
-      (case char
-        ;; TODO The explicit loop call is a hack to rerender the display
-        ;; It's REALLY ugly.
-        ((#\L #\l) (set! time (add-day time))    (set! cur-event 0) (loop #\nul))
-        ((#\h #\H) (set! time (remove-day time)) (set! cur-event 0) (loop #\nul))
-        ((#\j #\J) (unless (= cur-event (1- (length events)))
-                     (set! cur-event (1+ cur-event))))
-        ((#\k #\K) (unless (= cur-event 0)
-                     (set! cur-event (1- cur-event)))))
-
-      (cls)
-      (display-calendar-header! (time-utc->date time))
-      ;; (line)
-      (format #t "~a┬~a┬~a~%"
-              (make-string 20 #\─)
-              (make-string 32 #\─)
-              (make-string 10 #\─))
-
-
-      (for-each
-       (lambda (ev i)
-         (format #t "~a │ ~a~a~a~a │ ~a~a~%"
-                 (time->string (attr ev 'DTSTART) "~1 ~3") ; TODO show truncated string
-                 (if (= i cur-event) "\x1b[7m" "")
-                 (color-escape (attr (parent ev) 'COLOR))
-                 (trim-to-width (attr ev 'SUMMARY) 30)
-                 STR-RESET
-                 (trim-to-width
-                  (or (attr ev 'LOCATION) "\x1b[1;30mINGEN LOKAL") 20)
-                 STR-RESET))
-       events
-       (iota (length events)))
-
-      (format #t "~a┴~a┴~a~%"
-              (make-string 20 #\─)
-              (make-string 32 #\─)
-              (make-string 10 #\─))
-
-      (unless (null? events)
-       (let ((ev (list-ref events cur-event)))
-         (format #t "~a~%~a~%~aStart: ~a	Slut: ~a~%~%~a~%"
-                 (attr ev 'X-HNH-FILENAME)
-                 (attr ev 'SUMMARY)
-                 (or (and=> (attr ev 'LOCATION) (cut string-append "Plats: " <> "\n")) "")
-                 (time->string (attr ev 'DTSTART) "~1 ~3")
-                 (time->string (attr ev 'DTEND) "~1 ~3")
-                 (string-join      ; TODO replace this with a better text flower
-                  (take-to         ; This one destroys newlines used for layout
-                   (string->wrapped-lines (or (attr ev 'DESCRIPTION) "")
-                                          #:line-width 60
-                                          #:collapse-whitespace? #f)
-                   10)
-                  (string #\newline))
-                 )))
-
-      ;; (format #t "c = ~c (~d)~%" char (char->integer char))
-
-      (unless (or (eof-object? char)
-                  ;; TODO this requires that `q' is pressed as many
-                  ;; times as other inputs where pressed to actually
-                  ;; quit.
-                  ;; ^C only works because it force closes the
-                  ;; program.
+  (call/ec
+   (lambda (return)
+    (let loop ((char #\nul))
+      (let ((events
+             ;; TODO change back to filter-sorted once it's fixed
+             (merge (filter             ;-sorted
+                     (cut event-in? <> time)
+                     regular-events)
+
+                    (stream->list
+                     (filter-sorted-stream
+                      (cut event-in? <> time)
+                      repeating-events))
+
+                    ev-time<?)))
+
+        (case char
+          ;; TODO The explicit loop call is a hack to rerender the display
+          ;; It's REALLY ugly.
+          ((#\L #\l) (set! time (add-day time))    (set! cur-event 0) (loop #\nul))
+          ((#\h #\H) (set! time (remove-day time)) (set! cur-event 0) (loop #\nul))
+          ((#\j #\J) (unless (= cur-event (1- (length events)))
+                       (set! cur-event (1+ cur-event))))
+          ((#\k #\K) (unless (= cur-event 0)
+                       (set! cur-event (1- cur-event)))))
+
+        (when (or (eof-object? char)
                   (memv char (list #\q (ctrl #\C))))
-        (loop (read-char (current-input-port)))))))
+          (return #f))
+
+        (cls)
+        (display-calendar-header! (time-utc->date time))
+        ;; (line)
+        (format #t "~a┬~a┬~a~%"
+                (make-string 20 #\─)
+                (make-string 32 #\─)
+                (make-string 10 #\─))
+
+
+        (for-each
+         (lambda (ev i)
+           (format #t "~a │ ~a~a~a~a │ ~a~a~%"
+                   (time->string (attr ev 'DTSTART) "~1 ~3") ; TODO show truncated string
+                   (if (= i cur-event) "\x1b[7m" "")
+                   (color-escape (attr (parent ev) 'COLOR))
+                   (trim-to-width (attr ev 'SUMMARY) 30)
+                   STR-RESET
+                   (trim-to-width
+                    (or (attr ev 'LOCATION) "\x1b[1;30mINGEN LOKAL") 20)
+                   STR-RESET))
+         events
+         (iota (length events)))
+
+        (format #t "~a┴~a┴~a~%"
+                (make-string 20 #\─)
+                (make-string 32 #\─)
+                (make-string 10 #\─))
+
+        (unless (null? events)
+          (let ((ev (list-ref events cur-event)))
+            (format #t "~a~%~a~%~aStart: ~a	Slut: ~a~%~%~a~%"
+                    (attr ev 'X-HNH-FILENAME)
+                    (attr ev 'SUMMARY)
+                    (or (and=> (attr ev 'LOCATION) (cut string-append "Plats: " <> "\n")) "")
+                    (time->string (attr ev 'DTSTART) "~1 ~3")
+                    (time->string (attr ev 'DTEND) "~1 ~3")
+                    (string-join   ; TODO replace this with a better text flower
+                     (take-to      ; This one destroys newlines used for layout
+                      (string->wrapped-lines (or (attr ev 'DESCRIPTION) "")
+                                             #:line-width 60
+                                             #:collapse-whitespace? #f)
+                      10)
+                     (string #\newline))
+                    )))
+
+        ;; (format #t "c = ~c (~d)~%" char (char->integer char))
+        (loop (read-char (current-input-port)))
+        )))))
 
 
 
-- 
cgit v1.2.3