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