1;;; gnus-dired.el --- utility functions where gnus and dired meet 2 3;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 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., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, 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. 86If called non-interactively, FILES-TO-ATTACH should be a list of 87filenames." 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. 137If 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 170If there is no print command, print in a PostScript image. If the 171optional argument PRINT-TO is nil, send the image to the printer. If 172PRINT-TO is a string, save the PostScript image in a file with that 173name. If PRINT-TO is a number, prompt the user for the name of the 174file 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 208