From 989171268461a0069ecd53a49e6098ce08638102 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 5 May 2023 09:58:21 -0500 Subject: changes --- lisp/acdw-mail.el | 87 ++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 76 insertions(+), 11 deletions(-) (limited to 'lisp/acdw-mail.el') diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index f8111e7..bf20c9b 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el @@ -146,7 +146,7 @@ the saved search as well." (notmuch-poll))) (lambda (_) (message "Polling mail (async)...done")))) - ;;(user-error "Feature `async' not found!") + (user-error "Feature `async' not found!") (notmuch-poll))) ;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/ @@ -172,28 +172,93 @@ the saved search as well." (error "No attachment. Aborting send.")))) ;;; Process ical attachments +;; https://www.reddit.com/r/emacs/comments/8s1ion/comment/e0x5kgd/ + +(defun ical2org (&optional replace output-buffer) + "Run ical2org on contents of this buffer. +If REPLACE (interactive prefix argument), replace contents of the +buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to +minibuffer." + (interactive "P") + (shell-command-on-region (point-min) (point-max) + "ical2org.awk" + output-buffer + replace + "*ical2org errors*" + 'display-errors)) + +(defun ical2org-capture () + "Run `ical2org' on this buffer, then `org-capture' the result. +Leaves current buffer as-was afterwards." + (interactive) + (let ((buf (current-buffer)) + (ics (buffer-string))) + (ical2org 'replace buf) + (mark-whole-buffer) + (org-capture nil "a") + (mark-whole-buffer) + (delete-region (point-min) (point-max)) + (insert ics))) + +(defun notmuch-ics-refile (filename header) + "Refile the current ICS buffer to FILENAME, under HEADER." + (org-refile nil nil + (list header + filename + nil + (with-current-buffer (find-file-noselect filename) + (org-find-exact-headline-in-buffer header)))) + (notmuch-ics-kill)) + +(defun notmuch-ics-kill () + "Kill the current ICS buffer and delete its file." + (let ((kill-buffer-hook nil) + (kill-buffer-query-functions nil) + (file (buffer-file-name))) + (set-buffer-modified-p nil) + (kill-buffer-and-window) + (delete-file file))) + +(defun notmuch-ics-cancel () + "Cancel saving ICS buffer." + (interactive) + (notmuch-ics-kill)) + +(define-derived-mode notmuch-save-ics-mode org-mode + "Org-mode but with a different keymap.") (defun notmuch-save-ics () + ;; XXX: this is hacky as hell "Save a .ics file in a message." (interactive) (with-current-notmuch-show-message (notmuch-foreach-mime-part (lambda (part) - (message "%S" part) (when (and (listp part) (or (equal "application/ics" (caadr part)) ;; (equal "text/calendar" (caadr part)) )) - (save-window-excursion - (let* ((filename "/tmp/notmuch.ics") - (buf (find-file-noselect filename))) - (delete-file filename) - (kill-buffer (get-file-buffer filename)) - (mm-save-part-to-file part filename) - (icalendar-import-file filename diary-file) - (kill-buffer buf))))) + (let* ((filename (format "/dev/shm/notmuch-%s.ics" + (time-convert (current-time) 'integer)))) + (mm-save-part-to-file part filename) + (message "Converting ICS to org ...") + (with-current-buffer (find-file-other-window filename) + (ical2org 'replace (current-buffer)) + (deactivate-mark) + (let ((org-mode-hook nil)) + (notmuch-save-ics-mode)) + (local-set-key (kbd "C-c C-c") + (lambda () (interactive) + (notmuch-ics-refile (sync/ "org/diary.org") "Appointments"))) + (local-set-key (kbd "C-c C-k") #'notmuch-ics-cancel) + (setq-local header-line-format + (concat "ICAL buffer. " + "Finish: `C-c C-c'. " + "Abort: `C-c C-k'.")))))) (mm-dissect-buffer t t)))) +(add-hook 'notmuch-show-hook #'notmuch-save-ics) + ;;; Fixes @@ -338,7 +403,7 @@ the saved search as well." (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async) - (notmuch-async-poll)) + (call-process "swaymail")) (define-advice notmuch-address-selection-function (:override (prompt collection _) no-initial-input) -- cgit 1.4.1-21-gabe81