diff options
| -rw-r--r-- | emacsconf-mail.el | 14 | ||||
| -rw-r--r-- | emacsconf-pad.el | 2 | ||||
| -rw-r--r-- | emacsconf-schedule.el | 107 | ||||
| -rw-r--r-- | emacsconf-stream.el | 23 | ||||
| -rw-r--r-- | emacsconf.el | 59 |
5 files changed, 148 insertions, 57 deletions
diff --git a/emacsconf-mail.el b/emacsconf-mail.el index c31e049..5b93acd 100644 --- a/emacsconf-mail.el +++ b/emacsconf-mail.el @@ -81,8 +81,9 @@ (mail-func (plist-get template :function))) (funcall mail-func (emacsconf-mail-complete-email-group) template))) -(defun emacsconf-mail-template-to-all () - "Uses the current template to draft messages to all the speakers." +(defun emacsconf-mail-template-to-all-groups () + "Uses the current template to draft messages to all the speakers. +Group by e-mail." (interactive) (let* ((template (if (org-entry-get (point) "EMAIL_ID") (emacsconf-mail-merge-get-template-from-subtree) @@ -93,13 +94,20 @@ (member (plist-get o :slug) (split-string (plist-get template :slugs) " ")) t)) - (emacsconf-filter-talks (emacsconf-get-talk-info)))) + (emacsconf-prepare-for-display (emacsconf-filter-talks (emacsconf-get-talk-info))))) (grouped (emacsconf-mail-group-by-email info)) (mail-func (plist-get template :function))) (mapc (lambda (group) (funcall mail-func group template)) grouped))) +(defun emacsconf-mail-log-message-when-sent (o message) + (add-hook 'message-sent-hook + `(lambda () + (save-window-excursion + (emacsconf-add-to-talk-logbook ,(plist-get o :slug) ,message))) + nil t)) + (defun emacsconf-mail-group-by-email (info) (seq-group-by (lambda (o) (plist-get o :email)) info)) diff --git a/emacsconf-pad.el b/emacsconf-pad.el index c68088d..5af8ba3 100644 --- a/emacsconf-pad.el +++ b/emacsconf-pad.el @@ -461,7 +461,7 @@ ${next-talk-list} (lambda (o) (emacsconf-replace-plist-in-string (append (list :full-url (concat emacsconf-base-url (plist-get o :url))) o) - "<li>${slug} - ${track}: ${title} (${speakers-with-pronouns}, Q&A: ${q-and-a})<ul><li>${full-url}</li><li>Intro: </li></ul></li>")) + "<li>${slug} - ${track}: ${title} (${speakers-with-pronouns}, Q&A: ${q-and-a})<ul><li>${full-url}</li><li>Intro: ${intro-note}</li></ul></li>")) (emacsconf-prepare-for-display (emacsconf-get-talk-info))) "</ul>"))) (provide 'emacsconf-pad) diff --git a/emacsconf-schedule.el b/emacsconf-schedule.el index 532eaab..27070db 100644 --- a/emacsconf-schedule.el +++ b/emacsconf-schedule.el @@ -24,7 +24,9 @@ ;;; Code: -(defvar emacsconf-schedule-strategies nil "List of scheduling functions. +(defvar emacsconf-schedule-strategies + '(emacsconf-schedule-allocate-video-time-rounded-to-five) + "List of scheduling functions. Each function should take the info and manipulate it as needed, returning the new info.") (defvar emacsconf-schedule-max-time 30) @@ -111,8 +113,8 @@ Each function should take the info and manipulate it as needed, returning the ne (plist-get o :title))))) info)) -(defun emacsconf-schedule-validate-and-summarize (schedule) - (let ((validation-results (emacsconf-schedule-validate-time-constraints schedule)) +(defun emacsconf-schedule-validate-and-summarize (schedule &optional info) + (let ((validation-results (emacsconf-schedule-validate-time-constraints schedule info)) (sched (emacsconf-schedule-summarize schedule))) (append (list (list (format "%d talks" (length (emacsconf-filter-talks arranged))))) @@ -317,14 +319,14 @@ Each function should take the info and manipulate it as needed, returning the ne `((transform . ,(format "translate(%d,%d)" x label-margin))) (dom-node 'line - `((stroke . "lightgray") + `((stroke . "darkgray") (x1 . 0) (y1 . 0) (x2 . 0) (y2 . ,(- height label-margin label-margin)))) (dom-node 'text - `((fill . "darkgray") + `((fill . "black") (x . 0) (y . ,(- height 2 label-margin)) (font-size . 10) @@ -364,20 +366,21 @@ Each function should take the info and manipulate it as needed, returning the ne :tracks (emacsconf-by-track (cdr o))))) days)))) -(defun emacsconf-schedule-svg-color-by-status (o node &optional parent) - (dom-set-attribute node 'fill - (pcase (plist-get o :status) - ((rx (or "TO_PROCESS" - "PROCESSING" - "TO_AUTOCAP")) - "palegoldenrod") - ((rx (or "TO_ASSIGN")) - "yellow") - ((rx (or "TO_CAPTION")) - "lightgreen") - ((rx (or "TO_STREAM")) - "green") - (t "gray")))) +(defun emacsconf-schedule-svg-color-by-status (o node &optional _) + (unless (plist-get o :invalid) + (dom-set-attribute node 'fill + (pcase (plist-get o :status) + ((rx (or "TO_PROCESS" + "PROCESSING" + "TO_AUTOCAP")) + "palegoldenrod") + ((rx (or "TO_ASSIGN")) + "yellow") + ((rx (or "TO_CAPTION")) + "lightgreen") + ((rx (or "TO_STREAM")) + "green") + (t "gray"))))) (defun emacsconf-schedule-svg-days (width height days) (let ((svg (svg-create width height :background "white")) @@ -455,6 +458,20 @@ Each function should take the info and manipulate it as needed, returning the ne o) info)) +(defun emacsconf-schedule-round-up-to (x y) + "Return X rounded up to the nearest Y." + (+ x (% (- y (% x y)) y))) +;; (assert (= (emacsconf-schedule-round-up-to 13 5) 15)) +;; (assert (= (emacsconf-schedule-round-up-to 15 5) 15)) +;; (assert (= (emacsconf-schedule-round-up-to 16 5) 20)) + +(defun emacsconf-schedule-allocate-video-time-round-up-to-five (info) + (mapcar (lambda (o) ; 1 + 4, 2 + 3, 3 + 2, 4 + 1, 0 + 0, 5 + 0 + (when (plist-get o :video-time) + (plist-put o :time (number-to-string (emacsconf-schedule-round-up-to (string-to-number (plist-get o :video-time)) 5)))) + o) + info)) + (defun emacsconf-schedule-allocate-max-time (info) (mapcar (lambda (o) (when (plist-get o :max-time) @@ -569,26 +586,37 @@ Both start and end time are tested." (list (match-string 2 avail) nil) (list nil (match-string 2 avail))))))) -(defun emacsconf-schedule-validate (sched) +(defun emacsconf-schedule-validate-all-talks-present (sched &optional list) + (let* ((sched-slugs (mapcar (lambda (o) (plist-get o :slug)) + (emacsconf-filter-talks sched))) + (diff (delq + nil + (seq-difference + (mapcar + (lambda (o) (plist-get o :slug)) + (seq-remove + (lambda (o) + (string= (plist-get o :status) "CANCELLED")) + (let ((emacsconf-talk-info-functions '(emacsconf-get-talk-info-from-properties))) + (or list (emacsconf-get-talk-info))))) + sched-slugs)))) + (when diff + (list (concat "Missing talks: " (string-join diff ", ")))))) + +(defun emacsconf-schedule-validate-no-duplicates (sched) (let* ((sched-slugs (mapcar (lambda (o) (plist-get o :slug)) (emacsconf-filter-talks sched))) - (diff (delq nil - (seq-difference - (mapcar (lambda (o) (plist-get o :slug)) - (seq-remove (lambda (o) - (string= (plist-get o :status) "CANCELLED")) - (let ((emacsconf-talk-info-functions '(emacsconf-get-talk-info-from-properties))) - (emacsconf-get-talk-info)))) - sched-slugs))) (dupes (seq-filter (lambda (o) (> (length (cdr o)) 1)) (seq-group-by #'identity sched-slugs)))) - (append - (emacsconf-schedule-validate-time-constraints sched) - (emacsconf-schedule-validate-live-q-and-a-sessions-are-staggered sched) - (when diff - (list (concat "Missing talks: " (string-join diff ", ")))) - (when dupes - (list (concat "Duplicate talks: " (mapconcat 'car dupes ", "))))))) + (when dupes + (list (concat "Duplicate talks: " (mapconcat 'car dupes ", ")))))) + +(defun emacsconf-schedule-validate (sched &optional info) + (append + (emacsconf-schedule-validate-time-constraints sched) + (emacsconf-schedule-validate-live-q-and-a-sessions-are-staggered sched) + (emacsconf-schedule-validate-all-talks-present sched info) + (emacsconf-schedule-validate-no-duplicates sched))) (defun emacsconf-schedule-inflate-tracks (tracks schedule) (mapcar @@ -607,13 +635,20 @@ Both start and end time are tested." day) tracks)) +(defvar emacsconf-schedule-expected-talks nil "If non-nil, a list of slugs to validate against.") (defmacro emacsconf-schedule-test (filename &rest varlist) + "Write the proposed schedule to FILENAME using the variables in VARLIST. +If emacsconf-schedule-apply is non-nil, update `emacsconf-org-file' and the wiki." (declare (debug t)) `(let* (,@varlist) (let* ((schedule (emacsconf-schedule-prepare arranged)) - (validation (or (emacsconf-schedule-validate schedule) ""))) + (info (if emacsconf-schedule-expected-talks + (emacsconf-schedule-inflate-sexp emacsconf-schedule-expected-talks) + (emacsconf-get-talk-info))) + (validation (or (emacsconf-schedule-validate schedule info) ""))) (with-temp-file ,filename (svg-print (emacsconf-schedule-svg 800 200 schedule))) + (clear-image-cache) (mapconcat (lambda (o) (format "- %s\n" o)) (append validation (list (format "[[file:%s]]" filename))))))) (defun emacsconf-schedule-format-summary-row (o) diff --git a/emacsconf-stream.el b/emacsconf-stream.el index 705d0da..e2b4962 100644 --- a/emacsconf-stream.el +++ b/emacsconf-stream.el @@ -183,12 +183,19 @@ Final files should be stored in /data/emacsconf/stream/YEAR/video-slug--main.web (defun emacsconf-stream-play-video (talk) (interactive (list (emacsconf-complete-talk-info))) (let ((info (tramp-dissect-file-name (emacsconf-stream-track-login talk)))) - (call-process "ssh" nil nil t - (concat (tramp-file-name-user info) - "@" (tramp-file-name-host info)) - "-p" (tramp-file-name-port info) - "nohup" "~/bin/track-mpv" (emacsconf-stream-get-filename talk) ">" "/dev/null" - "2>&1" "&"))) + (apply + #'call-process + (append + (list + "ssh" nil nil t + (concat (tramp-file-name-user info) + "@" (tramp-file-name-host info)) + "-p" (tramp-file-name-port info) + "nohup" "~/bin/track-mpv") + (or (and (plist-get talk :stream-files) + (split-string-and-unquote (plist-get talk :stream-files))) + (list (emacsconf-stream-get-filename talk))) + (list ">" "/dev/null" "2>&1" "&"))))) (defun emacsconf-stream-open-pad (talk) (interactive (list (emacsconf-complete-talk-info))) @@ -196,8 +203,8 @@ Final files should be stored in /data/emacsconf/stream/YEAR/video-slug--main.web (async-shell-command-buffer 'new-buffer)) (shell-command (concat "nohup firefox -new-window " - (shell-quote-argument (plist-get talk :pad-url)) - " > /dev/null 2>&1 & ")))) + (shell-quote-argument (plist-get talk :pad-url)) + " > /dev/null 2>&1 & ")))) (defun emacsconf-stream-join-qa (talk) "Join the Q&A for TALK. diff --git a/emacsconf.el b/emacsconf.el index f32c47c..cdf3865 100644 --- a/emacsconf.el +++ b/emacsconf.el @@ -79,6 +79,11 @@ :type 'file :group 'emacsconf) +(defcustom emacsconf-emergency-contact nil + "Emergency contact information." + :type 'string + :group 'emacsconf) + (defvar emacsconf-stream-base "https://live0.emacsconf.org/emacsconf/") (defvar emacsconf-chat-base "https://chat.emacsconf.org/") (defvar emacsconf-backstage-dir "/ssh:orga@media.emacsconf.org:/var/www/media.emacsconf.org/2022/backstage") @@ -330,7 +335,7 @@ ("TO_ARCHIVE" . "Q&A finished, IRC and pad will be archived on this page") ("TO_EXTRACT" . "Q&A to be extracted from the room recordings") ("DONE" . "All done") - ("CANCELLED" . "Talk cancelled"))) + ("CANCELLED" . "Sorry, this talk has been cancelled"))) (defun emacsconf-get-talk-categories (o) (org-narrow-to-subtree) @@ -375,6 +380,7 @@ (:video-time "VIDEO_TIME") (:video-file-size "VIDEO_FILE_SIZE") (:video-duration "VIDEO_DURATION") + (:stream-files "STREAM_FILES") (:youtube-url "YOUTUBE_URL") (:toobnix-url "TOOBNIX_URL") ;; Captioning @@ -532,6 +538,7 @@ emacsconf-get-talk-categories emacsconf-get-talk-abstract-from-subtree emacsconf-add-talk-status + emacsconf-add-checkin-time emacsconf-add-timezone-conversions emacsconf-add-speakers-with-pronouns emacsconf-add-live-info)) @@ -544,6 +551,26 @@ (t (format "%s (%s)" (plist-get o :speakers) (plist-get o :pronouns))))) o) +(defun emacsconf-add-checkin-time (o) + (unless (or (null (plist-get o :status)) + (null (plist-get o :email)) + (string= (plist-get o :status) "CANCELLED")) + (if (string= (plist-get o :status) "WAITING_FOR_PREREC") + (progn + (plist-put + o :checkin-label + "1 hour before the scheduled start of your talk, since you don't have a pre-recorded video") + (plist-put + o :checkin-time + (time-subtract (plist-get o :start-time) (seconds-to-time 3600)))) + (plist-put o :checkin-label + "30 minutes before the scheduled start of your Q&A, since you have a pre-recorded video") + (plist-put o :checkin-time + (time-subtract (time-add (plist-get o :start-time) + (seconds-to-time (* 60 (string-to-number (plist-get o :video-time))))) + (seconds-to-time (/ 3600 2)))))) + o) + (defun emacsconf-add-live-info (o) (let ((track (emacsconf-get-track (plist-get o :track)))) (when track @@ -1031,7 +1058,8 @@ Filter by TRACK if given. Use INFO as the list of talks." (let ((states '((open . "OPEN_Q UNSTREAMED_Q") (before . "TODO TO_REVIEW TO_ACCEPT WAITING_FOR_PREREC TO_PROCESS PROCESSING TO_AUTOCAP TO_ASSIGN TO_CAPTION TO_STREAM PLAYING CLOSED_Q") - (after . "TO_ARCHIVE TO_EXTRACT TO_FOLLOW_UP DONE")))) + (after . "TO_ARCHIVE TO_EXTRACT TO_FOLLOW_UP DONE") + (cancelled . "CANCELLED")))) (if (string-match "live" (or (plist-get talk :q-and-a) "")) (or (car (seq-find (lambda (state) (member (plist-get talk :status) (split-string (cdr state)))) @@ -1067,15 +1095,20 @@ Filter by TRACK if given. Use INFO as the list of talks." (org-map-entries (lambda () (org-entry-properties)) "volunteer+EMAIL={.}"))) +(defun emacsconf-volunteer-emails-for-completion (&optional info) + (mapcar (lambda (o) + (emacsconf-surround + (if (assoc-default "ITEM" o) + (concat (assoc-default "ITEM" o) " <") + "<") + (assoc-default "EMAIL" o) + ">" "")) + (or info (emacsconf-get-volunteer-info)))) + (defun emacsconf-complete-volunteer (&optional info) - (setq info (or info (emacsconf-get-volunteer-info))) + (setq info (or info (emacsconf-get-volunteer-info info))) (let* ((choices - (mapcar (lambda (o) - (string-join - (delq nil - (mapcar (lambda (f) (assoc-default f o 'string=)) '("ITEM" "EMAIL"))) - " - ")) - info)) + (emacsconf-volunteer-emails-for-completion)) (choice (completing-read "Volunteer: " (lambda (string predicate action) @@ -1084,6 +1117,14 @@ Filter by TRACK if given. Use INFO as the list of talks." (complete-with-action action choices string predicate)))))) (elt info (seq-position choices choice)))) +(defun emacsconf-email-volunteers (volunteers) + (interactive + (list + (completing-read-multiple + "Volunteers: " (emacsconf-volunteer-emails-for-completion)))) + (compose-mail (string-join volunteers ", "))) + +;;; Reflowing (defun emacsconf-reflow () "Help reflow text files." (interactive) |