;;; gnus-art.el --- article mode commands for Semi-gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(defun article-wash-html (&optional read-charset)
"Format an HTML article.
-If READ-CHARSET, ask for a coding system."
+If READ-CHARSET, ask for a coding system. If it is a number, the
+charset defined in `gnus-summary-show-article-charset-alist' is used."
(interactive "P")
(save-excursion
(let ((inhibit-read-only t)
charset)
- (when (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
- (ignore-errors
- (mail-header-parse-content-type ct)))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (when (stringp charset)
- (setq charset (intern (downcase charset)))))))
- (when read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
- (unless charset
- (setq charset gnus-newsgroup-charset))
+ (if read-charset
+ (if (or (and (numberp read-charset)
+ (setq charset
+ (cdr
+ (assq read-charset
+ gnus-summary-show-article-charset-alist))))
+ (setq charset (mm-read-coding-system "Charset: ")))
+ (let ((gnus-summary-show-article-charset-alist
+ (list (cons 1 charset))))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-show-article 1)))
+ (error "No charset is given"))
+ (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
+ (let* ((ct (gnus-fetch-field "content-type"))
+ (ctl (and ct
+ (ignore-errors
+ (mail-header-parse-content-type ct)))))
+ (setq charset (and ctl
+ (mail-content-type-get ctl 'charset)))
+ (when (stringp charset)
+ (setq charset (intern (downcase charset)))))))
+ (unless charset
+ (setq charset gnus-newsgroup-charset)))
(article-goto-body)
(save-window-excursion
(save-restriction
;; Put the mark meaning this part was rendered by emacs-w3m.
'mm-inline-text-html-with-w3m t))))
+(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
+
+(defun gnus-article-wash-html-with-w3m-standalone ()
+ "Wash the current buffer with w3m."
+ (if (mm-w3m-standalone-supports-m17n-p)
+ (progn
+ (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'.
+ ;; The default.
+ (setq charset 'iso-8859-1))
+ (let ((coding-system-for-write charset)
+ (coding-system-for-read charset))
+ (call-process-region
+ (point-min) (point-max)
+ "w3m" t t nil "-dump" "-T" "text/html"
+ "-I" (symbol-name charset) "-O" (symbol-name charset))))
+ (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html")))
+
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(?d gnus-tmp-details ?s)
(?D gnus-tmp-pressed-details ?s)))
+(defvar gnus-mime-security-button-commands
+ '((gnus-article-press-button "\r" "Show Detail")
+ (undefined "v")
+ (undefined "t")
+ (undefined "C")
+ (gnus-mime-security-save-part "o" "Save...")
+ (undefined "\C-o")
+ (undefined "r")
+ (undefined "d")
+ (undefined "c")
+ (undefined "i")
+ (undefined "E")
+ (undefined "e")
+ (undefined "p")
+ (gnus-mime-security-pipe-part "|" "Pipe To Command...")
+ (undefined ".")))
+
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
(define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map "\r" 'gnus-article-press-button)
+ (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu)
+ (dolist (c gnus-mime-security-button-commands)
+ (define-key map (cadr c) (car c)))
map))
+(easy-menu-define
+ gnus-mime-security-button-menu gnus-mime-security-button-map
+ "Security button menu."
+ `("Security Part"
+ ,@(delq nil
+ (mapcar (lambda (c)
+ (unless (eq (car c) 'undefined)
+ (vector (caddr c) (car c) :enable t)))
+ gnus-mime-security-button-commands))))
+
+(defun gnus-mime-security-button-menu (event prefix)
+ "Construct a context-sensitive menu of security commands."
+ (interactive "e\nP")
+ (save-window-excursion
+ (let ((pos (event-start event)))
+ (select-window (posn-window pos))
+ (goto-char (posn-point pos))
+ (gnus-article-check-buffer)
+ (popup-menu gnus-mime-security-button-menu nil prefix))))
+
(defvar gnus-mime-security-details-buffer nil)
(defvar gnus-mime-security-button-pressed nil)
(when (boundp 'help-echo-owns-message)
(setq help-echo-owns-message t))
(format
- "%S: show detail"
- (aref gnus-mouse-2 0))))))
+ "%S: show detail; %S: more options"
+ (aref gnus-mouse-2 0)
+ (aref gnus-down-mouse-3 0))))))
(defun gnus-mime-display-security (handle)
(save-restriction
;;; @ end
;;;
+(defun gnus-mime-security-run-function (function)
+ "Run FUNCTION with the security part under point."
+ (gnus-article-check-buffer)
+ (let ((data (get-text-property (point) 'gnus-data))
+ buffer handle)
+ (when (and (stringp (car-safe data))
+ (setq buffer (mm-handle-multipart-original-buffer data))
+ (setq handle (cadr data)))
+ (if (bufferp (mm-handle-buffer handle))
+ (progn
+ (setq handle (cons buffer (copy-sequence (cdr handle))))
+ (mm-handle-set-undisplayer handle nil))
+ (setq handle (mm-make-handle
+ buffer
+ (mm-handle-multipart-ctl-parameter handle 'protocol)
+ nil nil nil nil nil nil)))
+ (funcall function handle))))
+
+(defun gnus-mime-security-save-part ()
+ "Save the security part under point."
+ (interactive)
+ (gnus-mime-security-run-function 'mm-save-part))
+
+(defun gnus-mime-security-pipe-part ()
+ "Pipe the security part under point to a process."
+ (interactive)
+ (gnus-mime-security-run-function 'mm-pipe-part))
+
(gnus-ems-redefine)
(provide 'gnus-art)
projects / elisp / gnus.git- / blobdiff