X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-dired.el;h=d341cea34bba775f50089c0870b396dfa49c2179;hb=5beb390633ce1e32cdf319c6ba19926244bbfdf2;hp=14104f4ce6a7cd83ef30c22b63b171bb09b8a98c;hpb=7e6315f5e5339cc5ad13338702801ced3ea06fad;p=gnus diff --git a/lisp/gnus-dired.el b/lisp/gnus-dired.el index 14104f4ce..d341cea34 100644 --- a/lisp/gnus-dired.el +++ b/lisp/gnus-dired.el @@ -1,7 +1,6 @@ ;;; gnus-dired.el --- utility functions where gnus and dired meet -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2001-2012 Free Software Foundation, Inc. ;; Authors: Benjamin Rutt , ;; Shenghuo Zhu @@ -9,10 +8,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -41,47 +38,92 @@ ;;; Code: +(eval-when-compile + (when (featurep 'xemacs) + (require 'easy-mmode))) ; for `define-minor-mode' (require 'dired) -(require 'gnus-ems) -(require 'gnus-msg) -(require 'gnus-util) -(require 'message) -(require 'mm-encode) -(require 'mml) +(autoload 'mml-attach-file "mml") +(autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'? +(autoload 'mailcap-extension-to-mime "mailcap") +(autoload 'mailcap-mime-info "mailcap") -(defvar gnus-dired-mode nil - "Minor mode for intersections of gnus and dired.") +;; Maybe shift this function to `mailcap.el'? +(autoload 'mm-mailcap-command "mm-decode") -(defvar gnus-dired-mode-map nil) +(autoload 'ps-print-preprint "ps-print") -(unless gnus-dired-mode-map - (setq gnus-dired-mode-map (make-sparse-keymap)) +;; Autoloads to avoid byte-compiler warnings. These are used only if the user +;; customizes `gnus-dired-mail-mode' to use Message and/or Gnus. +(autoload 'message-buffers "message") +(autoload 'gnus-print-buffer "gnus-sum") - (gnus-define-keys gnus-dired-mode-map - "\C-c\C-a" gnus-dired-attach - "\C-c\C-f" gnus-dired-find-file-mailcap - "\C-cP" gnus-dired-print - )) +(defvar gnus-dired-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-m\C-a" 'gnus-dired-attach) + (define-key map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap) + (define-key map "\C-c\C-m\C-p" 'gnus-dired-print) + map)) -(defun gnus-dired-mode (&optional arg) +;; FIXME: Make it customizable, change the default to `mail-user-agent' when +;; this file is renamed (e.g. to `dired-mime.el'). + +(defcustom gnus-dired-mail-mode 'gnus-user-agent ;; mail-user-agent + "Your preference for a mail composition package. +See `mail-user-agent' for more information." + :group 'mail ;; dired? + :version "23.1" ;; No Gnus + :type '(radio (function-item :tag "Default Emacs mail" + :format "%t\n" + sendmail-user-agent) + (function-item :tag "Emacs interface to MH" + :format "%t\n" + mh-e-user-agent) + (function-item :tag "Gnus Message package" + :format "%t\n" + message-user-agent) + (function-item :tag "Gnus Message with full Gnus features" + :format "%t\n" + gnus-user-agent) + (function :tag "Other"))) + +(eval-when-compile + (when (featurep 'xemacs) + (defvar gnus-dired-mode-hook) + (defvar gnus-dired-mode-on-hook) + (defvar gnus-dired-mode-off-hook))) + +(define-minor-mode gnus-dired-mode "Minor mode for intersections of gnus and dired. \\{gnus-dired-mode-map}" - (interactive "P") - (when (eq major-mode 'dired-mode) - (set (make-local-variable 'gnus-dired-mode) - (if (null arg) (not gnus-dired-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-dired-mode - (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) - (gnus-run-hooks 'gnus-dired-mode-hook)))) + :keymap gnus-dired-mode-map + (unless (derived-mode-p 'dired-mode) + (setq gnus-dired-mode nil))) ;;;###autoload (defun turn-on-gnus-dired-mode () "Convenience method to turn on gnus-dired-mode." + (interactive) (gnus-dired-mode 1)) -;; Method to attach files to a gnus composition. +(defun gnus-dired-mail-buffers () + "Return a list of active mail composition buffers." + (if (and (memq gnus-dired-mail-mode '(message-user-agent gnus-user-agent)) + (require 'message) + (fboundp 'message-buffers)) + (message-buffers) + ;; Cf. `message-buffers' in `message.el': + (let (buffers) + (save-excursion + (dolist (buffer (buffer-list t)) + (set-buffer buffer) + (when (eq major-mode 'mail-mode) + (push (buffer-name buffer) buffers)))) + (nreverse buffers)))) + +(autoload 'gnus-completing-read "gnus-util") + +;; Method to attach files to a mail composition. (defun gnus-dired-attach (files-to-attach) "Attach dired's marked files to a gnus message composition. If called non-interactively, FILES-TO-ATTACH should be a list of @@ -92,33 +134,42 @@ filenames." (mapcar ;; don't attach directories (lambda (f) (if (file-directory-p f) nil f)) - (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) + (nreverse + (let ((arg nil)) ;; Silence XEmacs 21.5 when compiling. + (dired-map-over-marks (dired-get-filename) arg))))))) (let ((destination nil) (files-str nil) (bufs nil)) - ;; warn if user tries to attach without any files marked + ;; warn if user tries to attach without any files marked (if (null files-to-attach) (error "No files to attach") (setq files-str (mapconcat (lambda (f) (file-name-nondirectory f)) files-to-attach ", ")) - (setq bufs (message-buffers)) - - ;; set up destination message buffer + (setq bufs (gnus-dired-mail-buffers)) + + ;; set up destination mail composition buffer (if (and bufs - (y-or-n-p "Attach files to existing message buffer? ")) + (y-or-n-p "Attach files to existing mail composition buffer? ")) (setq destination (if (= (length bufs) 1) (get-buffer (car bufs)) - (completing-read "Attach to which message buffer: " - (mapcar - (lambda (b) - (cons b (get-buffer b))) - bufs) - nil t))) - ;; setup a new gnus message buffer - (gnus-setup-message 'message (message-mail)) + (gnus-completing-read "Attach to which mail composition buffer" + bufs t))) + ;; setup a new mail composition buffer + (let ((mail-user-agent gnus-dired-mail-mode) + ;; A workaround to prevent Gnus from displaying the Gnus + ;; logo when invoking this command without loading Gnus. + ;; Gnus demonstrates it when gnus.elc is being loaded if + ;; a command of which the name is prefixed with "gnus" + ;; causes that autoloading. See the code in question, + ;; that is the one first found in gnus.el by performing + ;; `C-s this-command'. + (this-command (if (eq gnus-dired-mail-mode 'gnus-user-agent) + 'gnoose-dired-attach + this-command))) + (compose-mail)) (setq destination (current-buffer))) ;; set buffer to destination buffer, and attach files @@ -146,13 +197,14 @@ If ARG is non-nil, open it in a new buffer." (not (file-directory-p file-name)) (string-match "\\.[^\\.]+$" file-name) (setq mime-type - (mailcap-extension-to-mime + (mailcap-extension-to-mime (match-string 0 file-name))) - (stringp + (stringp (setq method - (cdr (assoc 'viewer - (car (mailcap-mime-info mime-type - 'all))))))) + (cdr (assoc 'viewer + (car (mailcap-mime-info mime-type + 'all + 'no-decode))))))) (let ((view-command (mm-mailcap-command method file-name nil))) (message "viewing via %s" view-command) (start-process "*display*" @@ -177,17 +229,18 @@ file to save in." (file-name-sans-versions (dired-get-filename) t) (ps-print-preprint current-prefix-arg))) (mailcap-parse-mailcaps) - (cond + (cond ((file-directory-p file-name) (error "Can't print a directory")) ((file-exists-p file-name) (let (mime-type method) (if (and (string-match "\\.[^\\.]+$" file-name) (setq mime-type - (mailcap-extension-to-mime + (mailcap-extension-to-mime (match-string 0 file-name))) - (stringp - (setq method (mailcap-mime-info mime-type "print")))) + (stringp + (setq method (mailcap-mime-info mime-type "print" + 'no-decode)))) (call-process shell-file-name nil (generate-new-buffer " *mm*") nil @@ -195,7 +248,10 @@ file to save in." (mm-mailcap-command method file-name mime-type)) (with-temp-buffer (insert-file-contents file-name) - (gnus-print-buffer)) + (if (eq gnus-dired-mail-mode 'gnus-user-agent) + (gnus-print-buffer) + ;; FIXME: + (error "MIME print only implemented via Gnus"))) (ps-despool print-to)))) ((file-symlink-p file-name) (error "File is a symlink to a nonexistent target"))