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