-;;;
-;;; tm-partial.el
-;;;
-;;; Grabbing all MIME "message/partial"s.
-;;; by Yasuo OKABE @ Kyoto University 1994
-;;; modified by MORIOKA Tomohiko
-;;; and Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
-;;;
-;;; original file is
-;;; gif.el written by Art Mellor @ Cayman Systems, Inc. 1991
-;;;
-;;; This file is a part of tm (Tools for MIME).
-;;;
-;;; $Id: tm-partial.el,v 7.0 1995/10/18 08:19:27 morioka Exp $
-;;;
+;;; tm-partial.el --- Grabbing all MIME "message/partial"s.
-(require 'tm-view)
+;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
-;; This regular expression controls what types of subject lines can be
-;; parsed. Currently handles lines like:
-;; foo [1/3]
-;; foo (1/3)
-;; foo 1/3
-;; foo [1 of 3]
-;; foo (1 of 3)
-;; foo 1 of 3
-;; foo1 of 3
+;; Author: OKABE Yasuo @ Kyoto University
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version:
+;; $Id: tm-partial.el,v 7.13 1996/08/30 04:27:52 morioka Exp $
+;; Keywords: mail, news, MIME, multimedia, message/partial
-(defvar mime/gp:subject-start-regexp "[ \t]*\\(v[0-9]+i[0-9]+:[ \t]+\\)?")
+;; This file is a part of tm (Tools for MIME).
-(defvar mime/gp:subject-end-regexp
- "\\([[(]?\\)\\([0-9]+\\)\\(/\\| [oO][fF] \\)\\([0-9]+\\)\\([])]?\\)[ \t]*$")
+;; 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.
-;; display Article at the cursor in Subject buffer.
-(defun mime/gp:display-article ()
- (save-excursion
- (cond
- ((eq target 'gnus4)
- (let ((gnus-show-all-headers t))
- (gnus-summary-display-article (gnus-summary-article-number))
- ))
- ((eq target 'mh-e)
- (mh-show)
- )
- ((eq target 'vm)
- (let ((vm-follow-summary-cursor t))
- (vm-follow-summary-cursor)
- (vm-select-folder-buffer)
- (vm-check-for-killed-summary)
- (vm-error-if-folder-empty)
- (vm-display (current-buffer) t '(tm-vm/view-message)
- '(tm-vm/view-mesage reading-message))
- (vm-widen-page)
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
- (goto-char (point-min))
- ))
- (t (error "Fatal. Unsupported mode")))))
+;; 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; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
-(defun mime/decode-message/grab-partials (beg end cal)
+(require 'tm-view)
+(require 'tm-play)
+
+(defvar tm-partial/preview-article-method-alist nil)
+
+;; display Article at the cursor in Subject buffer.
+(defun tm-partial/preview-article (target)
+ (let ((f (assq target tm-partial/preview-article-method-alist)))
+ (if f
+ (funcall (cdr f))
+ (error "Fatal. Unsupported mode")
+ )))
+
+(defun mime-article/grab-message/partials (beg end cal)
(interactive)
(let* ((id (cdr (assoc "id" cal)))
- (number (cdr (assoc "number" cal)))
- (total (cdr (assoc "total" cal)))
(buffer (generate-new-buffer id))
(mother mime::article/preview-buffer)
- target
- subject-buf
- (article-buf (buffer-name (current-buffer)))
- (subject-id nil)
- (part-num 1)
- (part-missing nil))
- (cond ((or (eq major-mode 'gnus-article-mode)
- (eq major-mode 'gnus-original-article-mode)
- )
- (setq subject-buf gnus-summary-buffer)
- (setq target 'gnus4)
- )
- ((eq major-mode 'mh-show-mode)
- (string-match "^show-\\(.+\\)$" article-buf)
- (setq subject-buf
- (substring article-buf (match-beginning 1) (match-end 1)))
- (setq target 'mh-e)
- )
- ((eq major-mode 'vm-mode)
- (setq subject-buf vm-summary-buffer)
- (setq target 'vm)
- )
- (t (error "%s is not supported. Sorry." major-mode)))
+ (target (cdr (assq 'major-mode cal)))
+ (article-buffer (buffer-name (current-buffer)))
+ (subject-buf (eval (cdr (assq 'summary-buffer-exp cal))))
+ subject-id
+ (root-dir (expand-file-name
+ (concat "m-prts-" (user-login-name)) mime/tmp-dir))
+ full-file)
+ (setq root-dir (concat root-dir "/" (replace-as-filename id)))
+ (setq full-file (concat root-dir "/FULL"))
+
+ (if (null target)
+ (error "%s is not supported. Sorry." target)
+ )
- (if (and (eq beg (point-min)) (eq end (point-max)))
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "^$")
- (let ((delim (match-beginning 0)))
- (goto-char (point-min))
- (if (re-search-forward "^[Ss]ubject:.*$" delim t)
- (let ((tail (match-end 0)))
- (beginning-of-line)
- (re-search-forward (concat "^[Ss]ubject:" mime/gp:subject-start-regexp) tail t)
- (let ((start (point)))
- (if (and (re-search-forward mime/gp:subject-end-regexp tail t)
- (eq (string-to-int number)
- (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))
- (eq (string-to-int total)
- (string-to-int (buffer-substring (match-beginning 4) (match-end 4)))))
- (setq subject-id (buffer-substring start (match-end 1)))
- (setq part-missing (string-to-int number)))))
- (setq part-missing t))))
- (setq part-missing t))
-
;; if you can't parse the subject line, try simple decoding method
- (if (or part-missing
- (not (y-or-n-p "Merge partials?")))
+ (if (or (file-exists-p full-file)
+ (not (y-or-n-p "Merge partials?"))
+ )
(progn
(kill-buffer buffer)
- (mime/decode-message/partial-region beg end cal))
- (progn
- (set-buffer subject-buf)
- (setq part-missing (mime/gp:part-missing-p subject-id (string-to-int total)))
- (if part-missing
- (progn
- (kill-buffer buffer)
- (error "Couldn't find part %d" part-missing)))
- (save-excursion
- (while (<= part-num (string-to-int total))
- (goto-char (point-min))
- (message "Grabbing part %d of %d" part-num (string-to-int total))
- (re-search-forward
- (concat (regexp-quote subject-id) "0*"
- (int-to-string part-num)) nil t)
- (mime/gp:display-article)
- (save-excursion
- (set-buffer article-buf)
- (goto-char (point-min))
- (re-search-forward "^$")
- (let ((delimit (1+ (point))))
- (goto-char (point-min))
- (if (not
- (let ((params (cdr (mime/Content-Type))))
- (and (equal (assoc-value "id" params) id)
- (= (string-to-int (assoc-value "number" params))
- part-num)
- )))
- (progn
- (kill-buffer buffer)
- (error "Couldn't find part %d" part-num)))
- (if (< delimit (point-max))
- (append-to-buffer buffer delimit (point-max))
- )))
- (setq part-num (+ part-num 1))))
- (mime/gp:display-article)
- (save-excursion
- (set-buffer article-buf)
- ;; (make-variable-buffer-local 'mime/content-list)
- ;; (setq mime/content-list (mime/parse-contents))
- (make-variable-buffer-local 'mime::article/content-info)
- (setq mime::article/content-info (mime/parse-message))
- )
- (delete-other-windows)
- (switch-to-buffer buffer)
- (goto-char (point-min))
- (setq major-mode 'mime/show-message-mode)
- (mime/viewer-mode mother)
- (pop-to-buffer (current-buffer))
- ))))
-
-;; Check if all the parts are there
-(defun mime/gp:part-missing-p (subject-string num-parts)
- (save-excursion
- (let ((part-num 1)
- (cant-find nil))
-
- (while (and (<= part-num num-parts) (not cant-find))
- (goto-char (point-min))
- ;; If the parts are numbered 01/10, then chop off the leading 0
- (if (not (re-search-forward
- (concat (regexp-quote subject-id) "0*"
- (int-to-string part-num))
- nil t))
- (setq cant-find part-num)
- (progn
- (message "Found part %d of %d." part-num num-parts)
- (setq part-num (+ part-num 1)))))
- cant-find)))
-
-
-;;; @ set up
+ (mime-article/decode-message/partial beg end cal)
+ )
+ (let (cinfo the-id parameters)
+ (setq subject-id (std11-field-body "Subject"))
+ (if (string-match "[0-9\n]+" subject-id)
+ (setq subject-id (substring subject-id 0 (match-beginning 0)))
+ )
+ (pop-to-buffer subject-buf)
+ (while (search-backward subject-id nil t)
+ )
+ (catch 'tag
+ (while t
+ (tm-partial/preview-article target)
+ (pop-to-buffer article-buffer)
+ (switch-to-buffer mime::article/preview-buffer)
+ (setq cinfo
+ (mime::preview-content-info/content-info
+ (car mime::preview/content-list)))
+ (setq parameters (mime::content-info/parameters cinfo))
+ (setq the-id (assoc-value "id" parameters))
+ (if (equal the-id id)
+ (progn
+ (switch-to-buffer article-buffer)
+ (mime-article/decode-message/partial
+ (point-min)(point-max) parameters)
+ (if (file-exists-p full-file)
+ (throw 'tag nil)
+ )
+ ))
+ (if (not (progn
+ (pop-to-buffer subject-buf)
+ (end-of-line)
+ (search-forward subject-id nil t)
+ ))
+ (error "not found")
+ )
+ ))))))
+
+
+;;; @ end
;;;
-(set-atype 'mime/content-decoding-condition
- '((type . "message/partial")
- (method . mime/decode-message/grab-partials)
- (major-mode . gnus-article-mode)
- ))
-
-(set-atype 'mime/content-decoding-condition
- '((type . "message/partial")
- (method . mime/decode-message/grab-partials)
- (major-mode . gnus-original-article-mode)
- ))
-
-(set-atype 'mime/content-decoding-condition
- '((type . "message/partial")
- (method . mime/decode-message/grab-partials)
- (major-mode . mh-show-mode)
- ))
+(provide 'tm-partial)
-(set-atype 'mime/content-decoding-condition
- '((type . "message/partial")
- (method . mime/decode-message/grab-partials)
- (major-mode . vm-mode)
- ))
+(run-hooks 'tm-partial-load-hook)
-(provide 'tm-partial)
+;;; tm-partial.el ends here
projects / elisp / tm.git / blobdiff