;;;
-;;; tm-sgnus.el --- tm-gnus module for September GNUS
+;;; tm-sgnus.el --- tm-gnus module for September Gnus
;;;
;;; Copyright (C) 1995 Free Software Foundation, Inc.
;;; Copyright (C) 1995 MORIOKA Tomohiko
;;;
;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; MURATA Masahiro <murata@sol.cs.ritsumei.ac.jp>
+;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Created: 1995/09/24
+;;; Version: $Revision: 7.28 $
;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
;;;
+;;; This program 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.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with This program. If not, write to the Free Software
+;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; Code:
(require 'tl-str)
(require 'tl-list)
(require 'gnus)
(require 'tm-gd5)
+(eval-when-compile (require 'cl))
+
;;; @ version
;;;
(defconst tm-gnus/RCS-ID
- "$Id: tm-sgnus.el,v 7.18 1995/11/19 08:29:23 morioka Exp $")
+ "$Id: tm-sgnus.el,v 7.28 1995/12/22 07:50:17 morioka Exp $")
(defconst tm-gnus/version
(concat (get-version-string tm-gnus/RCS-ID) " for September"))
(defun tm-gnus/summary-toggle-header (&optional arg)
(interactive "P")
- (if (and gnus-show-mime
- (or (not gnus-strict-mime)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-fetch-field "Mime-Version")
- )))
- (let ((mime-viewer/ignored-field-regexp
- (if (save-excursion
- (set-buffer gnus-article-buffer)
- (some-element
- (lambda (field)
- (rfc822/get-field-body field)
- )
- mime-viewer/ignored-field-list))
- mime-viewer/ignored-field-regexp
- "^:$")))
- (gnus-summary-select-article t t)
- )
- (gnus-summary-toggle-header arg)
- ))
+ (if tm-gnus/automatic-mime-preview
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let* ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (hidden (text-property-any
+ (goto-char (point-min)) (search-forward "\n\n")
+ 'invisible t))
+ e)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (point-min) (1- (point))))
+ (goto-char (point-min))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (if (or (not hidden) (and (numberp arg) (< arg 0)))
+ (tm-gnus/content-header-filter)
+ (mime/decode-message-header))
+ (let ((gnus-inhibit-hiding t))
+ (run-hooks 'gnus-article-display-hook))
+ ))
+ (gnus-summary-toggle-header arg))
+ )
(define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
(define-key gnus-summary-mode-map
;;;
(defun mime-viewer/quitting-method-for-sgnus ()
- (mime-viewer/kill-buffer)
+ (if (not gnus-show-mime)
+ (mime-viewer/kill-buffer))
(delete-other-windows)
(gnus-article-show-summary)
- (gnus-summary-display-article (gnus-summary-article-number))
- )
+ (if (or (not gnus-show-mime)
+ (null gnus-have-all-headers))
+ (gnus-summary-select-article nil t)
+ ))
(call-after-loaded
'tm-view
(set-alist 'mime-viewer/quitting-method-alist
'gnus-original-article-mode
(function mime-viewer/quitting-method-for-sgnus))
+ (set-alist 'mime-viewer/show-summary-method
+ 'gnus-original-article-mode
+ (function mime-viewer/quitting-method-for-sgnus))
))
;;; @ for tm-partial
;;;
+(defun tm-gnus/partial-preview-function ()
+ (tm-gnus/view-message (gnus-summary-article-number))
+ )
+
(call-after-loaded
'tm-partial
(lambda ()
))
(set-alist 'tm-partial/preview-article-method-alist
'gnus-original-article-mode
- '(lambda ()
- (tm-gnus/view-message (gnus-summary-article-number))
- ))
+ 'tm-gnus/partial-preview-function)
))
(tm::gnus-article-hide-headers-if-wanted)
))
+(defun tm-gnus/preview-cut-header ()
+ (save-restriction
+ (let ((ignored mime-viewer/ignored-field-regexp)
+ (visible mime-viewer/visible-field-regexp)
+ want-list beg)
+ (goto-char (point-min))
+ (narrow-to-region
+ (point)
+ (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ ;; We add the headers we want to keep to a list and delete
+ ;; them from the buffer.
+ (if (or (and visible (looking-at visible))
+ (and ignored (not (looking-at ignored))))
+ (progn
+ (push (buffer-substring
+ (setq beg (point))
+ (progn
+ (forward-line 1)
+ ;; Be sure to get multi-line headers...
+ (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ (point)))
+ want-list)
+ (delete-region beg (point)))
+ (forward-line 1)))
+ ;; Sort the headers that we want to display.
+ (setq want-list (sort want-list 'gnus-article-header-less))
+ (goto-char (point-min))
+ (while want-list
+ (insert (pop want-list)))
+ (add-text-properties
+ (point) (point-max)
+ (nconc (list 'gnus-type 'headers) gnus-hidden-properties))
+ )))
+
+(defun tm-gnus/content-header-filter ()
+ (tm-gnus/preview-cut-header)
+ (mime/decode-message-header)
+ )
+
+
+;;; @ set up
+;;;
+
+(set-alist 'mime-viewer/content-header-filter-alist
+ 'gnus-original-article-mode
+ (function tm-gnus/content-header-filter))
+
;;; @ for BBDB
;;;
projects / elisp / tm.git / blobdiff