diff options
Diffstat (limited to 'module/entry-points')
-rw-r--r-- | module/entry-points/benchmark.scm | 33 | ||||
-rw-r--r-- | module/entry-points/html.scm | 150 | ||||
-rw-r--r-- | module/entry-points/ical.scm | 31 | ||||
-rw-r--r-- | module/entry-points/import.scm | 61 | ||||
-rw-r--r-- | module/entry-points/server.scm | 66 | ||||
-rw-r--r-- | module/entry-points/terminal.scm | 28 | ||||
-rw-r--r-- | module/entry-points/text.scm | 29 |
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)))) |