Commit | Line | Data |
---|---|---|
23f87bed MB |
1 | ;;; gnus-dired.el --- utility functions where gnus and dired meet |
2 | ||
ab422c4d | 3 | ;; Copyright (C) 1996-1999, 2001-2013 Free Software Foundation, Inc. |
23f87bed MB |
4 | |
5 | ;; Authors: Benjamin Rutt <brutt@bloomington.in.us>, | |
6 | ;; Shenghuo Zhu <zsh@cs.rochester.edu> | |
7 | ;; Keywords: mail, news, extensions | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
5e809f55 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
23f87bed | 12 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
23f87bed MB |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
23f87bed MB |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This package provides utility functions for intersections of gnus | |
27 | ;; and dired. To enable the gnus-dired-mode minor mode which will | |
28 | ;; have the effect of installing keybindings in dired-mode, place the | |
29 | ;; following in your ~/.gnus: | |
30 | ||
31 | ;; (require 'gnus-dired) ;, isn't needed due to autoload cookies | |
32 | ;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) | |
33 | ||
34 | ;; Note that if you visit dired buffers before your ~/.gnus file has | |
35 | ;; been read, those dired buffers won't have the keybindings in | |
36 | ;; effect. To get around that problem, you may want to add the above | |
37 | ;; statements to your ~/.emacs instead. | |
38 | ||
39 | ;;; Code: | |
40 | ||
d029b5d2 KY |
41 | (eval-when-compile |
42 | (when (featurep 'xemacs) | |
43 | (require 'easy-mmode))) ; for `define-minor-mode' | |
23f87bed | 44 | (require 'dired) |
b890d447 MB |
45 | (autoload 'mml-attach-file "mml") |
46 | (autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'? | |
47 | (autoload 'mailcap-extension-to-mime "mailcap") | |
48 | (autoload 'mailcap-mime-info "mailcap") | |
49 | ||
50 | ;; Maybe shift this function to `mailcap.el'? | |
51 | (autoload 'mm-mailcap-command "mm-decode") | |
52 | ||
53 | (autoload 'ps-print-preprint "ps-print") | |
54 | ||
55 | ;; Autoloads to avoid byte-compiler warnings. These are used only if the user | |
56 | ;; customizes `gnus-dired-mail-mode' to use Message and/or Gnus. | |
57 | (autoload 'message-buffers "message") | |
b890d447 | 58 | (autoload 'gnus-print-buffer "gnus-sum") |
23f87bed | 59 | |
bbf52f1e SM |
60 | (defvar gnus-dired-mode-map |
61 | (let ((map (make-sparse-keymap))) | |
62 | (define-key map "\C-c\C-m\C-a" 'gnus-dired-attach) | |
63 | (define-key map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap) | |
64 | (define-key map "\C-c\C-m\C-p" 'gnus-dired-print) | |
65 | map)) | |
b890d447 MB |
66 | |
67 | ;; FIXME: Make it customizable, change the default to `mail-user-agent' when | |
3a0f6aac | 68 | ;; this file is renamed (e.g. to `dired-mime.el'). |
b890d447 MB |
69 | |
70 | (defcustom gnus-dired-mail-mode 'gnus-user-agent ;; mail-user-agent | |
71 | "Your preference for a mail composition package. | |
72 | See `mail-user-agent' for more information." | |
73 | :group 'mail ;; dired? | |
330f707b | 74 | :version "23.1" ;; No Gnus |
b890d447 MB |
75 | :type '(radio (function-item :tag "Default Emacs mail" |
76 | :format "%t\n" | |
77 | sendmail-user-agent) | |
78 | (function-item :tag "Emacs interface to MH" | |
79 | :format "%t\n" | |
80 | mh-e-user-agent) | |
81 | (function-item :tag "Gnus Message package" | |
82 | :format "%t\n" | |
83 | message-user-agent) | |
84 | (function-item :tag "Gnus Message with full Gnus features" | |
85 | :format "%t\n" | |
86 | gnus-user-agent) | |
87 | (function :tag "Other"))) | |
23f87bed | 88 | |
765d4319 KY |
89 | (eval-when-compile |
90 | (when (featurep 'xemacs) | |
91 | (defvar gnus-dired-mode-hook) | |
92 | (defvar gnus-dired-mode-on-hook) | |
93 | (defvar gnus-dired-mode-off-hook))) | |
94 | ||
bbf52f1e | 95 | (define-minor-mode gnus-dired-mode |
23f87bed MB |
96 | "Minor mode for intersections of gnus and dired. |
97 | ||
98 | \\{gnus-dired-mode-map}" | |
bbf52f1e SM |
99 | :keymap gnus-dired-mode-map |
100 | (unless (derived-mode-p 'dired-mode) | |
101 | (setq gnus-dired-mode nil))) | |
23f87bed MB |
102 | |
103 | ;;;###autoload | |
104 | (defun turn-on-gnus-dired-mode () | |
105 | "Convenience method to turn on gnus-dired-mode." | |
b890d447 | 106 | (interactive) |
23f87bed MB |
107 | (gnus-dired-mode 1)) |
108 | ||
b890d447 MB |
109 | (defun gnus-dired-mail-buffers () |
110 | "Return a list of active mail composition buffers." | |
111 | (if (and (memq gnus-dired-mail-mode '(message-user-agent gnus-user-agent)) | |
112 | (require 'message) | |
113 | (fboundp 'message-buffers)) | |
114 | (message-buffers) | |
115 | ;; Cf. `message-buffers' in `message.el': | |
116 | (let (buffers) | |
117 | (save-excursion | |
118 | (dolist (buffer (buffer-list t)) | |
119 | (set-buffer buffer) | |
120 | (when (eq major-mode 'mail-mode) | |
121 | (push (buffer-name buffer) buffers)))) | |
122 | (nreverse buffers)))) | |
123 | ||
26205de3 GM |
124 | (autoload 'gnus-completing-read "gnus-util") |
125 | ||
b890d447 | 126 | ;; Method to attach files to a mail composition. |
23f87bed MB |
127 | (defun gnus-dired-attach (files-to-attach) |
128 | "Attach dired's marked files to a gnus message composition. | |
129 | If called non-interactively, FILES-TO-ATTACH should be a list of | |
130 | filenames." | |
131 | (interactive | |
132 | (list | |
133 | (delq nil | |
134 | (mapcar | |
135 | ;; don't attach directories | |
136 | (lambda (f) (if (file-directory-p f) nil f)) | |
68d9bf4b KY |
137 | (nreverse |
138 | (let ((arg nil)) ;; Silence XEmacs 21.5 when compiling. | |
139 | (dired-map-over-marks (dired-get-filename) arg))))))) | |
23f87bed MB |
140 | (let ((destination nil) |
141 | (files-str nil) | |
142 | (bufs nil)) | |
143 | ;; warn if user tries to attach without any files marked | |
144 | (if (null files-to-attach) | |
145 | (error "No files to attach") | |
146 | (setq files-str | |
147 | (mapconcat | |
148 | (lambda (f) (file-name-nondirectory f)) | |
149 | files-to-attach ", ")) | |
b890d447 | 150 | (setq bufs (gnus-dired-mail-buffers)) |
23f87bed | 151 | |
b890d447 | 152 | ;; set up destination mail composition buffer |
23f87bed | 153 | (if (and bufs |
b890d447 | 154 | (y-or-n-p "Attach files to existing mail composition buffer? ")) |
23f87bed MB |
155 | (setq destination |
156 | (if (= (length bufs) 1) | |
157 | (get-buffer (car bufs)) | |
229b59da G |
158 | (gnus-completing-read "Attach to which mail composition buffer" |
159 | bufs t))) | |
b890d447 | 160 | ;; setup a new mail composition buffer |
87202be1 KY |
161 | (let ((mail-user-agent gnus-dired-mail-mode) |
162 | ;; A workaround to prevent Gnus from displaying the Gnus | |
163 | ;; logo when invoking this command without loading Gnus. | |
164 | ;; Gnus demonstrates it when gnus.elc is being loaded if | |
165 | ;; a command of which the name is prefixed with "gnus" | |
166 | ;; causes that autoloading. See the code in question, | |
167 | ;; that is the one first found in gnus.el by performing | |
168 | ;; `C-s this-command'. | |
169 | (this-command (if (eq gnus-dired-mail-mode 'gnus-user-agent) | |
170 | 'gnoose-dired-attach | |
171 | this-command))) | |
b890d447 | 172 | (compose-mail)) |
23f87bed MB |
173 | (setq destination (current-buffer))) |
174 | ||
175 | ;; set buffer to destination buffer, and attach files | |
176 | (set-buffer destination) | |
177 | (goto-char (point-max)) ;attach at end of buffer | |
178 | (while files-to-attach | |
179 | (mml-attach-file (car files-to-attach) | |
180 | (or (mm-default-file-encoding (car files-to-attach)) | |
181 | "application/octet-stream") nil) | |
182 | (setq files-to-attach (cdr files-to-attach))) | |
183 | (message "Attached file(s) %s" files-str)))) | |
184 | ||
185 | (autoload 'mailcap-parse-mailcaps "mailcap" "" t) | |
186 | ||
187 | (defun gnus-dired-find-file-mailcap (&optional file-name arg) | |
188 | "In dired, visit FILE-NAME according to the mailcap file. | |
189 | If ARG is non-nil, open it in a new buffer." | |
190 | (interactive (list | |
191 | (file-name-sans-versions (dired-get-filename) t) | |
192 | current-prefix-arg)) | |
193 | (mailcap-parse-mailcaps) | |
194 | (if (file-exists-p file-name) | |
195 | (let (mime-type method) | |
196 | (if (and (not arg) | |
197 | (not (file-directory-p file-name)) | |
198 | (string-match "\\.[^\\.]+$" file-name) | |
199 | (setq mime-type | |
200 | (mailcap-extension-to-mime | |
201 | (match-string 0 file-name))) | |
202 | (stringp | |
203 | (setq method | |
204 | (cdr (assoc 'viewer | |
205 | (car (mailcap-mime-info mime-type | |
c9fc72fa | 206 | 'all |
b890d447 | 207 | 'no-decode))))))) |
23f87bed MB |
208 | (let ((view-command (mm-mailcap-command method file-name nil))) |
209 | (message "viewing via %s" view-command) | |
210 | (start-process "*display*" | |
211 | nil | |
212 | shell-file-name | |
213 | shell-command-switch | |
214 | view-command)) | |
215 | (find-file file-name))) | |
216 | (if (file-symlink-p file-name) | |
217 | (error "File is a symlink to a nonexistent target") | |
218 | (error "File no longer exists; type `g' to update Dired buffer")))) | |
219 | ||
220 | (defun gnus-dired-print (&optional file-name print-to) | |
221 | "In dired, print FILE-NAME according to the mailcap file. | |
222 | ||
223 | If there is no print command, print in a PostScript image. If the | |
224 | optional argument PRINT-TO is nil, send the image to the printer. If | |
225 | PRINT-TO is a string, save the PostScript image in a file with that | |
226 | name. If PRINT-TO is a number, prompt the user for the name of the | |
227 | file to save in." | |
228 | (interactive (list | |
229 | (file-name-sans-versions (dired-get-filename) t) | |
230 | (ps-print-preprint current-prefix-arg))) | |
231 | (mailcap-parse-mailcaps) | |
232 | (cond | |
233 | ((file-directory-p file-name) | |
234 | (error "Can't print a directory")) | |
235 | ((file-exists-p file-name) | |
236 | (let (mime-type method) | |
237 | (if (and (string-match "\\.[^\\.]+$" file-name) | |
238 | (setq mime-type | |
239 | (mailcap-extension-to-mime | |
240 | (match-string 0 file-name))) | |
241 | (stringp | |
b890d447 MB |
242 | (setq method (mailcap-mime-info mime-type "print" |
243 | 'no-decode)))) | |
23f87bed MB |
244 | (call-process shell-file-name nil |
245 | (generate-new-buffer " *mm*") | |
246 | nil | |
247 | shell-command-switch | |
248 | (mm-mailcap-command method file-name mime-type)) | |
249 | (with-temp-buffer | |
250 | (insert-file-contents file-name) | |
b890d447 MB |
251 | (if (eq gnus-dired-mail-mode 'gnus-user-agent) |
252 | (gnus-print-buffer) | |
253 | ;; FIXME: | |
53964682 | 254 | (error "MIME print only implemented via Gnus"))) |
23f87bed MB |
255 | (ps-despool print-to)))) |
256 | ((file-symlink-p file-name) | |
257 | (error "File is a symlink to a nonexistent target")) | |
258 | (t | |
259 | (error "File no longer exists; type `g' to update Dired buffer")))) | |
260 | ||
261 | (provide 'gnus-dired) | |
262 | ||
23f87bed | 263 | ;;; gnus-dired.el ends here |