Move a bunch of files into calp module.

1 files changed, 0 insertions, 150 deletions

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")
-  )