Move a bunch of files into calp module.

7 files changed, 0 insertions, 398 deletions

diff --git a/module/entry-points/benchmark.scm b/module/entry-points/benchmark.scm
deleted file mode 100644
index fecc62f7..00000000
--- a/module/entry-points/benchmark.scm
+++ /dev/null
@@ -1,33 +0,0 @@
-(define-module (entry-points benchmark)
-  :use-module (util)
-
-  :use-module (ice-9 getopt-long)
-  :use-module (util options)
-  :use-module ((srfi srfi-41) :select (stream->list))
-
-  :use-module ((vcomponent instance methods) :select (get-event-set))
-  :autoload (vcomponent instance) (global-event-object)
-
-  :export (main)
-  )
-
-
-(define opt-spec
-  `((enable-output (single-char #\o)
-                   (description
-                    "Output is be default supressed, since many fields contain way to much data "
-                    "to read. This turns it on again."))
-    (help (single-char #\h) (description "Print this help."))))
-
-
-(define (main args)
-  (define opts (getopt-long args (getopt-opt opt-spec)))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help opt-spec)
-    (throw 'return))
-
-  (let ((strm (get-event-set global-event-object)))
-    (if (option-ref opts 'enable-output #f)
-        (write (stream->list 1000 strm))
-        (stream->list 1000 strm))))
diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
deleted file mode 100644
index de80f8d2..00000000
--- a/module/entry-points/html.scm
+++ /dev/null
@@ -1,150 +0,0 @@
-(define-module (entry-points html)
-  :export (main)
-  :use-module (util)
-  :use-module (util time)
-  :use-module (util options)
-  :use-module (datetime)
-  :use-module (ice-9 getopt-long)
-  :use-module ((ice-9 regex) :select (string-match regexp-substitute))
-
-  :use-module ((srfi srfi-41) :select (stream-take stream-for-each))
-  :use-module ((html view calendar) :select (html-generate))
-  :use-module ((html view calendar week)
-               :select (render-calendar)
-               :renamer (lambda _ 'render-calendar-wide))
-  :use-module ((html view calendar month)
-               :select (render-calendar-table))
-  :use-module ((vcomponent instance methods)
-                :select (get-calendars get-event-set))
-
-  :use-module ((sxml simple) :select (sxml->xml))
-  :use-module ((sxml transformations) :select (href-transformer))
-
-  :autoload (vcomponent instance) (global-event-object)
-  )
-
-
-(define opt-spec
-  `((from (value #t) (single-char #\F)
-          (description "Start date of output.")
-          )
-    (count (value #t)
-           (description "How many pages should be rendered."
-                        "If --style=" (b "week") " and --from=" (b "2020-04-27")
-                        " then --count=" (b 4) " would render the four pages "
-                        "2020-04-27, 2020-05-04, 2020-05-11, and 2020-05-25. "
-                        "Defaults to 12 to give a whole year when --style=" (b "month") "."
-                        ))
-
-    (style (value #t) (predicate ,(lambda (v) (memv (string->symbol v)
-                                            '(wide week table))))
-           (description "How the body of the HTML page should be layed out. "
-                        (br) (b "week")
-                        " gives a horizontally scrolling page with 7 elements, "
-                        "where each has events graphically laid out hour by hour."
-                        (br) (b "table")
-                        " gives a month in overview as a table. Each block contains "
-                        "the events for the given day, in order of start time. They are "
-                        "however not graphically sized. "
-                        (br) (b "wide")
-                        " is the same as week, but gives a full month.")
-           )
-
-    (help (single-char #\h) (description "Print this help."))))
-
-
-
-;; file existing but is of wrong type,
-(define (create-files)
-  (let* ((dir (dirname (or (@ (global) basedir) ".")))
-         (html (string-append dir "/html"))
-         (link (string-append html "/static")))
-    (unless (file-exists? html)
-      (mkdir html))
-    (unless (file-exists? link)
-      (symlink "../static" link))))
-
-
-(define (get-filename start-date)
-  (format #f "~a/html/~a.xml"
-          (dirname (or (@ (global) basedir) "."))
-          (date->string start-date "~1")))
-
-(define (re-root-static tree)
-  (href-transformer
-   tree
-   (lambda (str)
-     (aif (string-match "^/static" str)
-          (regexp-substitute #f it 'pre "static" 'post)
-          str))))
-
-(define (common count start-date chunk-length
-                render-calendar . extra-args)
-
-  (define calendars (get-calendars global-event-object))
-  (define events (get-event-set global-event-object))
-
-  ((@ (util time) report-time!) "html start")
-
-  (create-files)
-
-  (stream-for-each
-   (lambda (start-date)
-     (define fname (get-filename start-date))
-     (format (current-error-port) "Writing to [~a]~%" fname)
-     (with-output-to-file fname
-       (lambda () (sxml->xml (re-root-static
-                         (apply html-generate
-                                calendars: calendars
-                                events: events
-                                next-start: (lambda (d) (date+ d chunk-length))
-                                prev-start: (lambda (d) (date- d chunk-length))
-                                start-date: start-date
-                                end-date: (remove-day (date+ start-date chunk-length))
-                                render-calendar: render-calendar
-                                extra-args))))))
-   (stream-take count (date-stream chunk-length start-date))
-   ))
-
-
-
-
-(define (main args)
-  (define opts (getopt-long args (getopt-opt opt-spec)))
-  (define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
-                      [else (start-of-month (current-date))]))
-  (define count (string->number (option-ref opts 'count "12")))
-
-  (define style (string->symbol (option-ref opts 'style "wide")))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help opt-spec)
-    (throw 'return)
-    )
-
-  ;; TODO a number of links are wrong, since they point to .html files,
-  ;; while we save the documents as .xml.
-
-  (case style
-    [(wide)
-     (common count start (date month: 1) render-calendar-wide)]
-
-    [(week)
-
-     ;; TODO The small calendar is always centered on months, it might
-     ;; be a good idea to instead center it on the current week, meaning
-     ;; that the active row is always in the center
-     (common count (start-of-week start)
-             (date day: 7)
-             render-calendar-wide)]
-    [(table)
-
-     (common count (start-of-month start) (date month: 1)
-             render-calendar-table
-             pre-start: (start-of-week start)
-             post-end: (end-of-week (end-of-month start)))]
-    [else
-     (error "Unknown html style: ~a" style)])
-
-  ((@ (util time) report-time!) "all done")
-  )
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
deleted file mode 100644
index 997621b2..00000000
--- a/module/entry-points/ical.scm
+++ /dev/null
@@ -1,31 +0,0 @@
-(define-module (entry-points ical)
-  :export (main)
-  :use-module (util)
-  :use-module (util options)
-  :use-module (output ical)
-  :use-module (ice-9 getopt-long)
-  :use-module (datetime)
-  )
-
-(define opt-spec
-  '((from (value #t) (single-char #\F))
-    (to (value #t) (single-char #\T)
-        (description "Returns all elements between these two dates."))
-    (help (single-char #\h)
-          (description "Print this help."))))
-
-(define (main args)
-  (define opts (getopt-long args (getopt-opt opt-spec)))
-
-  (define start (cond [(option-ref opts 'from #f) => parse-freeform-date]
-                      [else (start-of-month (current-date))]))
-  (define end   (cond [(option-ref opts 'to  #f) => parse-freeform-date]
-                      ;; [else (normalize-date* (set (month start) = (+ 1)))]
-                      [(date+ start (date month: 1))]
-                      ))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help opt-spec)
-    (throw 'return))
-
-  (print-events-in-interval start end))
diff --git a/module/entry-points/import.scm b/module/entry-points/import.scm
deleted file mode 100644
index 956ccc91..00000000
--- a/module/entry-points/import.scm
+++ /dev/null
@@ -1,61 +0,0 @@
-(define-module (entry-points import)
-  :export (main)
-  :use-module (util)
-  :use-module (util options)
-  :use-module (ice-9 getopt-long)
-  :use-module (ice-9 rdelim)
-  :use-module (srfi srfi-1)
-  :use-module (output vdir)
-  :use-module (vcomponent)
-  :autoload (vcomponent instance) (global-event-object)
-  )
-
-(define options
-  '((calendar (value #t) (single-char #\c)
-              (description "Name of calendar to import into"))
-    (file (value #t) (single-char #\f)
-          (description "ics file to import"))
-    (help (single-char #\h)
-          (description "Print this help."))))
-
-(define (main args)
-  (define opts (getopt-long args (getopt-opt options)))
-
-  (define cal-name (option-ref opts 'calendar #f))
-  (define fname (option-ref opts 'file "/dev/stdin"))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help options)
-    (throw 'return))
-
-  (let* ((calendars (get-calendars global-event-object))
-         (calendar
-          (and cal-name
-               (find (lambda (c) (string=? cal-name (prop c 'NAME)))
-                     (get-calendars global-event-object)))))
-
-    (unless calendar
-      (format (current-error-port) "No calendar named ~s~%" cal-name)
-      (throw 'return))
-
-    (let ((new-events (parse-cal-path fname)))
-
-      (format #t "About to the following ~a events into ~a~%~{~a~^~%~}~%"
-              (length (children new-events))
-              (prop calendar 'NAME)
-              (map (extract 'SUMMARY) (children new-events)))
-
-      (format #t "Continue? [Y/n] ")
-
-      (let loop ((c #\space))
-        (case c
-          [(#\n #\N) (throw 'return)]
-          [(#\y #\Y) (map (lambda (e)
-                            (add-event calendar e)
-                            (save-event e))
-                          (children new-events))]
-          [else
-           (let ((line (read-line)))
-             (loop (if (string-null? line)
-                       #\Y (string-ref line 0))))]))
-      )))
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
deleted file mode 100644
index dfa94cc7..00000000
--- a/module/entry-points/server.scm
+++ /dev/null
@@ -1,66 +0,0 @@
-(define-module (entry-points server)
-  :use-module (util)
-  :use-module (util options)
-  :use-module (util exceptions)
-
-  :use-module (srfi srfi-1)
-
-  :use-module (ice-9 getopt-long)
-  ;; :use-module (ice-9 regex) #| regex here due to bad macros |#
-
-  :use-module ((server server) :select (start-server))
-
-  :export (main))
-
-
-(define options
-  '((port (value #t) (single-char #\p)
-          (description "Bind to TCP port, defaults to " (i 8080) "."))
-    (addr (value #t)
-          (description "Address to use, defaults to " (i "0.0.0.0")
-                       " for IPv4, and " (i "::") " for IPv6.")
-          )
-    ;; numbers as single-char doesn't work.
-    (six (description "Use IPv6."))
-    (four (description "Use IPv4."))
-    (help (single-char #\h)
-          (description "Print this help."))))
-
-
-(define-public (main args)
-
-  (define opts (getopt-long args (getopt-opt options)))
-  (define port (string->number (option-ref opts 'port "8080")))
-  (define addr (option-ref opts 'addr #f))
-  (define family
-    (cond [(option-ref opts 'six  #f) AF_INET6]
-          [(option-ref opts 'four #f) AF_INET]
-          [(and addr (string-contains addr ":")) AF_INET6]
-          [(and addr (string-contains addr ".")) AF_INET]
-          [else AF_INET6]))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help options)
-    (throw 'return))
-
-  ;; update address if it was left blank. A bit clumsy since
-  ;; @var{addr} & @var{family} depend on each other.
-  ;; placed after load-calendars to keep Guile 2.2 compability.
-  (set! addr
-    (if addr addr
-        (if (eqv? family AF_INET6)
-            "::" "0.0.0.0")))
-
-
-  (format #t "Starting server on ~a:~a~%I'm ~a, runing from ~a~%"
-          addr port
-          (getpid) (getcwd))
-
-  (catch 'system-error
-    (lambda ()
-      (start-server `(family: ,family port: ,port host: ,addr)))
-
-    ;; probably address already in use
-    (lambda (err proc fmt args errno)
-      (format (current-error-port) "~a: ~?~%"
-              proc fmt args))))
diff --git a/module/entry-points/terminal.scm b/module/entry-points/terminal.scm
deleted file mode 100644
index d44fb1e8..00000000
--- a/module/entry-points/terminal.scm
+++ /dev/null
@@ -1,28 +0,0 @@
-(define-module (entry-points terminal)
-  :export (main)
-  :use-module (output terminal)
-  :use-module (vcomponent)
-  :use-module (ice-9 getopt-long)
-  :use-module (datetime)
-  :use-module (vulgar)
-  :use-module (util options)
-  )
-
-(define options
-  '((date (value #t) (single-char #\d)
-          (description "Which date to start on."))
-    (help (single-char #\t) (description "Print this help."))
-    ))
-
-(define (main args)
-  (define opts (getopt-long args (getopt-opt options)))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help options)
-    (throw 'return))
-
-  (let ((date (or (and=> (option-ref opts 'date #f) parse-freeform-date)
-                  (current-date))))
-    (with-vulgar
-     (lambda () (main-loop date))))
-)
diff --git a/module/entry-points/text.scm b/module/entry-points/text.scm
deleted file mode 100644
index d6ebd72e..00000000
--- a/module/entry-points/text.scm
+++ /dev/null
@@ -1,29 +0,0 @@
-(define-module (entry-points text)
-  :export (main)
-  :use-module (text flow)
-  :use-module (ice-9 getopt-long)
-  :use-module (util io)
-  :use-module (util options)
-  )
-
-
-(define options
-  '((width (value #t) (single-char #\w)
-           (description "Width of written text, defaults to 70 chars."))
-    (file (value #t) (single-char #\f)
-          (description "Read from " (i "file") " instead of standard input."))
-    (help (single-char #\h)
-          (description "Prints this help."))))
-
-(define (main args)
-  (define opts (getopt-long args (getopt-opt options)))
-
-  (when (option-ref opts 'help #f)
-    (print-arg-help options)
-    (throw 'return))
-
-  (for-each (lambda (l) (display l) (newline))
-            (flow-text
-             (with-input-from-port (open-input-port (option-ref opts 'file "-"))
-               (@ (ice-9 rdelim) read-string))
-             #:width (or (string->number (option-ref opts 'width "")) 70))))