tm-partial.el

   1 ;;; tm-partial.el --- Grabbing all MIME "message/partial"s.
   2
   3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
   4
   5 ;; Author: OKABE Yasuo @ Kyoto University
   6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;; Version:
   8 ;;      $Id: tm-partial.el,v 7.13 1996/08/30 04:27:52 morioka Exp $
   9 ;; Keywords: mail, news, MIME, multimedia, message/partial
  10
  11 ;; This file is a part of tm (Tools for MIME).
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Code:
  29
  30 (require 'tm-view)
  31 (require 'tm-play)
  32
  33 (defvar tm-partial/preview-article-method-alist nil)
  34
  35 ;; display Article at the cursor in Subject buffer.
  36 (defun tm-partial/preview-article (target)
  37   (let ((f (assq target tm-partial/preview-article-method-alist)))
  38     (if f
  39         (funcall (cdr f))
  40       (error "Fatal. Unsupported mode")
  41       )))
  42
  43 (defun mime-article/grab-message/partials (beg end cal)
  44   (interactive)
  45   (let* ((id (cdr (assoc "id" cal)))
  46          (buffer (generate-new-buffer id))
  47          (mother mime::article/preview-buffer)
  48          (target (cdr (assq 'major-mode cal)))
  49          (article-buffer (buffer-name (current-buffer)))
  50          (subject-buf (eval (cdr (assq 'summary-buffer-exp cal))))
  51          subject-id
  52          (root-dir (expand-file-name
  53                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
  54          full-file)
  55     (setq root-dir (concat root-dir "/" (replace-as-filename id)))
  56     (setq full-file (concat root-dir "/FULL"))
  57
  58     (if (null target)
  59         (error "%s is not supported. Sorry." target)
  60       )
  61
  62     ;; if you can't parse the subject line, try simple decoding method
  63     (if (or (file-exists-p full-file)
  64             (not (y-or-n-p "Merge partials?"))
  65             )
  66         (progn
  67           (kill-buffer buffer)
  68           (mime-article/decode-message/partial beg end cal)
  69           )
  70       (let (cinfo the-id parameters)
  71         (setq subject-id (std11-field-body "Subject"))
  72         (if (string-match "[0-9\n]+" subject-id)
  73             (setq subject-id (substring subject-id 0 (match-beginning 0)))
  74           )
  75         (pop-to-buffer subject-buf)
  76         (while (search-backward subject-id nil t)
  77           )
  78         (catch 'tag
  79           (while t
  80             (tm-partial/preview-article target)
  81             (pop-to-buffer article-buffer)
  82             (switch-to-buffer mime::article/preview-buffer)
  83             (setq cinfo
  84                   (mime::preview-content-info/content-info
  85                    (car mime::preview/content-list)))
  86             (setq parameters (mime::content-info/parameters cinfo))
  87             (setq the-id (assoc-value "id" parameters))
  88             (if (equal the-id id)
  89                 (progn
  90                   (switch-to-buffer article-buffer)
  91                   (mime-article/decode-message/partial
  92                    (point-min)(point-max) parameters)
  93                   (if (file-exists-p full-file)
  94                       (throw 'tag nil)
  95                     )
  96                   ))
  97             (if (not (progn
  98                        (pop-to-buffer subject-buf)
  99                        (end-of-line)
 100                        (search-forward subject-id nil t)
 101                        ))
 102                 (error "not found")
 103               )
 104             ))))))
 105
 106
 107 ;;; @ end
 108 ;;;
 109
 110 (provide 'tm-partial)
 111
 112 (run-hooks 'tm-partial-load-hook)
 113
 114 ;;; tm-partial.el ends here