1 ;;; mmelmo-imap4-1.el -- MM backend of IMAP4 for ELMO (for FLIM 1.12.x).
3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
34 (defvar mmelmo-imap4-threshold nil)
35 (defvar mmelmo-imap4-skipped-parts nil)
36 (defvar mmelmo-imap4-current-message-structure nil)
38 (defun mmelmo-imap4-node-id-to-string (node-id)
39 (let ((i (length node-id))
45 (concat "." (int-to-string
46 (+ 1 (nth (- i 1) node-id))))
48 (+ 1 (nth (- i 1) node-id))
53 ;; parse IMAP4 body structure entity recursively.
54 (defun mmelmo-imap4-parse-bodystructure-entity (location node-id entity parent)
56 ((listp (car entity));; multipart
62 (make-mime-entity-internal 'elmo-imap4
69 (while (and (setq cur-entity (car entity))
74 (mmelmo-imap4-parse-bodystructure-entity
75 (list (nth 0 location)
78 (append (list num) node-id))
79 (append (list num) node-id)
81 ret-val ; myself as parent
84 (setq entity (cdr entity))
86 (mime-entity-set-children-internal ret-val children)
87 (setq content-type (list (cons 'type 'multipart)))
88 (setq content-type (append content-type
91 (downcase (car entity)))))))
92 (setq content-type (append content-type
93 (mime-parse-parameters-from-list
94 (elmo-imap4-nth 1 entity))))
95 (mime-entity-set-content-type-internal ret-val content-type)
98 (let (content-type result)
99 ;; append size information into location
100 (setq location (append location (list (nth 6 entity))))
101 (setq content-type (list (cons 'type (intern (downcase (car entity))))))
102 (if (elmo-imap4-nth 1 entity)
103 (setq content-type (append content-type
108 (elmo-imap4-nth 1 entity))))))))
109 (if (elmo-imap4-nth 2 entity)
110 (setq content-type (append content-type
111 (mime-parse-parameters-from-list
112 (elmo-imap4-nth 2 entity)))))
113 (setq result (make-mime-entity-internal 'elmo-imap4
115 content-type ; content-type
120 (mime-entity-set-encoding-internal result
121 (and (elmo-imap4-nth 5 entity)
123 (elmo-imap4-nth 5 entity))))
126 (defun mmelmo-imap4-parse-bodystructure-string (location string)
128 (let ((tmp-buffer (get-buffer-create " *ELMO bodystructure TMP*"))
129 (raw-buffer (current-buffer))
132 (set-buffer tmp-buffer)
135 (goto-char (point-min))
136 (when (search-forward "FETCH" nil t)
137 (narrow-to-region (match-end 0) (point-max))
138 (while (re-search-forward "{\\([0-9]+\\)}\r\n" nil t)
139 (goto-char (+ (point)
140 (string-to-int (elmo-match-buffer 1))))
141 (setq str (buffer-substring (match-end 0) (point)))
142 (delete-region (match-beginning 0) (point))
143 (insert (prin1-to-string str))); (insert "\""))
145 (nth 1 (memq 'BODYSTRUCTURE
146 (read (buffer-string)))))
147 (set-buffer raw-buffer)
148 (mmelmo-imap4-parse-bodystructure-entity location nil entity nil)
151 (defun mmelmo-imap4-multipart-p (entity)
152 (eq (cdr (assq 'type (mime-entity-content-type entity))) 'multipart)
155 (defun mmelmo-imap4-rfc822part-p (entity)
156 (eq (cdr (assq 'type (mime-entity-content-type entity))) 'rfc822)
159 (defun mmelmo-imap4-textpart-p (entity)
160 (eq (cdr (assq 'type (mime-entity-content-type entity))) 'text)
163 (defun mmelmo-imap4-get-mime-entity (location)
165 (let* ((spec (elmo-folder-get-spec (nth 0 location)))
166 (msg (nth 1 location))
167 (connection (elmo-imap4-get-connection spec))
168 (process (elmo-imap4-connection-get-process connection))
170 response errmsg ret-val bytes)
171 (when (elmo-imap4-spec-mailbox spec)
173 (when (not (string= (elmo-imap4-connection-get-cwf connection)
174 (elmo-imap4-spec-mailbox spec)))
175 (if (null (setq response
176 (elmo-imap4-select-folder
177 (elmo-imap4-spec-mailbox spec) connection)))
178 (error "Select folder failed")))
179 (elmo-imap4-send-command (process-buffer process)
181 (format "uid fetch %s bodystructure"
183 (if (null (setq response (elmo-imap4-read-contents
184 (process-buffer process) process)))
185 (error "Fetching body structure failed")))
186 (mmelmo-imap4-parse-bodystructure-string location
187 response); make mime-entity
190 (defun mmelmo-imap4-read-part (entity location)
191 (if (or (not mmelmo-imap4-threshold)
192 (not (nth 4 location))
193 (and (nth 4 location)
194 mmelmo-imap4-threshold
195 (<= (nth 4 location) mmelmo-imap4-threshold)))
196 (cond ((mmelmo-imap4-multipart-p entity)) ; noop
198 (insert (elmo-imap4-read-part
201 (mmelmo-imap4-node-id-to-string
203 (mime-entity-set-body-start-internal entity (point-min))
204 (mime-entity-set-body-end-internal entity (point-max))))
205 (setq mmelmo-imap4-skipped-parts
207 mmelmo-imap4-skipped-parts
208 (list (mmelmo-imap4-node-id-to-string
209 (nth 3 location)))))))
211 (defun mmelmo-imap4-read-body (entity)
212 (let ((location (mime-entity-location-internal entity)))
213 (mime-entity-set-body-start-internal entity (- (point) 1))
214 (if (or (not mmelmo-imap4-threshold)
215 (not (nth 4 location))
216 (and (nth 4 location)
217 mmelmo-imap4-threshold
218 (<= (nth 4 location) mmelmo-imap4-threshold)))
219 (insert (elmo-imap4-read-part (nth 0 location)
223 (setq mmelmo-imap4-skipped-parts
225 mmelmo-imap4-skipped-parts
227 (mmelmo-imap4-node-id-to-string
228 (nth 3 location))))))))
230 ;;; mm-backend definitions for elmo-imap4
231 (mm-define-backend elmo-imap4 (elmo))
233 (mm-define-method initialize-instance ((entity elmo-imap4))
234 (let ((new-entity (mmelmo-imap4-get-mime-entity
235 (mime-entity-location-internal entity))))
238 (mime-entity-location-internal new-entity))
239 (mime-entity-set-content-type-internal
241 (mime-entity-content-type-internal new-entity))
242 (mime-entity-set-encoding-internal
244 (mime-entity-encoding-internal new-entity))
245 (mime-entity-set-children-internal
247 (mime-entity-children-internal new-entity))
248 (mime-entity-set-body-start-internal
250 (mime-entity-body-start-internal new-entity))
251 (mime-entity-set-body-end-internal
253 (mime-entity-body-end-internal new-entity))))
255 (mm-define-method entity-buffer ((entity elmo-imap4))
256 (let ((buffer (get-buffer-create
257 (concat mmelmo-entity-buffer-name
258 (mmelmo-imap4-node-id-to-string
259 (mime-entity-node-id-internal entity)))))
260 (location (mime-entity-location-internal entity)))
262 (mmelmo-original-mode)
263 (mime-entity-set-buffer-internal entity buffer) ; set buffer.
264 (let ((buffer-read-only nil))
266 (if (nth 3 location) ; not top
268 (setq mime-message-structure mmelmo-imap4-current-message-structure)
269 (mmelmo-imap4-read-part entity location))
271 (setq mmelmo-imap4-current-message-structure entity)
272 (setq mime-message-structure entity)
273 (setq mmelmo-imap4-skipped-parts nil)
274 ;; (setq mmelmo-fetched-entire-message nil)
276 (insert (elmo-imap4-read-part (nth 0 location)
280 (mime-entity-set-header-start-internal entity (point-min))
281 (mime-entity-set-header-end-internal entity (- (point) 1))
282 (if (not (mime-entity-children-internal entity)) ; body part!
284 (mmelmo-imap4-read-body entity)
285 (mime-entity-set-body-end-internal entity (point))
289 (mm-define-method entity-point-min ((entity elmo-imap4))
290 (let ((buffer (mime-entity-buffer-internal entity)))
294 (mm-define-method entity-point-max ((entity elmo-imap4))
295 (let ((buffer (mime-entity-buffer-internal entity)))
299 (mm-define-method entity-children ((entity elmo-imap4))
300 (let* ((content-type (mime-entity-content-type entity))
301 (primary-type (mime-content-type-primary-type content-type)))
302 (cond ((eq primary-type 'multipart)
303 (mime-parse-multipart entity)
305 ((and (eq primary-type 'message)
306 (memq (mime-content-type-subtype content-type)
307 '(rfc822 news external-body)
310 (set-buffer (mime-entity-buffer-internal entity))
311 (mime-entity-set-body-start-internal entity (point-min))
312 (mime-entity-set-body-end-internal entity (point-max)))
313 (mime-parse-encapsulated entity)
317 (mm-define-method entity-body-start ((entity elmo-imap4))
320 (mm-define-method entity-body-end ((entity elmo-imap4))
323 ;; override generic function for dynamic body fetching.
324 (mm-define-method entity-content ((entity elmo-imap4))
326 (set-buffer (mime-entity-buffer entity))
328 (buffer-substring (mime-entity-body-start entity)
329 (mime-entity-body-end entity))
330 (mime-entity-encoding entity))))
332 (mm-define-method fetch-field ((entity elmo-imap4) field-name)
334 (let ((buf (mime-entity-buffer-internal entity)))
338 (if (and (mime-entity-header-start-internal entity)
339 (mime-entity-header-end-internal entity))
342 (mime-entity-header-start-internal entity)
343 (mime-entity-header-end-internal entity))
344 (std11-fetch-field field-name))
347 (provide 'mmelmo-imap4-1)
349 ;;; mmelmo-imap4-1.el ends here