From 94f1d4c4fef71b5012eefcce57e5ca781134ab92 Mon Sep 17 00:00:00 2001 From: Sacha Chua Date: Fri, 30 Sep 2022 12:10:19 -0400 Subject: More tweaks --- emacsconf.el | 215 ++++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 191 insertions(+), 24 deletions(-) (limited to 'emacsconf.el') diff --git a/emacsconf.el b/emacsconf.el index 9411adf..891b7eb 100644 --- a/emacsconf.el +++ b/emacsconf.el @@ -195,6 +195,13 @@ ;; TODO ) +(defun emacsconf-get-talk-categories (o) + (org-narrow-to-subtree) + (let (list) + (while (re-search-forward "Category[^ \t\n]+" nil t) + (setq list (cons (match-string-no-properties 0) list))) + (plist-put o :categories (reverse list)))) + (defun emacsconf-get-talk-info-from-properties (o) (let ((heading (org-heading-components)) (field-props '((:title "ITEM") @@ -207,7 +214,6 @@ (:uuid "UUID") (:email "EMAIL") (:caption-note "CAPTION_NOTE") - (:duration "TIME") (:availability "AVAILABILITY") (:q-and-a "Q_AND_A") (:bbb-room "ROOM") @@ -224,9 +230,11 @@ (:pronouns "PRONOUNS") (:public-email "PUBLIC_EMAIL") (:buffer "BUFFER") + (:duration "TIME") (:time "TIME") (:min-time "MIN_TIME") (:max-time "MAX_TIME") + (:fixed-time "FIXED_TIME") (:present "PRESENT") (:speakers "NAME") (:speakers-short "NAME_SHORT") @@ -239,6 +247,7 @@ 'append o (list + :point (point) :year emacsconf-year :type (if (org-entry-get (point) "SLUG") 'talk 'headline) :status (elt heading 2) @@ -266,14 +275,43 @@ field-props)))) (defvar emacsconf-abstract-heading-regexp "abstract" "Regexp matching heading for talk abstract.") + +(defun emacsconf-get-subtree-entry (heading-regexp) + (car + (delq nil + (org-map-entries + (lambda () + (when (string-match heading-regexp (org-entry-get (point) "ITEM")) + (org-get-entry))) + nil 'tree)))) + (defun emacsconf-get-talk-abstract-from-subtree (o) "Add the abstract from a subheading with a title matching Abstract." - (org-map-entries - (lambda () - (when (string-match "abstract" (org-entry-get (point) "ITEM")) - (plist-put o :abstract (org-get-entry)))) - nil 'tree) - o) + (plist-put o :abstract (substring-no-properties (or (emacsconf-get-subtree-entry "abstract") "")))) + + +(defun emacsconf-get-talk-comments-from-subtree (o) + (setq o (plist-put o :comments + (apply 'append + (org-map-entries + (lambda () + (org-end-of-meta-data) + (mapcar (lambda (item) + (string-trim + (replace-regexp-in-string + " *\n *" + " " + (buffer-substring-no-properties (+ (car item) (length (elt item 2))) + (min (point-max) (elt item 6)))))) + (org-element-property :structure (org-element-at-point))) + ) + "ITEM={comments}" 'tree)))) + (plist-put o :acceptance-comment + (car (delq nil (mapcar + (lambda (o) + (when (string-match "For the [^ ]+ speakers?: " o) + (replace-match "" t t o))) + (plist-get o :comments)))))) (defun emacsconf-convert-talk-abstract-to-markdown (o) (plist-put o :abstract-md (org-export-string-as (or (plist-get o :abstract) "") 'md t))) @@ -300,6 +338,7 @@ (defun emacsconf-get-abstract-from-wiki (o) (plist-put o :markdown (emacsconf-talk-markdown-from-wiki (plist-get o :slug)))) + (defun emacsconf-add-talk-status (o) (plist-put o :status-label (assoc-default (plist-get o :status) @@ -307,22 +346,48 @@ (defvar emacsconf-talk-info-functions '(emacsconf-get-talk-info-from-properties + emacsconf-get-talk-categories emacsconf-get-talk-abstract-from-subtree emacsconf-add-talk-status emacsconf-add-timezone-conversions)) +(defun emacsconf-search-talk-info (search &optional info) + (setq info (or info (emacsconf-get-talk-info))) + (or + (seq-find (lambda (o) (string= (plist-get o :slug) + (emacsconf-get-slug-from-string search))) + info) + (seq-find (lambda (o) + (string-match + search + (format "%s - %s - %s - %s" + (plist-get o :slug) + (plist-get o :title) + (plist-get o :speakers) + (plist-get o :email)))) + info))) + (defun emacsconf-get-talk-info-for-subtree () - (seq-reduce (lambda (prev val) (funcall val prev)) + (seq-reduce (lambda (prev val) (save-excursion (save-restriction (funcall val prev)))) emacsconf-talk-info-functions nil)) -(defun emacsconf-get-talk-info (&optional description-source) +(defun emacsconf-sort-by-scheduled (a b) + (let ((time-a (plist-get a :start-time)) + (time-b (plist-get b :start-time))) + (cond + ((time-less-p time-a time-b) t) + ((time-less-p time-b time-a) nil) + (t (< (plist-get a :point) (plist-get b :point)))))) + +(defun emacsconf-get-talk-info () (with-current-buffer (find-file-noselect emacsconf-org-file) (save-excursion - (let (talk results (status-types (emacsconf-status-types))) + (let (results) (org-map-entries (lambda () (when (or (org-entry-get (point) "TIME") + (org-entry-get (point) "SLUG") (org-entry-get (point) "INCLUDE_IN_INFO")) (setq results (cons (emacsconf-get-talk-info-for-subtree) @@ -408,12 +473,14 @@ (defun emacsconf-replace-plist-in-string (attrs string) "Replace ${keyword} from ATTRS in STRING." - (let ((a attrs)) + (let ((a attrs) name val) (while a - (setq string - (replace-regexp-in-string (regexp-quote (concat "${" (substring (symbol-name (pop a)) 1) "}")) - (or (pop a) "") - string t t))) + (setq name (pop a) val (pop a)) + (when (stringp val) + (setq string + (replace-regexp-in-string (regexp-quote (concat "${" (substring (symbol-name name) 1) "}")) + (or val "") + string t t)))) string)) (defun emacsconf-public-talks (info) @@ -450,6 +517,36 @@ (plist-put o :time (plist-get o :max-time))) o) +(defvar emacsconf-tweaked-allocations nil "Alist of slug . time") +(defun emacsconf-tweak-allocations (o) + (let ((talk-times emacsconf-tweaked-allocations)) + (when (assoc (plist-get o :slug) emacsconf-tweaked-allocations) + (plist-put o :time + (number-to-string + (assoc-default (plist-get o :slug) emacsconf-tweaked-allocations))))) + o) + + + +(defun emacsconf-schedule-based-on-info (info) + (let (current-time end-time duration) + (mapcar + (lambda (talk) + (when (plist-get talk :fixed-time) + (setq current-time (plist-get talk :start-time))) + (when (and (plist-get talk :time) + (not (string= (plist-get talk :status) "CANCELLED"))) + (setq duration (* (string-to-number (plist-get talk :time)) 60) + end-time (time-add current-time (seconds-to-time duration))) + (plist-put talk :scheduled + (format "<%s-%s>" (format-time-string "%Y-%m-%d %a %H:%M" current-time) + (format-time-string "%H:%M" end-time))) + (plist-put talk :start-time current-time) + (plist-put talk :end-time end-time) + (setq current-time (time-add end-time (* (string-to-number (or (plist-get talk :buffer) "0")) 60)))) + talk) + info))) + (defun emacsconf-update-schedules (&optional modify-func) "Schedule the talks based on TIME and BUFFER. Talks with a FIXED_TIME property are not moved." @@ -517,7 +614,7 @@ Talks with a FIXED_TIME property are not moved." (plist-get o :slug)) "------") (if (and (plist-get o :scheduled) - (not (plist-get o :fixed))) + (not (plist-get o :fixed-time))) (emacsconf-format-short-time (plist-get o :scheduled) t) "") (or (plist-get o :time) "") @@ -533,12 +630,12 @@ Talks with a FIXED_TIME property are not moved." "") (or (plist-get o :availability) ""))))) -(defun emacsconf-summarize-schedule () +(defun emacsconf-summarize-schedule (&optional info) (cons (if (eq emacsconf-focus 'time) (list "Slug" "Schedule" "Time" "Buffer" "Max" "Title" "Time" "Availability") (list "Status" "Slug" "Schedule" "Time" "Buffer" "Title" "Name" "Q&A" "Availability")) - (mapcar #'emacsconf-format-schedule-summary-row (emacsconf-get-talk-info)))) + (mapcar #'emacsconf-format-schedule-summary-row (or info (emacsconf-get-talk-info))))) ;;; Embark (defun emacsconf-embark-finder () @@ -546,6 +643,10 @@ Talks with a FIXED_TIME property are not moved." (org-entry-get-with-inheritance "SLUG")) (cons 'emacsconf (org-entry-get-with-inheritance "SLUG")))) +(defun emacsconf-insert-talk-title (search) + (interactive (list (emacsconf-complete-talk))) + (insert (plist-get (emacsconf-search-talk-info search) :title))) + (with-eval-after-load 'embark (add-to-list 'embark-target-finders 'emacsconf-embark-finder) (embark-define-keymap embark-emacsconf-actions @@ -558,6 +659,7 @@ Talks with a FIXED_TIME property are not moved." ("s" emacsconf-set-start-time-for-slug) ("W" emacsconf-browse-wiki-page) ("u" emacsconf-update-talk) + ("it" emacsconf-insert-talk-title) ("m" emacsconf-mail-speaker-from-slug) ("n" emacsconf-notmuch-search-mail-from-entry) ("f" org-forward-heading-same-level) @@ -610,8 +712,9 @@ Talks with a FIXED_TIME property are not moved." (goto-char (org-find-property "EMAIL_ID" id)) (list :subject (org-entry-get-with-inheritance "SUBJECT") :cc (org-entry-get-with-inheritance "CC") - :reply-to (org-entry-get-with-inheritance "REPLY_TO") - :mail-followup-to (org-entry-get-with-inheritance "MAIL_FOLLOWUP_TO") + :reply-to (or (org-entry-get-with-inheritance "REPLY_TO") (org-entry-get-with-inheritance "REPLY-TO")) + :mail-followup-to (or (org-entry-get-with-inheritance "MAIL_FOLLOWUP_TO") + (org-entry-get-with-inheritance "MAIL-FOLLOWUP-TO")) :body (replace-regexp-in-string "\n *," "\n" (buffer-substring-no-properties (progn (org-end-of-meta-data) (point)) (org-end-of-subtree)))))) @@ -652,6 +755,15 @@ Include some other things, too, such as emacsconf-year, title, name, email, url, (when note (insert "#+NOTE: " note "\n======== Delete above before sending =============\n\n")) (insert body)))) +(defun emacsconf-cancel-mail-merge () + (interactive) + (mapc (lambda (buffer) + (when (string-match "unsent" (buffer-name buffer)) + (let ((kill-buffer-query-functions nil) + (buffer-modified-p nil)) + (kill-buffer buffer)))) + (buffer-list))) + ;;; Status updates (defun emacsconf-status-update () @@ -669,7 +781,7 @@ Include some other things, too, such as emacsconf-year, title, name, email, url, (defun emacsconf-convert-from-timezone (timezone time) (interactive (list (completing-read "From zone: " tzc-time-zones) (read-string "Time: "))) - (let* ((from-offset (tzc--get-offset timezone)) + (let* ((from-offset (format-time-string "%z" (date-to-time emacsconf-date) timezone)) (time (date-to-time (concat emacsconf-date "T" (string-pad time 5 ?0 t) ":00.000" @@ -696,7 +808,7 @@ Include some other things, too, such as emacsconf-year, title, name, email, url, comments) (forward-line 1) (setq comments - (split-string +a (split-string (replace-regexp-in-string "\t\t\\*[ \t]*" "" @@ -726,18 +838,73 @@ Include some other things, too, such as emacsconf-year, title, name, email, url, (insert "- " o "\n"))) comments)))))))) +;;; Validation + (defun emacsconf-validate-all-talks-have-comments-for-speakers () (interactive) (emacsconf-for-each-talk (unless (re-search-forward "^\\(- \\)?For \\(the \\)?[^ ]+ speaker" (save-excursion (org-end-of-subtree) (point)) t) (error "Could not find comment for %s" (org-entry-get (point) "SLUG")))) - t) + nil) (defun emacsconf-validate-all-talks-have-field (field) (emacsconf-for-each-talk (when (string= (or (org-entry-get (point) field) "") "") (error "%s is missing %s" (org-entry-get (point) "SLUG") field))) - t) + 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)))) + (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))))) + +(defun emacsconf-get-time-constraint (o) + (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") + ("saturday lunch" "11:30" "13:30") + ("saturday closing remarks" "16:30" "17:30") + ("sunday morning break" "10:00" "11:30") + ("sunday lunch" "11:30" "13:30") + ("sunday closing remarks" "16:30" "17:30"))) + +(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 -- cgit v1.2.3