diff options
Diffstat (limited to 'calp-gnome.scm')
-rw-r--r-- | calp-gnome.scm | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/calp-gnome.scm b/calp-gnome.scm new file mode 100644 index 00000000..cd10406b --- /dev/null +++ b/calp-gnome.scm @@ -0,0 +1,69 @@ +;;; Commentary: + +;; $ calp --repl /socket -- server +;; paste this when connected to the socket. + +;;; Code: + +(begin + + (use-modules + (calp util) + ((srfi srfi-1) :select (partition)) + (srfi srfi-41) + (vcomponent datetime) + (datetime) + ((calp html view calendar shared) + :select (fix-event-widths! x-pos width)) + ) + + (define events (get-event-set (@ (vcomponent instance) global-event-object))) + + (define evs (stream->list (events-between (current-date) (date+ (current-date) (date day: 1)) events))) + + (define-values (longevs shortevs) (partition long-event? evs)) + + (fix-event-widths! shortevs event-length-key: (lambda (e) (event-length/day (current-date) e))) + + + + (use-modules (gnome gtk) + (oop goops)) + + (define window (make <gtk-window> type: 'toplevel)) + + (define table (gtk-table-new 1 1 #f)) + + (add window table) + + (define aligns + (map (lambda (ev) + (define xalign (exact->inexact (x-pos ev))) + (define yalign (/ (time->decimal-hour (as-time (prop ev 'DTSTART))) 24)) + (define xscale (exact->inexact (/ (width ev) (- 1 (x-pos ev))))) + (define yscale (exact->inexact (/ (- 1 yalign) + (/ (datetime->decimal-hour (event-length ev)) 24)))) + (define align (gtk-alignment-new xalign yalign xscale yscale)) + ;; (define event-container (make <gtk-layout>)) + + ;; (put event-container + ;; (make <gtk-label> + ;; label: (prop ev 'SUMMARY) + ;; wrap: #t + ;; wrap-mode: 'word) + ;; 0 0) + (define event-container (make <gtk-frame> label: (prop ev 'SUMMARY))) + (add align event-container) + + align) + shortevs)) + + + (for align in aligns + (attach table align 0 1 0 1)) + + (show-all window) + + (define thr ((@ (ice-9 threads) begin-thread) (gtk-main)))) + + |