tm-partial.el

   1 ;;;
   2 ;;; tm-partial.el --- Grabbing all MIME "message/partial"s.
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994 OKABE Yasuo
   6 ;;; Copyright (C) 1995 MORIOKA Tomohiko
   7 ;;;
   8 ;;; Author: OKABE Yasuo @ Kyoto University
   9 ;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
  10 ;;; Version:
  11 ;;;     $Id: tm-partial.el,v 7.11 1995/11/16 15:51:10 morioka Exp $
  12 ;;; Keywords: mail, news, MIME, multimedia, message/partial
  13 ;;;
  14 ;;; This file is a part of tm (Tools for MIME).
  15 ;;;
  16
  17 (require 'tm-view)
  18 (require 'tm-play)
  19
  20 (defvar tm-partial/preview-article-method-alist nil)
  21
  22 ;; display Article at the cursor in Subject buffer.
  23 (defun tm-partial/preview-article (target)
  24   (let ((f (assq target tm-partial/preview-article-method-alist)))
  25     (if f
  26         (funcall (cdr f))
  27       (error "Fatal. Unsupported mode")
  28       )))
  29
  30 (defun mime-article/grab-message/partials (beg end cal)
  31   (interactive)
  32   (let* ((id (cdr (assoc "id" cal)))
  33          (buffer (generate-new-buffer id))
  34          (mother mime::article/preview-buffer)
  35          (target (cdr (assq 'major-mode cal)))
  36          (article-buffer (buffer-name (current-buffer)))
  37          (subject-buf (eval (cdr (assq 'summary-buffer-exp cal))))
  38          subject-id
  39          (root-dir (expand-file-name
  40                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
  41          full-file)
  42     (setq root-dir (concat root-dir "/" (replace-as-filename id)))
  43     (setq full-file (concat root-dir "/FULL"))
  44
  45     (if (null target)
  46         (error "%s is not supported. Sorry." target)
  47       )
  48
  49     ;; if you can't parse the subject line, try simple decoding method
  50     (if (or (file-exists-p full-file)
  51             (not (y-or-n-p "Merge partials?"))
  52             )
  53         (progn
  54           (kill-buffer buffer)
  55           (mime-article/decode-message/partial beg end cal)
  56           )
  57       (let (cinfo the-id parameters)
  58         (setq subject-id (rfc822/get-field-body "Subject"))
  59         (if (string-match "[0-9\n]+" subject-id)
  60             (setq subject-id (substring subject-id 0 (match-beginning 0)))
  61           )
  62         (pop-to-buffer subject-buf)
  63         (while (search-backward subject-id nil t)
  64           )
  65         (catch 'tag
  66           (while t
  67             (tm-partial/preview-article target)
  68             (pop-to-buffer article-buffer)
  69             (switch-to-buffer mime::article/preview-buffer)
  70             (setq cinfo
  71                   (mime::preview-content-info/content-info
  72                    (car mime::preview/content-list)))
  73             (setq parameters (mime::content-info/parameters cinfo))
  74             (setq the-id (assoc-value "id" parameters))
  75             (if (equal the-id id)
  76                 (progn
  77                   (switch-to-buffer article-buffer)
  78                   (mime-article/decode-message/partial
  79                    (point-min)(point-max) parameters)
  80                   (if (file-exists-p full-file)
  81                       (throw 'tag nil)
  82                     )
  83                   ))
  84             (if (not (progn
  85                        (pop-to-buffer subject-buf)
  86                        (end-of-line)
  87                        (search-forward subject-id nil t)
  88                        ))
  89                 (error "not found")
  90               )
  91             ))))))
  92
  93
  94 ;;; @ end
  95 ;;;
  96
  97 (provide 'tm-partial)
  98
  99 (run-hooks 'tm-partial-load-hook)