pass certain mail requests in primary session over to gdbmacs

1 files changed, 50 insertions, 4 deletions

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 7d8742fe..9d262aae 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -2406,6 +2406,11 @@ Called by '~/src/dotfiles/bin/emacsclient --spw/update-environment'."
        nil))))
 (add-hook 'kill-emacs-hook #'spw/daemon-lock-self -99)
 
+(defun spw/may-pass-to-gdbmacs-p ()
+  (and (display-graphic-p)
+       (not (string= (daemonp) "gdbmacs"))
+       (spw/daemon-pid "gdbmacs")))
+
 ;; open a frame on a new workspace with only the relevant dired buffer open,
 ;; eval this form: (global-set-key "\C-cG" #'spw/grading-advance)
 ;; and then use C-c G to open the first item (will need C-c f t after just
@@ -2785,6 +2790,27 @@ mutt's review view, after exiting EDITOR."
 		  (message-fetch-field "to") (message-fetch-field "cc")))
     (message-remove-header "Cc")))
 
+(cl-macrolet
+    ((define-simple-pass-to-gdbmacs (cmd)
+       (let ((new (intern (concat "spw/" (symbol-name cmd)))))
+	 `(progn
+	    (defun ,new ()
+	      (interactive)
+	      (if (spw/may-pass-to-gdbmacs-p)
+		  (server-eval-at
+		   "gdbmacs"
+		   `(let ((display-buffer-overriding-action
+			   '(display-buffer-pop-up-frame
+			     (pop-up-frame-parameters
+			      (display . ,(frame-parameter nil 'display)))))
+			  (current-prefix-arg ',current-prefix-arg))
+		      (call-interactively #',',cmd)))
+		(call-interactively #',cmd)))
+	    (global-set-key [remap ,cmd] #',new)))))
+  (define-simple-pass-to-gdbmacs compose-mail)
+  (define-simple-pass-to-gdbmacs compose-mail-other-window)
+  (define-simple-pass-to-gdbmacs compose-mail-other-frame))
+
 (with-eval-after-load 'message
   (spw/when-library-available message-templ
     (define-key message-mode-map [f7] #'spw/unfinalise-message)
@@ -2926,6 +2952,25 @@ mutt's review view, after exiting EDITOR."
 (with-eval-after-load 'gnus
   (unless (gnus-getenv-nntpserver) (setq gnus-select-method '(nnnil ""))))
 
+(defmacro spw/defun-pass-to-gdbmacs (name arglist &rest body)
+  (declare (indent 2))
+  (let ((parsed-body (macroexp-parse-body body))
+	(arglist-names
+	 (cl-loop for entry in arglist
+		  if (eq entry '&rest) do (error "Not implemented")
+		  else unless (eq entry '&optional) collect entry)))
+    `(defun ,name ,arglist
+       ,@(car parsed-body)
+       (if (spw/may-pass-to-gdbmacs-p)
+	   ;; We'd like to just bind `display-buffer-overriding-action', but
+	   ;; Gnus doesn't respect that when it starts up.
+	   (server-eval-at
+	    "gdbmacs" `(with-selected-frame
+			   (make-frame
+			    '((display . ,(frame-parameter nil 'display))))
+			 ,(list ',name ,@arglist-names)))
+	 ,@(cdr parsed-body)))))
+
 (defvar gnus-always-read-dribble-file)
 
 (defun spw/gnus-startup-wrapper (orig-fun &rest args)
@@ -2941,7 +2986,7 @@ mutt's review view, after exiting EDITOR."
 (advice-add 'gnus :around #'spw/gnus-startup-wrapper)
 (advice-add 'gnus-no-server :around #'spw/gnus-startup-wrapper)
 
-(defun spw/gnus (&optional fetch-and-inbox)
+(spw/defun-pass-to-gdbmacs spw/gnus (&optional fetch-and-inbox)
   (interactive "P")
   (require 'gnus)
   (if (not fetch-and-inbox)
@@ -2971,19 +3016,20 @@ mutt's review view, after exiting EDITOR."
   (gnus-group-jump-to-group group)
   (call-interactively #'gnus-topic-select-group))
 
-(defun spw/gnus-goto-notes ()
+(spw/defun-pass-to-gdbmacs spw/gnus-goto-notes ()
   (interactive)
   (spw/gnus-goto "nnmaildir+fmail:notes")
   (gnus-summary-rescan-group))
 (global-set-key "\C-cgN" #'spw/gnus-goto-notes)
 
-(defun spw/gnus-goto-sent ()
+(spw/defun-pass-to-gdbmacs spw/gnus-goto-sent ()
   (interactive)
   (spw/gnus-goto "nnmaildir+fmail:sent")
   (gnus-summary-rescan-group))
 (global-set-key "\C-cgS" #'spw/gnus-goto-sent)
 
-(defun spw/gnus-notmuch-ephemeral-search (query &optional limit thread)
+(spw/defun-pass-to-gdbmacs spw/gnus-notmuch-ephemeral-search
+    (query &optional limit thread)
   (interactive
    (list (read-string "Query: ")
 	 (and current-prefix-arg (prefix-numeric-value current-prefix-arg))