Mercurial > emacs
comparison lisp/gnus/gnus-dired.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | |
children | 18a818a2ee7c |
comparison
equal
deleted
inserted
replaced
56503:8bbd2323fbf2 | 82951:0fde48feb604 |
---|---|
1 ;;; gnus-dired.el --- utility functions where gnus and dired meet | |
2 | |
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004 | |
4 ;; Free Software Foundation, Inc. | |
5 | |
6 ;; Authors: Benjamin Rutt <brutt@bloomington.in.us>, | |
7 ;; Shenghuo Zhu <zsh@cs.rochester.edu> | |
8 ;; Keywords: mail, news, extensions | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; This package provides utility functions for intersections of gnus | |
30 ;; and dired. To enable the gnus-dired-mode minor mode which will | |
31 ;; have the effect of installing keybindings in dired-mode, place the | |
32 ;; following in your ~/.gnus: | |
33 | |
34 ;; (require 'gnus-dired) ;, isn't needed due to autoload cookies | |
35 ;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) | |
36 | |
37 ;; Note that if you visit dired buffers before your ~/.gnus file has | |
38 ;; been read, those dired buffers won't have the keybindings in | |
39 ;; effect. To get around that problem, you may want to add the above | |
40 ;; statements to your ~/.emacs instead. | |
41 | |
42 ;;; Code: | |
43 | |
44 (require 'dired) | |
45 (require 'gnus-ems) | |
46 (require 'gnus-msg) | |
47 (require 'gnus-util) | |
48 (require 'message) | |
49 (require 'mm-encode) | |
50 (require 'mml) | |
51 | |
52 (defvar gnus-dired-mode nil | |
53 "Minor mode for intersections of gnus and dired.") | |
54 | |
55 (defvar gnus-dired-mode-map nil) | |
56 | |
57 (unless gnus-dired-mode-map | |
58 (setq gnus-dired-mode-map (make-sparse-keymap)) | |
59 | |
60 (gnus-define-keys gnus-dired-mode-map | |
61 "\C-c\C-m\C-a" gnus-dired-attach | |
62 "\C-c\C-m\C-l" gnus-dired-find-file-mailcap | |
63 "\C-c\C-m\C-p" gnus-dired-print)) | |
64 | |
65 (defun gnus-dired-mode (&optional arg) | |
66 "Minor mode for intersections of gnus and dired. | |
67 | |
68 \\{gnus-dired-mode-map}" | |
69 (interactive "P") | |
70 (when (eq major-mode 'dired-mode) | |
71 (set (make-local-variable 'gnus-dired-mode) | |
72 (if (null arg) (not gnus-dired-mode) | |
73 (> (prefix-numeric-value arg) 0))) | |
74 (when gnus-dired-mode | |
75 (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) | |
76 (gnus-run-hooks 'gnus-dired-mode-hook)))) | |
77 | |
78 ;;;###autoload | |
79 (defun turn-on-gnus-dired-mode () | |
80 "Convenience method to turn on gnus-dired-mode." | |
81 (gnus-dired-mode 1)) | |
82 | |
83 ;; Method to attach files to a gnus composition. | |
84 (defun gnus-dired-attach (files-to-attach) | |
85 "Attach dired's marked files to a gnus message composition. | |
86 If called non-interactively, FILES-TO-ATTACH should be a list of | |
87 filenames." | |
88 (interactive | |
89 (list | |
90 (delq nil | |
91 (mapcar | |
92 ;; don't attach directories | |
93 (lambda (f) (if (file-directory-p f) nil f)) | |
94 (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) | |
95 (let ((destination nil) | |
96 (files-str nil) | |
97 (bufs nil)) | |
98 ;; warn if user tries to attach without any files marked | |
99 (if (null files-to-attach) | |
100 (error "No files to attach") | |
101 (setq files-str | |
102 (mapconcat | |
103 (lambda (f) (file-name-nondirectory f)) | |
104 files-to-attach ", ")) | |
105 (setq bufs (message-buffers)) | |
106 | |
107 ;; set up destination message buffer | |
108 (if (and bufs | |
109 (y-or-n-p "Attach files to existing message buffer? ")) | |
110 (setq destination | |
111 (if (= (length bufs) 1) | |
112 (get-buffer (car bufs)) | |
113 (completing-read "Attach to which message buffer: " | |
114 (mapcar | |
115 (lambda (b) | |
116 (cons b (get-buffer b))) | |
117 bufs) | |
118 nil t))) | |
119 ;; setup a new gnus message buffer | |
120 (gnus-setup-message 'message (message-mail)) | |
121 (setq destination (current-buffer))) | |
122 | |
123 ;; set buffer to destination buffer, and attach files | |
124 (set-buffer destination) | |
125 (goto-char (point-max)) ;attach at end of buffer | |
126 (while files-to-attach | |
127 (mml-attach-file (car files-to-attach) | |
128 (or (mm-default-file-encoding (car files-to-attach)) | |
129 "application/octet-stream") nil) | |
130 (setq files-to-attach (cdr files-to-attach))) | |
131 (message "Attached file(s) %s" files-str)))) | |
132 | |
133 (autoload 'mailcap-parse-mailcaps "mailcap" "" t) | |
134 | |
135 (defun gnus-dired-find-file-mailcap (&optional file-name arg) | |
136 "In dired, visit FILE-NAME according to the mailcap file. | |
137 If ARG is non-nil, open it in a new buffer." | |
138 (interactive (list | |
139 (file-name-sans-versions (dired-get-filename) t) | |
140 current-prefix-arg)) | |
141 (mailcap-parse-mailcaps) | |
142 (if (file-exists-p file-name) | |
143 (let (mime-type method) | |
144 (if (and (not arg) | |
145 (not (file-directory-p file-name)) | |
146 (string-match "\\.[^\\.]+$" file-name) | |
147 (setq mime-type | |
148 (mailcap-extension-to-mime | |
149 (match-string 0 file-name))) | |
150 (stringp | |
151 (setq method | |
152 (cdr (assoc 'viewer | |
153 (car (mailcap-mime-info mime-type | |
154 'all))))))) | |
155 (let ((view-command (mm-mailcap-command method file-name nil))) | |
156 (message "viewing via %s" view-command) | |
157 (start-process "*display*" | |
158 nil | |
159 shell-file-name | |
160 shell-command-switch | |
161 view-command)) | |
162 (find-file file-name))) | |
163 (if (file-symlink-p file-name) | |
164 (error "File is a symlink to a nonexistent target") | |
165 (error "File no longer exists; type `g' to update Dired buffer")))) | |
166 | |
167 (defun gnus-dired-print (&optional file-name print-to) | |
168 "In dired, print FILE-NAME according to the mailcap file. | |
169 | |
170 If there is no print command, print in a PostScript image. If the | |
171 optional argument PRINT-TO is nil, send the image to the printer. If | |
172 PRINT-TO is a string, save the PostScript image in a file with that | |
173 name. If PRINT-TO is a number, prompt the user for the name of the | |
174 file to save in." | |
175 (interactive (list | |
176 (file-name-sans-versions (dired-get-filename) t) | |
177 (ps-print-preprint current-prefix-arg))) | |
178 (mailcap-parse-mailcaps) | |
179 (cond | |
180 ((file-directory-p file-name) | |
181 (error "Can't print a directory")) | |
182 ((file-exists-p file-name) | |
183 (let (mime-type method) | |
184 (if (and (string-match "\\.[^\\.]+$" file-name) | |
185 (setq mime-type | |
186 (mailcap-extension-to-mime | |
187 (match-string 0 file-name))) | |
188 (stringp | |
189 (setq method (mailcap-mime-info mime-type "print")))) | |
190 (call-process shell-file-name nil | |
191 (generate-new-buffer " *mm*") | |
192 nil | |
193 shell-command-switch | |
194 (mm-mailcap-command method file-name mime-type)) | |
195 (with-temp-buffer | |
196 (insert-file-contents file-name) | |
197 (gnus-print-buffer)) | |
198 (ps-despool print-to)))) | |
199 ((file-symlink-p file-name) | |
200 (error "File is a symlink to a nonexistent target")) | |
201 (t | |
202 (error "File no longer exists; type `g' to update Dired buffer")))) | |
203 | |
204 (provide 'gnus-dired) | |
205 | |
206 ;;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76 | |
207 ;;; gnus-dired.el ends here |