diff options
| -rw-r--r-- | emacsconf-publish.el | 5 | ||||
| -rw-r--r-- | emacsconf-schedule.el | 145 | ||||
| -rw-r--r-- | emacsconf.el | 48 |
3 files changed, 108 insertions, 90 deletions
diff --git a/emacsconf-publish.el b/emacsconf-publish.el index c1b3b55..286b1ff 100644 --- a/emacsconf-publish.el +++ b/emacsconf-publish.el @@ -214,11 +214,6 @@ ${chapter-list} ""))) "<div class=\"files resources\"><ul>${video-download}${other-files}${toobnix-info}</ul></div>")))) -(condition-case nil - (when (featurep 'memoize) - (memoize #'compile-media-get-file-duration-ms)) - nil) - (defun emacsconf-format-public-email (o &optional email) (format "[%s](mailto:%s?subject=%s)" (or email (plist-get o :public-email)) diff --git a/emacsconf-schedule.el b/emacsconf-schedule.el index 23bdc86..c1534fa 100644 --- a/emacsconf-schedule.el +++ b/emacsconf-schedule.el @@ -110,8 +110,8 @@ Each function should take the info and manipulate it as needed, returning the ne info)) (defun emacsconf-schedule-validate-and-summarize (schedule) - (let ((validation-results (emacsconf-validate-time-constraints schedule)) - (sched (emacsconf-summarize-schedule schedule))) + (let ((validation-results (emacsconf-schedule-validate-time-constraints schedule)) + (sched (emacsconf-schedule-summarize schedule))) (append (list (list (format "%d talks" (length (emacsconf-filter-talks arranged))))) (mapcar (lambda (o) (list nil nil nil nil nil o)) validation-results) @@ -239,10 +239,7 @@ Each function should take the info and manipulate it as needed, returning the ne (emacsconf-filter-talks info))))) - - - -(defun emacsconf-summarize-track-as-svg (svg base-x base-y width height start-time end-time info &optional vertical) +(defun emacsconf-schedule-svg-track (svg base-x base-y width height start-time end-time info &optional vertical) (let ((scale (/ (if vertical height width) (float-time (time-subtract end-time start-time))))) (mapc @@ -259,12 +256,18 @@ Each function should take the info and manipulate it as needed, returning the ne (title . ,(plist-get o :title))) (dom-node 'rect - `((x . ,x) - (y . ,y) + `((x . ,x) + (y . ,y) (width . ,(if vertical width size)) (height . ,(1- (if vertical size height))) (stroke . "black") - (fill . ,(if (plist-get o :invalid) "red" "gray")))) + (fill . ,(cond + ((string-match "BREAK\\|LUNCH" (plist-get o :title)) nil) + ((plist-get o :invalid) "red") + ((string-match "EST" + (or (plist-get o :availability) "")) + "lightgray") + (t "lightgreen"))))) (dom-node 'g `((transform . ,(format "translate(%d,%d)" @@ -277,51 +280,64 @@ Each function should take the info and manipulate it as needed, returning the ne (font-size . 10) (transform . "rotate(-90)")) (svg--encode-text (or (plist-get o :slug) (plist-get o :title))))))))) - (emacsconf-filter-talks info)))) - -(defun emacsconf-summarize-schedule-as-svg (width height start end tracks &optional vertical) - (let* ((svg (svg-create width height :background "white")) - (track-width (if vertical (/ width (length tracks)) width)) - (grid-margin 10) - (track-height (if vertical height (/ (- height grid-margin) (length tracks)))) - (x 0) (y 0) - (scale (/ (if vertical height width) - (float-time (time-subtract end start)))) + info))) + +(defun emacsconf-schedule-svg-day (elem label width height start end tracks) + (let* ((label-margin 15) + (track-height (/ (- height (* 2 label-margin)) (length tracks))) + (x 0) (y label-margin) + (scale (/ width (float-time (time-subtract end start)))) (time start)) - (svg-rectangle svg 0 0 width height :fill "white") + (svg-rectangle elem 0 0 width height :fill "white") + (svg-text elem label :x 3 :y (- label-margin 3) :fill "black" :font-size "10") + (mapc (lambda (track) + (emacsconf-schedule-svg-track + elem x y width track-height + start end track) + (setq y (+ y track-height))) + tracks) ;; draw grid (while (time-less-p time end) (let ((x (* (float-time (time-subtract time start)) scale))) (dom-append-child - svg + elem (dom-node 'g - `((transform . ,(format "translate(%d,0)" x))) + `((transform . ,(format "translate(%d,%d)" x label-margin))) (dom-node 'line - `((stroke . "gray") + `((stroke . "lightgray") (x1 . 0) (y1 . 0) (x2 . 0) - (y2 . ,(- height grid-margin)))) + (y2 . ,(- height label-margin label-margin)))) (dom-node 'text - `((fill . "gray") + `((fill . "darkgray") (x . 0) - (y . ,(- height 2)) - (font-size . 5)) + (y . ,(- height 2 label-margin)) + (font-size . 10) + (text-anchor . "middle")) (svg--encode-text (format-time-string "%-l" time))))) - (setq time (time-add time (seconds-to-time 3600)))) - - ) - (mapc (lambda (track) - (emacsconf-summarize-track-as-svg - svg x y track-width track-height - start end track vertical) - (if vertical - (setq x (+ x track-width)) - (setq y (+ y track-height)))) - tracks) + (setq time (time-add time (seconds-to-time 3600))))) + elem)) + +(defun emacsconf-schedule-svg (width height days) + (let ((svg (svg-create width height :background "white")) + (day-height (/ height (length days))) + (y 0)) + (mapc + (lambda (day) + (let ((group (dom-node 'g `((transform . ,(format "translate(0,%d)" y)))))) + (dom-append-child svg group) + (emacsconf-schedule-svg-day group + (plist-get day :label) + width day-height + (date-to-time (plist-get day :start)) + (date-to-time (plist-get day :end)) + (plist-get day :tracks))) + (setq y (+ y day-height))) + days) svg)) (defun emacsconf-schedule-get-subsequence (info start &optional end) @@ -425,5 +441,58 @@ Talks with a FIXED_TIME property are not moved." (setq end-time (time-add (org-get-scheduled-time (point)) (seconds-to-time duration))) (setq current-time (time-add end-time (* (string-to-number (or (plist-get talk :buffer) "0")) 60)))))))))))) +(defun emacsconf-schedule-validate-time-constraints (&optional info) + (interactive) + (let* ((info (or info (emacsconf-get-talk-info))) + (results (delq nil + (append + (mapcar + (lambda (o) + (apply #'emacsconf-schedule-check-time + (car o) + (emacsconf-search-talk-info (car o) info) + (cdr o))) + emacsconf-time-constraints) + (mapcar + (lambda (o) + (let (result + (constraint (emacsconf-schedule-get-time-constraint o))) + (when constraint + (setq result (apply #'emacsconf-schedule-check-time + (plist-get o :slug) + o + constraint)) + (when result (plist-put o :invalid result)) + result))) + info))))) + (if (called-interactively-p 'any) + (message "%s" (string-join results "\n")) + results))) + +(defun emacsconf-schedule-check-time (label o &optional from-time to-time) + "FROM-TIME and TO-TIME should be strings like HH:MM in EST. +Both start and end time are tested." + (let* ((start-time (format-time-string "%H:%M" (plist-get o :start-time))) + (end-time (format-time-string "%H:%M" (plist-get o :end-time))) + result) + (setq result + (or + (and (null o) (format "%s: Not found" label)) + (and from-time (string< start-time from-time) + (format "%s: Starts at %s before %s" label start-time from-time)) + (and to-time (string< to-time end-time) + (format "%s: Ends at %s after %s" label end-time to-time)))) + (when result (plist-put o :invalid result)) + result)) + +(defun emacsconf-schedule-get-time-constraint (o) + (unless (string-match "after the event" (or (plist-get o :q-and-a) "")) + (let ((avail (or (plist-get o :availability) "")) + hours) + (when (string-match "\\([<>]\\)=? *\\([0-9]+:[0-9]+\\) *EST" avail) + (if (string= (match-string 1 avail) ">") + (list (match-string 2 avail) nil) + (list nil (match-string 2 avail))))))) + (provide 'emacsconf-schedule) ;;; emacsconf-schedule.el ends here diff --git a/emacsconf.el b/emacsconf.el index 9628872..1844713 100644 --- a/emacsconf.el +++ b/emacsconf.el @@ -718,30 +718,7 @@ Include some other things, too, such as emacsconf-year, title, name, email, url, (error "%s is missing %s" (org-entry-get (point) "SLUG") field))) nil) -(defun emacsconf-check-time (label o &optional from-time to-time) - "FROM-TIME and TO-TIME should be strings like HH:MM in EST. -Both start and end time are tested." - (let* ((start-time (format-time-string "%H:%M" (plist-get o :start-time))) - (end-time (format-time-string "%H:%M" (plist-get o :end-time))) - result) - (setq result - (or - (and (null o) (format "%s: Not found" label)) - (and from-time (string< start-time from-time) - (format "%s: Starts at %s before %s" label start-time from-time)) - (and to-time (string< to-time end-time) - (format "%s: Ends at %s after %s" label end-time to-time)))) - (when result (plist-put o :invalid result)) - result)) -(defun emacsconf-get-time-constraint (o) - (unless (string-match "after the event" (or (plist-get o :q-and-a) "")) - (let ((avail (or (plist-get o :availability) "")) - hours) - (when (string-match "\\([<>]\\)=? *\\([0-9]+:[0-9]+\\) *EST" avail) - (if (string= (match-string 1 avail) ">") - (list (match-string 2 avail) nil) - (list nil (match-string 2 avail))))))) (defvar emacsconf-time-constraints '(("saturday morning break" "10:00" "11:30") @@ -765,30 +742,7 @@ Both start and end time are tested." (format-time-string "%H:%M" (plist-get (cadr info) :start-time))))) (setq info (cdr info)))) -(defun emacsconf-validate-time-constraints (&optional info) - (interactive) - (let* ((info (or info (emacsconf-get-talk-info))) - (results (delq nil - (append - (mapcar - (lambda (o) - (apply #'emacsconf-check-time - (car o) - (emacsconf-search-talk-info (car o) info) - (cdr o))) - emacsconf-time-constraints) - (mapcar - (lambda (o) - (let ((constraint (emacsconf-get-time-constraint o))) - (when constraint - (apply #'emacsconf-check-time - (plist-get o :slug) - o - constraint)))) - info))))) - (if (called-interactively-p 'any) - (message "%s" (string-join results "\n")) - results))) + (provide 'emacsconf) ;;; emacsconf.el ends here |