tm-partial.el

   1 ;;;
   2 ;;; tm-partial.el
   3 ;;;
   4 ;;; Grabbing all MIME "message/partial"s.
   5 ;;; by Yasuo OKABE @ Kyoto University 1994
   6 ;;; modified by MORIOKA Tomohiko
   7 ;;;         and Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
   8 ;;;
   9 ;;; original file is
  10 ;;;  gif.el written by Art Mellor @ Cayman Systems, Inc. 1991
  11 ;;;
  12 ;;; This file is a part of tm (Tools for MIME).
  13 ;;;
  14 ;;; $Id: tm-partial.el,v 7.0 1995/10/18 08:19:27 morioka Exp $
  15 ;;;
  16
  17 (require 'tm-view)
  18
  19 ;; This regular expression controls what types of subject lines can be
  20 ;; parsed. Currently handles lines like:
  21 ;;      foo [1/3]
  22 ;;      foo (1/3)
  23 ;;      foo 1/3
  24 ;;      foo [1 of 3]
  25 ;;      foo (1 of 3)
  26 ;;      foo 1 of 3
  27 ;;      foo1 of 3
  28
  29 (defvar mime/gp:subject-start-regexp "[ \t]*\\(v[0-9]+i[0-9]+:[ \t]+\\)?")
  30
  31 (defvar mime/gp:subject-end-regexp
  32   "\\([[(]?\\)\\([0-9]+\\)\\(/\\| [oO][fF] \\)\\([0-9]+\\)\\([])]?\\)[ \t]*$")
  33
  34 ;; display Article at the cursor in Subject buffer.
  35 (defun mime/gp:display-article ()
  36   (save-excursion
  37     (cond
  38      ((eq target 'gnus4)
  39       (let ((gnus-show-all-headers t))
  40         (gnus-summary-display-article (gnus-summary-article-number))
  41         ))
  42      ((eq target 'mh-e)
  43       (mh-show)
  44       )
  45      ((eq target 'vm)
  46       (let ((vm-follow-summary-cursor t))
  47         (vm-follow-summary-cursor)
  48         (vm-select-folder-buffer)
  49         (vm-check-for-killed-summary)
  50         (vm-error-if-folder-empty)
  51         (vm-display (current-buffer) t '(tm-vm/view-message)
  52                     '(tm-vm/view-mesage reading-message))
  53         (vm-widen-page)
  54         (goto-char (point-max))
  55         (widen)
  56         (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
  57         (goto-char (point-min))
  58         ))
  59      (t (error "Fatal. Unsupported mode")))))
  60
  61 (defun mime/decode-message/grab-partials (beg end cal)
  62   (interactive)
  63   (let* ((id (cdr (assoc "id" cal)))
  64          (number (cdr (assoc "number" cal)))
  65          (total (cdr (assoc "total" cal)))
  66          (buffer (generate-new-buffer id))
  67          (mother mime::article/preview-buffer)
  68          target
  69          subject-buf
  70          (article-buf (buffer-name (current-buffer)))
  71          (subject-id nil)
  72          (part-num 1)
  73          (part-missing nil))
  74     (cond ((or (eq major-mode 'gnus-article-mode)
  75                (eq major-mode 'gnus-original-article-mode)
  76                )
  77            (setq subject-buf gnus-summary-buffer)
  78            (setq target 'gnus4)
  79            )
  80           ((eq major-mode 'mh-show-mode)
  81            (string-match "^show-\\(.+\\)$" article-buf)
  82            (setq subject-buf
  83                  (substring article-buf (match-beginning 1) (match-end 1)))
  84            (setq target 'mh-e)
  85            )
  86           ((eq major-mode 'vm-mode)
  87            (setq subject-buf vm-summary-buffer)
  88            (setq target 'vm)
  89            )
  90           (t (error "%s is not supported. Sorry." major-mode)))
  91
  92     (if (and (eq beg (point-min)) (eq end (point-max)))
  93         (save-excursion
  94           (goto-char (point-min))
  95           (re-search-forward "^$")
  96           (let ((delim (match-beginning 0)))
  97             (goto-char (point-min))
  98             (if (re-search-forward "^[Ss]ubject:.*$" delim t)
  99                 (let ((tail (match-end 0)))
 100                   (beginning-of-line)
 101                   (re-search-forward (concat "^[Ss]ubject:" mime/gp:subject-start-regexp) tail t)
 102                   (let ((start (point)))
 103                     (if (and (re-search-forward mime/gp:subject-end-regexp tail t)
 104                              (eq (string-to-int number)
 105                                  (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))
 106                              (eq (string-to-int total)
 107                                  (string-to-int (buffer-substring (match-beginning 4) (match-end 4)))))
 108                         (setq subject-id (buffer-substring start (match-end 1)))
 109                       (setq part-missing (string-to-int number)))))
 110               (setq part-missing t))))
 111       (setq part-missing t))
 112
 113     ;; if you can't parse the subject line, try simple decoding method
 114     (if (or part-missing
 115             (not (y-or-n-p "Merge partials?")))
 116         (progn
 117           (kill-buffer buffer)
 118           (mime/decode-message/partial-region beg end cal))
 119       (progn
 120         (set-buffer subject-buf)
 121         (setq part-missing (mime/gp:part-missing-p subject-id (string-to-int total)))
 122         (if part-missing
 123             (progn
 124               (kill-buffer buffer)
 125               (error "Couldn't find part %d" part-missing)))
 126         (save-excursion
 127           (while (<= part-num (string-to-int total))
 128             (goto-char (point-min))
 129             (message "Grabbing part %d of %d" part-num (string-to-int total))
 130             (re-search-forward
 131                       (concat (regexp-quote subject-id) "0*"
 132                               (int-to-string part-num)) nil t)
 133             (mime/gp:display-article)
 134             (save-excursion
 135               (set-buffer article-buf)
 136               (goto-char (point-min))
 137               (re-search-forward "^$")
 138               (let ((delimit (1+ (point))))
 139                 (goto-char (point-min))
 140                 (if (not
 141                      (let ((params (cdr (mime/Content-Type))))
 142                        (and (equal (assoc-value "id" params) id)
 143                             (= (string-to-int (assoc-value "number" params))
 144                                part-num)
 145                             )))
 146                     (progn
 147                       (kill-buffer buffer)
 148                       (error "Couldn't find part %d" part-num)))
 149                 (if (< delimit (point-max))
 150                     (append-to-buffer buffer delimit (point-max))
 151                   )))
 152             (setq part-num (+ part-num 1))))
 153         (mime/gp:display-article)
 154         (save-excursion
 155           (set-buffer article-buf)
 156           ;; (make-variable-buffer-local 'mime/content-list)
 157           ;; (setq mime/content-list (mime/parse-contents))
 158           (make-variable-buffer-local 'mime::article/content-info)
 159           (setq mime::article/content-info (mime/parse-message))
 160           )
 161         (delete-other-windows)
 162         (switch-to-buffer buffer)
 163         (goto-char (point-min))
 164         (setq major-mode 'mime/show-message-mode)
 165         (mime/viewer-mode mother)
 166         (pop-to-buffer (current-buffer))
 167         ))))
 168
 169 ;; Check if all the parts are there
 170 (defun mime/gp:part-missing-p (subject-string num-parts)
 171   (save-excursion
 172     (let ((part-num 1)
 173           (cant-find nil))
 174
 175       (while (and (<= part-num num-parts) (not cant-find))
 176         (goto-char (point-min))
 177         ;; If the parts are numbered 01/10, then chop off the leading 0
 178         (if (not (re-search-forward
 179                   (concat (regexp-quote subject-id) "0*"
 180                           (int-to-string part-num))
 181                   nil t))
 182             (setq cant-find part-num)
 183           (progn
 184             (message "Found part %d of %d." part-num num-parts)
 185             (setq part-num (+ part-num 1)))))
 186       cant-find)))
 187
 188
 189 ;;; @ set up
 190 ;;;
 191
 192 (set-atype 'mime/content-decoding-condition
 193            '((type . "message/partial")
 194              (method . mime/decode-message/grab-partials)
 195              (major-mode . gnus-article-mode)
 196              ))
 197
 198 (set-atype 'mime/content-decoding-condition
 199            '((type . "message/partial")
 200              (method . mime/decode-message/grab-partials)
 201              (major-mode . gnus-original-article-mode)
 202              ))
 203
 204 (set-atype 'mime/content-decoding-condition
 205            '((type . "message/partial")
 206              (method . mime/decode-message/grab-partials)
 207              (major-mode . mh-show-mode)
 208              ))
 209
 210 (set-atype 'mime/content-decoding-condition
 211            '((type . "message/partial")
 212              (method . mime/decode-message/grab-partials)
 213              (major-mode . vm-mode)
 214              ))
 215
 216 (provide 'tm-partial)