[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/gnorb 62368b7 017/449: gnorb-gnus.el: Make attachment f
From: |
Stefan Monnier |
Subject: |
[elpa] externals/gnorb 62368b7 017/449: gnorb-gnus.el: Make attachment fiddling work in org capture |
Date: |
Fri, 27 Nov 2020 23:14:59 -0500 (EST) |
branch: externals/gnorb
commit 62368b7f1e9fd0317cddbb860aa7aa9bb50e95fa
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>
gnorb-gnus.el: Make attachment fiddling work in org capture
Setting a :gnus-attachments t key on capture templates will copy
attachments to the captured heading using org-attach.
---
lisp/gnorb-gnus.el | 93 ++++++++++++++++++++++++++++++++++++++++++++----------
1 file changed, 76 insertions(+), 17 deletions(-)
diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index 46632b2..2839e46 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -34,6 +34,10 @@
;;; What follows is a very careful copy-pasta of bits and pieces from
;;; mm-decode.el and gnus-art.el. Voodoo was involved.
+(defvar gnorb-gnus-capture-attachments nil
+ "Holding place for attachment names during the capture
+ process.")
+
(defun gnorb-gnus-article-org-attach (n)
"Save MIME part N, which is the numerical prefix, of the
article under point as an attachment to the specified org
@@ -52,26 +56,81 @@
(defun gnorb-gnus-attach-part (handle &optional org-heading)
"Attach HANDLE to an existing org heading."
- (let ((filename (or (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name)))
+ (let ((filename (gnorb-gnus-save-part handle))
(org-heading (or org-heading
- (org-refile-get-location "Attach part to"))))
- (require 'org-attach)
- (when filename
- (setq filename (gnus-map-function mm-file-name-rewrite-functions
- (file-name-nondirectory filename))))
- ;; Get a temp pathname inside `gnorb-tmp-dir', and save the
- ;; attachment there
+ (org-refile-get-location "Attach part to")))))
+ (require 'org-attach)
+ (save-window-excursion
+ (find-file (nth 1 org-heading))
+ (goto-char (nth 3 org-heading))
+ (org-attach-attach filename nil 'mv)))
+
+(defun gnorb-gnus-save-part (handle)
+ (let ((filename (or (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name))))
+ (setq filename
+ (gnus-map-function mm-file-name-rewrite-functions
+ (file-name-nondirectory filename)))
(setq filename (expand-file-name filename gnorb-tmp-dir))
(mm-save-part-to-file handle filename)
- ;; then visit the headline in question...
- (save-window-excursion
- (find-file (nth 1 org-heading))
- (goto-char (nth 3 org-heading))
- ;; ...and actually attach the file, moving it out of the tmp dir
- (org-attach-attach filename nil 'mv))))
+ filename))
+
+(defun gnorb-gnus-collect-all-attachments (&optional capture-p)
+ "Collect all the attachments from the message under point, and
+save them into `gnorb-tmp-dir'."
+ (save-excursion
+ (when capture-p
+ (set-buffer (org-capture-get :original-buffer)))
+ (unless (memq major-mode '(gnus-summary-mode gnus-article-mode))
+ (error "Only works in Gnus summary or article buffers"))
+ (let ((article (gnus-summary-article-number))
+ mime-handles)
+ (when (or (null gnus-current-article)
+ (null gnus-article-current)
+ (/= article (cdr gnus-article-current))
+ (not (equal (car gnus-article-current) gnus-newsgroup-name)))
+ (gnus-summary-display-article article))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq mime-handles (cl-remove-if-not
+ (lambda (h) (equal "attachment" (car (nth 5 h))))
+ gnus-article-mime-handle-alist) ))
+ (when mime-handles
+ (dolist (h mime-handles)
+ (let ((filename
+ (gnorb-gnus-save-part (cdr h))))
+ (when capture-p
+ (push filename gnorb-gnus-capture-attachments))))))))
+
+;;; Make the above work in the capture process
+
+(defun gnorb-gnus-capture-attach ()
+ (when (and (org-capture-get :gnus-attachments)
+ (with-current-buffer
+ (org-capture-get :original-buffer)
+ (memq major-mode '(gnus-summary-mode gnus-article-mode))))
+ (require 'org-attach)
+ (setq gnorb-gnus-capture-attachments nil)
+ (gnorb-gnus-collect-all-attachments t)
+ (when gnorb-gnus-capture-attachments
+ (dolist (a gnorb-gnus-capture-attachments)
+ (org-attach-attach a nil 'mv)))))
+
+(add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-attach)
+
+(defun gnorb-gnus-capture-abort-cleanup ()
+ (when (and org-note-abort
+ (org-capture-get :gnus-attachments))
+ (condition-case error
+ (progn (org-attach-delete-all)
+ (setq abort-note 'clean))
+ ((error
+ (setq abort-note 'dirty))))))
+
+(add-hook 'org-capture-prepare-finalize-hook
+ 'gnorb-gnus-capture-abort-cleanup)
+
;;; Something is still slightly wrong about the following -- it
;;; doesn't provide "a" as a key on the button itself, which is what I
- [elpa] externals/gnorb 3edf1c9 025/449: gnorb-utils.el: gnorb-prompt-for-bbdb-record, (continued)
- [elpa] externals/gnorb 3edf1c9 025/449: gnorb-utils.el: gnorb-prompt-for-bbdb-record, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 32ecc09 026/449: gnorb-org.el: gnorb-org-handle-mail, gnorb-org-email-subtree, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 123b521 031/449: gnorb-org.el: bugfix gnorb-org-restore-after-send, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb a9c7410 032/449: gnorb-gnus.el: bugfix gnorb-gnus-attach-part, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 5adcc84 008/449: gnorb-utils: (gnorb-prompt-for-bbdb-record), Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb bedce9d 012/449: gnorb-gnus.el: (gnorb-gnus(article|mime)-org-attach), Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb d28a099 005/449: gnorb-bbdb.el: New function gnorb-bbdb-tag-agenda, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 63ac8f6 011/449: gnorb-org.el: (gnorb-org-handle-mail, gnorb-org-handle-mail-agenda), Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb c2b1a3a 013/449: Docstring for gnorb-org-contact-link, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb d4987a7 014/449: gnorb-utils.el: More likely requires for Org libraries, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 62368b7 017/449: gnorb-gnus.el: Make attachment fiddling work in org capture,
Stefan Monnier <=
- [elpa] externals/gnorb da7cf10 018/449: gnorb-utils.el: Require mailcap, and parse, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 5264b3c 021/449: README.org: Document gnorb-org-email-subtree, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 82bb9db 023/449: README.org: Add keybindings to gnus mime commands., Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 534b2bf 024/449: gnorb-org.el: new option gnorb-org-mail-todos, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 9c5d04a 027/449: README.org: More explanation about the mail stuff., Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb e53d908 028/449: gnorb-gnus.el: bugfix in gnorb-gnus-collect-all-attachments, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 4f16002 029/449: gnorb-org.el: Fix attaching attachments to outgoing messages., Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb ed9825e 034/449: Use map-y-or-n-p for attachment actions, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb af8f375 038/449: Various README.org tweaks, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 27a91f6 039/449: Open link from string correctly, Stefan Monnier, 2020/11/27