enclosure (It's harmful in unplugged status).
* elmo-pop3.el (elmo-pop3-folder-exists-p): Ditto.
* mmelmo-1.el: Removed.
* mmelmo-2.el: Ditto.
* mmelmo-imap4-1.el: Ditto.
* mmelmo-imap4-2.el: Ditto.
* mmelmo-imap4.el: Merged mmelmo-imap4-2.el
* mmelmo.el: Merged mmelmo-2.el.
2000-10-20 Yuuichi Teranishi <teranisi@gohome.org>
+ * elmo-imap4.el (elmo-imap4-folder-exists-p): Removed `condition-case'
+ enclosure (It's harmful in unplugged status).
+
+ * elmo-pop3.el (elmo-pop3-folder-exists-p): Ditto.
+
+ * mmelmo-1.el: Removed.
+
+ * mmelmo-2.el: Ditto.
+
+ * mmelmo-imap4-1.el: Ditto.
+
+ * mmelmo-imap4-2.el: Ditto.
+
+ * mmelmo-imap4.el: Merged mmelmo-imap4-2.el
+
+ * mmelmo.el: Merged mmelmo-2.el.
+
* elmo-version.el (elmo-version): Up to 2.3.92.
2000-10-19 TAKAHASHI Kaoru <kaoru@kaisei.org>
(elmo-imap4-session-current-mailbox-internal session)
(elmo-imap4-spec-mailbox spec))
t
- (condition-case nil
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-spec-mailbox spec)
- 'force)
- (error nil)))))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-spec-mailbox spec)
+ 'force))))
(defun elmo-imap4-folder-creatable-p (spec)
t)
(save-excursion
(let (elmo-auto-change-plugged ; don't change plug status.
session)
- (condition-case nil
- (prog1
- (setq session (elmo-pop3-get-session spec))
- (if session
- (elmo-network-close-session session)))
- (error nil))))
+ (prog1
+ (setq session (elmo-pop3-get-session spec))
+ (if session
+ (elmo-network-close-session session)))))
t))
(defun elmo-pop3-parse-uidl-response (string)
+++ /dev/null
-;;; mmelmo-1.el -- mm-backend (for FLIM 1.12.x) by ELMO.
-
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Keywords: mail, net news
-
-;; This file is part of ELMO (Elisp Library for Message Orchestration).
-
-;; 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.
-;;
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-;;
-
-;;; Commentary:
-;;
-
-;;; Code:
-;;
-
-(require 'mime)
-(require 'mime-parse)
-(eval-when-compile
- (require 'std11))
-
-(require 'mmelmo)
-
-(defvar mmelmo-force-reload nil)
-(defvar mmelmo-sort-field-list nil)
-
-;;; mmelmo: Only the initialization method is different from mmbuffer.
-(mm-define-backend elmo (buffer))
-
-(mm-define-method initialize-instance ((entity elmo))
- (mime-entity-set-buffer-internal
- entity
- (get-buffer-create (concat mmelmo-entity-buffer-name "0")))
- (save-excursion
- (set-buffer (mime-entity-buffer-internal entity))
- (mmelmo-original-mode)
- (let ((buffer-read-only nil)
- (location (mime-entity-location-internal entity))
- header-start header-end body-start body-end)
- (erase-buffer)
- (setq mime-message-structure entity)
- (elmo-read-msg-with-buffer-cache (nth 0 location)
- (nth 1 location)
- (current-buffer)
- (nth 2 location)
- mmelmo-force-reload)
- (setq header-start (point-min))
- (setq body-end (point-max))
- (goto-char header-start)
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$\\|^$" )
- nil t)
- (setq header-end (match-beginning 0)
- body-start (if (= header-end body-end)
- body-end
- (1+ (match-end 0))))
- (setq header-end (point-min)
- body-start (point-min)))
- (save-restriction
- (narrow-to-region header-start header-end)
- (mime-entity-set-content-type-internal
- entity
- (let ((str (std11-fetch-field "Content-Type")))
- (if str
- (mime-parse-Content-Type str)
- )))
- )
- (mime-entity-set-header-start-internal entity header-start)
- (mime-entity-set-header-end-internal entity header-end)
- (mime-entity-set-body-start-internal entity body-start)
- (mime-entity-set-body-end-internal entity body-end)
- )))
-
-(mm-define-method insert-header ((entity elmo)
- &optional invisible-fields visible-fields)
- (mmelmo-insert-sorted-header-from-buffer
- (mime-entity-buffer entity)
- (mime-entity-header-start-internal entity)
- (mime-entity-header-end-internal entity)
- invisible-fields visible-fields))
-
-(mm-define-method insert-text-content ((entity elmo))
- (insert
- (decode-mime-charset-string (mime-entity-content entity)
- (or (mime-content-type-parameter
- (mime-entity-content-type entity)
- "charset")
- default-mime-charset)
- 'CRLF))
- (run-hooks 'mmelmo-entity-content-inserted-hook))
-
-(require 'product)
-(product-provide (provide 'mmelmo-1) (require 'elmo-version))
-
-;;; mmelmo-1.el ends here
+++ /dev/null
-;;; mmelmo-2.el -- mm-backend (for FLIM 1.13.x) by ELMO.
-
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Keywords: mail, net news
-
-;; This file is part of ELMO (Elisp Library for Message Orchestration).
-
-;; 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.
-;;
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-;;
-
-;;; Commentary:
-;;
-
-;;; Code:
-;;
-
-(require 'mmelmo-imap4)
-(require 'mmelmo)
-(require 'mmbuffer)
-
-(defvar mmelmo-force-reload nil)
-(defvar mmelmo-sort-field-list nil)
-
-(eval-and-compile
- (luna-define-class mime-elmo-entity (mime-buffer-entity)
- (imap folder number msgdb size))
- (luna-define-internal-accessors 'mime-elmo-entity))
-
-(luna-define-method initialize-instance :after ((entity mime-elmo-entity)
- &rest init-args)
- "The initialization method for elmo.
-mime-elmo-entity has its own member variable,
-`imap', `folder', `msgdb' and `size'.
-imap: boolean. if non-nil, entity becomes mime-elmo-imap4-entity class.
-folder: string. folder name.
-msgdb: msgdb of elmo.
-size: size of the entity."
- (if (mime-elmo-entity-imap-internal entity)
- ;; use imap part fetching.
- ;; child mime-entity's class becomes `mime-elmo-imap4-entity'
- ;; which implements `entity-buffer' method.
- (progn
- (let (new-entity)
- (mime-buffer-entity-set-buffer-internal entity nil)
- (setq new-entity
- (mmelmo-imap4-get-mime-entity
- (mime-elmo-entity-folder-internal entity) ; folder
- (mime-elmo-entity-number-internal entity) ; number
- (mime-elmo-entity-msgdb-internal entity) ; msgdb
- ))
- (mime-entity-set-content-type-internal
- entity
- (mime-entity-content-type-internal new-entity))
- (mime-entity-set-encoding-internal
- entity
- (mime-entity-encoding-internal new-entity))
- (mime-entity-set-children-internal
- entity
- (mime-entity-children-internal new-entity))
- (mime-elmo-entity-set-size-internal
- entity
- (mime-elmo-entity-size-internal new-entity))
- (mime-entity-set-representation-type-internal
- entity 'mime-elmo-imap4-entity)
- entity))
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (mmelmo-original-mode)
- (when (mime-root-entity-p entity)
- (let ((buffer-read-only nil)
- header-end body-start)
- (erase-buffer)
- (elmo-read-msg-with-buffer-cache
- (mime-elmo-entity-folder-internal entity)
- (mime-elmo-entity-number-internal entity)
- (current-buffer)
- (mime-elmo-entity-msgdb-internal entity)
- mmelmo-force-reload)
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$\\|^$" )
- nil t)
- (setq header-end (match-beginning 0)
- body-start (if (= (match-end 0) (point-max))
- (point-max)
- (1+ (match-end 0))))
- (setq header-end (point-min)
- body-start (point-min)))
- (mime-buffer-entity-set-header-start-internal entity (point-min))
- (mime-buffer-entity-set-header-end-internal entity header-end)
- (mime-buffer-entity-set-body-start-internal entity body-start)
- (mime-buffer-entity-set-body-end-internal entity (point-max))
- (save-restriction
- (narrow-to-region (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity))
- (mime-entity-set-content-type-internal
- entity
- (let ((str (std11-fetch-field "Content-Type")))
- (if str
- (mime-parse-Content-Type str)
- ))))))
- entity))
-
-(luna-define-method mime-insert-header ((entity mime-elmo-entity)
- &optional invisible-fields
- visible-fields)
- (mmelmo-insert-sorted-header-from-buffer
- (mime-buffer-entity-buffer-internal entity)
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity)
- invisible-fields visible-fields mmelmo-sort-field-list))
-
-(luna-define-method mime-insert-text-content :around ((entity
- mime-elmo-entity))
- (luna-call-next-method)
- (run-hooks 'mmelmo-entity-content-inserted-hook))
-
-;(luna-define-method mime-entity-content ((entity mime-elmo-entity))
-; (mime-decode-string
-; (with-current-buffer (mime-buffer-entity-buffer-internal entity)
-; (buffer-substring (mime-buffer-entity-body-start-internal entity)
-; (mime-buffer-entity-body-end-internal entity)))
-; (mime-entity-encoding entity)))
-
-(require 'product)
-(product-provide (provide 'mmelmo-2) (require 'elmo-version))
-
-;;; mmelmo-2.el ends here
+++ /dev/null
-;;; mmelmo-imap4-1.el -- MM backend of IMAP4 for ELMO (for FLIM 1.12.x).
-
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Keywords: mail, net news
-
-;; This file is part of ELMO (Elisp Library for Message Orchestration).
-
-;; 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.
-;;
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-;;
-
-;;; Commentary:
-;;
-
-;;; Code:
-;;
-
-(require 'mmelmo)
-
-(defvar mmelmo-imap4-threshold nil)
-(defvar mmelmo-imap4-skipped-parts nil)
-(defvar mmelmo-imap4-current-message-structure nil)
-
-(defun mmelmo-imap4-node-id-to-string (node-id)
- (let ((i (length node-id))
- result)
- (while (> i 0)
- (setq result
- (concat result
- (if result
- (concat "." (int-to-string
- (+ 1 (nth (- i 1) node-id))))
- (int-to-string (or
- (+ 1 (nth (- i 1) node-id))
- 0)))))
- (setq i (- i 1)))
- (or result "0")))
-
-;; parse IMAP4 body structure entity recursively.
-(defun mmelmo-imap4-parse-bodystructure-entity (location node-id entity parent)
- (cond
- ((listp (car entity));; multipart
- (let (cur-entity
- children
- content-type ret-val
- (num 0))
- (setq ret-val
- (make-mime-entity-internal 'elmo-imap4
- location
- nil ; content-type
- nil ; children
- parent ; parent
- node-id ; node-id
- ))
- (while (and (setq cur-entity (car entity))
- (listp cur-entity))
- (setq children
- (append children
- (list
- (mmelmo-imap4-parse-bodystructure-entity
- (list (nth 0 location)
- (nth 1 location)
- (nth 2 location)
- (append (list num) node-id))
- (append (list num) node-id)
- cur-entity
- ret-val ; myself as parent
- ))))
- (setq num (+ num 1))
- (setq entity (cdr entity))
- )
- (mime-entity-set-children-internal ret-val children)
- (setq content-type (list (cons 'type 'multipart)))
- (setq content-type (append content-type
- (list (cons 'subtype
- (intern
- (downcase (car entity)))))))
- (setq content-type (append content-type
- (mime-parse-parameters-from-list
- (elmo-imap4-nth 1 entity))))
- (mime-entity-set-content-type-internal ret-val content-type)
- ret-val))
- (t ;; singlepart
- (let (content-type result)
- ;; append size information into location
- (setq location (append location (list (nth 6 entity))))
- (setq content-type (list (cons 'type (intern (downcase (car entity))))))
- (if (elmo-imap4-nth 1 entity)
- (setq content-type (append content-type
- (list
- (cons 'subtype
- (intern
- (downcase
- (elmo-imap4-nth 1 entity))))))))
- (if (elmo-imap4-nth 2 entity)
- (setq content-type (append content-type
- (mime-parse-parameters-from-list
- (elmo-imap4-nth 2 entity)))))
- (setq result (make-mime-entity-internal 'elmo-imap4
- location
- content-type ; content-type
- nil ; children
- parent ; parent
- node-id ; node-id
- ))
- (mime-entity-set-encoding-internal result
- (and (elmo-imap4-nth 5 entity)
- (downcase
- (elmo-imap4-nth 5 entity))))
- result))))
-
-(defun mmelmo-imap4-parse-bodystructure-string (location string)
- (save-excursion
- (let ((tmp-buffer (get-buffer-create " *ELMO bodystructure TMP*"))
- (raw-buffer (current-buffer))
- str
- entity)
- (set-buffer tmp-buffer)
- (erase-buffer)
- (insert string)
- (goto-char (point-min))
- (when (search-forward "FETCH" nil t)
- (narrow-to-region (match-end 0) (point-max))
- (while (re-search-forward "{\\([0-9]+\\)}\r\n" nil t)
- (goto-char (+ (point)
- (string-to-int (elmo-match-buffer 1))))
- (setq str (buffer-substring (match-end 0) (point)))
- (delete-region (match-beginning 0) (point))
- (insert (prin1-to-string str))); (insert "\""))
- (setq entity
- (nth 1 (memq 'BODYSTRUCTURE
- (read (buffer-string)))))
- (set-buffer raw-buffer)
- (mmelmo-imap4-parse-bodystructure-entity location nil entity nil)
- ))))
-
-(defun mmelmo-imap4-multipart-p (entity)
- (eq (cdr (assq 'type (mime-entity-content-type entity))) 'multipart)
- )
-
-(defun mmelmo-imap4-rfc822part-p (entity)
- (eq (cdr (assq 'type (mime-entity-content-type entity))) 'rfc822)
- )
-
-(defun mmelmo-imap4-textpart-p (entity)
- (eq (cdr (assq 'type (mime-entity-content-type entity))) 'text)
- )
-
-(defun mmelmo-imap4-get-mime-entity (location)
- (save-excursion
- (let* ((spec (elmo-folder-get-spec (nth 0 location)))
- (msg (nth 1 location))
- (connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- (read-it t)
- response errmsg ret-val bytes)
- (when (elmo-imap4-spec-mailbox spec)
- (save-excursion
- (when (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (if (null (setq response
- (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec) connection)))
- (error "Select folder failed")))
- (elmo-imap4-send-command (process-buffer process)
- process
- (format "uid fetch %s bodystructure"
- msg))
- (if (null (setq response (elmo-imap4-read-contents
- (process-buffer process) process)))
- (error "Fetching body structure failed")))
- (mmelmo-imap4-parse-bodystructure-string location
- response); make mime-entity
- ))))
-
-(defun mmelmo-imap4-read-part (entity location)
- (if (or (not mmelmo-imap4-threshold)
- (not (nth 4 location))
- (and (nth 4 location)
- mmelmo-imap4-threshold
- (<= (nth 4 location) mmelmo-imap4-threshold)))
- (cond ((mmelmo-imap4-multipart-p entity)) ; noop
- (t
- (insert (elmo-imap4-read-part
- (nth 0 location)
- (nth 1 location)
- (mmelmo-imap4-node-id-to-string
- (nth 3 location))))
- (mime-entity-set-body-start-internal entity (point-min))
- (mime-entity-set-body-end-internal entity (point-max))))
- (setq mmelmo-imap4-skipped-parts
- (append
- mmelmo-imap4-skipped-parts
- (list (mmelmo-imap4-node-id-to-string
- (nth 3 location)))))))
-
-(defun mmelmo-imap4-read-body (entity)
- (let ((location (mime-entity-location-internal entity)))
- (mime-entity-set-body-start-internal entity (- (point) 1))
- (if (or (not mmelmo-imap4-threshold)
- (not (nth 4 location))
- (and (nth 4 location)
- mmelmo-imap4-threshold
- (<= (nth 4 location) mmelmo-imap4-threshold)))
- (insert (elmo-imap4-read-part (nth 0 location)
- (nth 1 location)
- "1"
- ))
- (setq mmelmo-imap4-skipped-parts
- (append
- mmelmo-imap4-skipped-parts
- (list
- (mmelmo-imap4-node-id-to-string
- (nth 3 location))))))))
-
-;;; mm-backend definitions for elmo-imap4
-(mm-define-backend elmo-imap4 (elmo))
-
-(mm-define-method initialize-instance ((entity elmo-imap4))
- (let ((new-entity (mmelmo-imap4-get-mime-entity
- (mime-entity-location-internal entity))))
- ;; ...
- (aset entity 1
- (mime-entity-location-internal new-entity))
- (mime-entity-set-content-type-internal
- entity
- (mime-entity-content-type-internal new-entity))
- (mime-entity-set-encoding-internal
- entity
- (mime-entity-encoding-internal new-entity))
- (mime-entity-set-children-internal
- entity
- (mime-entity-children-internal new-entity))
- (mime-entity-set-body-start-internal
- entity
- (mime-entity-body-start-internal new-entity))
- (mime-entity-set-body-end-internal
- entity
- (mime-entity-body-end-internal new-entity))))
-
-(mm-define-method entity-buffer ((entity elmo-imap4))
- (let ((buffer (get-buffer-create
- (concat mmelmo-entity-buffer-name
- (mmelmo-imap4-node-id-to-string
- (mime-entity-node-id-internal entity)))))
- (location (mime-entity-location-internal entity)))
- (set-buffer buffer)
- (mmelmo-original-mode)
- (mime-entity-set-buffer-internal entity buffer) ; set buffer.
- (let ((buffer-read-only nil))
- (erase-buffer)
- (if (nth 3 location) ; not top
- (progn
- (setq mime-message-structure mmelmo-imap4-current-message-structure)
- (mmelmo-imap4-read-part entity location))
- ;; TOP
- (setq mmelmo-imap4-current-message-structure entity)
- (setq mime-message-structure entity)
- (setq mmelmo-imap4-skipped-parts nil)
- ;; (setq mmelmo-fetched-entire-message nil)
- ;; header
- (insert (elmo-imap4-read-part (nth 0 location)
- (nth 1 location)
- "header"
- ))
- (mime-entity-set-header-start-internal entity (point-min))
- (mime-entity-set-header-end-internal entity (- (point) 1))
- (if (not (mime-entity-children-internal entity)) ; body part!
- (progn
- (mmelmo-imap4-read-body entity)
- (mime-entity-set-body-end-internal entity (point))
- ))))
- buffer))
-
-(mm-define-method entity-point-min ((entity elmo-imap4))
- (let ((buffer (mime-entity-buffer-internal entity)))
- (set-buffer buffer)
- (point-min)))
-
-(mm-define-method entity-point-max ((entity elmo-imap4))
- (let ((buffer (mime-entity-buffer-internal entity)))
- (set-buffer buffer)
- (point-max)))
-
-(mm-define-method entity-children ((entity elmo-imap4))
- (let* ((content-type (mime-entity-content-type entity))
- (primary-type (mime-content-type-primary-type content-type)))
- (cond ((eq primary-type 'multipart)
- (mime-parse-multipart entity)
- )
- ((and (eq primary-type 'message)
- (memq (mime-content-type-subtype content-type)
- '(rfc822 news external-body)
- ))
- (save-excursion
- (set-buffer (mime-entity-buffer-internal entity))
- (mime-entity-set-body-start-internal entity (point-min))
- (mime-entity-set-body-end-internal entity (point-max)))
- (mime-parse-encapsulated entity)
- ))
- ))
-
-(mm-define-method entity-body-start ((entity elmo-imap4))
- (point-min))
-
-(mm-define-method entity-body-end ((entity elmo-imap4))
- (point-max))
-
-;; override generic function for dynamic body fetching.
-(mm-define-method entity-content ((entity elmo-imap4))
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (mime-decode-string
- (buffer-substring (mime-entity-body-start entity)
- (mime-entity-body-end entity))
- (mime-entity-encoding entity))))
-
-(mm-define-method fetch-field ((entity elmo-imap4) field-name)
- (save-excursion
- (let ((buf (mime-entity-buffer-internal entity)))
- (when buf
- (set-buffer buf)
- (save-restriction
- (if (and (mime-entity-header-start-internal entity)
- (mime-entity-header-end-internal entity))
- (progn
- (narrow-to-region
- (mime-entity-header-start-internal entity)
- (mime-entity-header-end-internal entity))
- (std11-fetch-field field-name))
- nil))))))
-
-(require 'product)
-(product-provide (provide 'mmelmo-imap4-1) (require 'elmo-version))
-
-;;; mmelmo-imap4-1.el ends here
+++ /dev/null
-;;; mmelmo-imap4-1.el -- MM backend of IMAP4 for ELMO (for FLIM 1.13.x).
-
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Keywords: mail, net news
-
-;; This file is part of ELMO (Elisp Library for Message Orchestration).
-
-;; 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.
-;;
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-;;
-
-;;; Commentary:
-;;
-
-;;; Code:
-;;
-(require 'mmbuffer)
-(require 'mmelmo)
-(defvar mmelmo-imap4-threshold nil)
-(defvar mmelmo-imap4-skipped-parts nil)
-(defvar mmelmo-imap4-current-message-structure nil)
-
-;; Buffer local variable.
-(defvar mmelmo-imap4-fetched nil)
-(make-variable-buffer-local 'mmelmo-imap4-fetched)
-
-(defun mmelmo-imap4-node-id-to-string (node-id)
- (let ((i (length node-id))
- result)
- (while (> i 0)
- (setq result
- (concat result
- (if result
- (concat "." (int-to-string
- (+ 1 (nth (- i 1) node-id))))
- (int-to-string (or
- (+ 1 (nth (- i 1) node-id))
- 0)))))
- (setq i (- i 1)))
- (or result "0")))
-
-;; parse IMAP4 body structure entity recursively.
-(defun mmelmo-imap4-parse-bodystructure-object (folder
- number msgdb
- node-id object parent)
- (cond
- ((listp (car object));; multipart
- (let (cur-obj children content-type ret-val (num 0))
- (setq ret-val
- (luna-make-entity
- (mm-expand-class-name 'elmo-imap4)
- :folder folder
- :number number
- :msgdb msgdb
- :parent parent
- :node-id node-id))
- (while (and (setq cur-obj (car object))
- (listp cur-obj))
- (setq children
- (append children
- (list
- (mmelmo-imap4-parse-bodystructure-object
- folder number msgdb
- (append (list num) node-id)
- cur-obj
- ret-val ; myself as parent
- ))))
- (setq num (+ num 1))
- (setq object (cdr object)))
- (mime-entity-set-children-internal ret-val children)
- (setq content-type (list (cons 'type 'multipart)))
- (if (elmo-imap4-nth 0 object)
- (setq content-type (append content-type
- (list (cons 'subtype
- (intern
- (downcase
- (elmo-imap4-nth
- 0
- object))))))))
- (setq content-type (append content-type
- (mime-parse-parameters-from-list
- (elmo-imap4-nth 1 object))))
- (mime-entity-set-content-type-internal ret-val content-type)
- ret-val))
- (t ;; singlepart
- (let (content-type ret-val)
- ;; append size information into location
- (setq content-type (list (cons 'type (intern (downcase (car object))))))
- (if (elmo-imap4-nth 1 object)
- (setq content-type (append content-type
- (list
- (cons 'subtype
- (intern
- (downcase
- (elmo-imap4-nth 1 object))))))))
- (if (elmo-imap4-nth 2 object)
- (setq content-type (append content-type
- (mime-parse-parameters-from-list
- (elmo-imap4-nth 2 object)))))
- (setq ret-val
- (luna-make-entity
- (mm-expand-class-name 'elmo-imap4)
- :folder folder
- :number number
- :size (nth 6 object)
- :content-type content-type
- :parent parent
- :node-id node-id))
- (mime-entity-set-encoding-internal ret-val
- (and (elmo-imap4-nth 5 object)
- (downcase
- (elmo-imap4-nth 5 object))))
- ret-val))))
-
-(defun mmelmo-imap4-multipart-p (entity)
- (eq (cdr (assq 'type (mime-entity-content-type entity))) 'multipart))
-
-(defun mmelmo-imap4-rfc822part-p (entity)
- (eq (cdr (assq 'type (mime-entity-content-type entity))) 'rfc822))
-
-(defun mmelmo-imap4-textpart-p (entity)
- (eq (cdr (assq 'type (mime-entity-content-type entity))) 'text))
-
-(defun mmelmo-imap4-get-mime-entity (folder number msgdb)
- (let* ((spec (elmo-folder-get-spec folder))
- (session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session (elmo-imap4-spec-mailbox spec))
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (mmelmo-imap4-parse-bodystructure-object
- folder
- number
- msgdb
- nil ; node-id
- (elmo-imap4-response-value
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait
- session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s bodystructure"
- "fetch %s bodystructure")
- number)) 'fetch) 'bodystructure)
- nil ; parent
- )))
-
-(defun mmelmo-imap4-read-part (entity)
- (if (or (not mmelmo-imap4-threshold)
- (not (mime-elmo-entity-size-internal entity))
- (and (mime-elmo-entity-size-internal entity)
- mmelmo-imap4-threshold
- (<= (mime-elmo-entity-size-internal entity)
- mmelmo-imap4-threshold)))
- (progn
- (cond ((mmelmo-imap4-multipart-p entity)) ; noop
- (t (insert (elmo-imap4-read-part
- (mime-elmo-entity-folder-internal entity)
- (mime-elmo-entity-number-internal entity)
- (mmelmo-imap4-node-id-to-string
- (mime-entity-node-id-internal entity))))))
- (setq mmelmo-imap4-fetched t)
- (mime-buffer-entity-set-body-start-internal entity (point-min))
- (mime-buffer-entity-set-body-end-internal entity (point-max)))
- (setq mmelmo-imap4-fetched nil)
- (mime-buffer-entity-set-body-start-internal entity (point-min))
- (mime-buffer-entity-set-body-end-internal entity (point-min))
- (setq mmelmo-imap4-skipped-parts
- (append
- mmelmo-imap4-skipped-parts
- (list (mmelmo-imap4-node-id-to-string
- (mime-entity-node-id-internal entity)))))))
-
-(defun mmelmo-imap4-insert-body (entity)
- (mime-buffer-entity-set-body-start-internal entity (- (point) 1))
- (if (or (not mmelmo-imap4-threshold)
- (not (mime-elmo-entity-size-internal entity))
- (and (mime-elmo-entity-size-internal entity)
- mmelmo-imap4-threshold
- (<= (mime-elmo-entity-size-internal entity)
- mmelmo-imap4-threshold)))
- (insert (elmo-imap4-read-part
- (mime-elmo-entity-folder-internal entity)
- (mime-elmo-entity-number-internal entity) "1"))
- (setq mmelmo-imap4-skipped-parts
- (append
- mmelmo-imap4-skipped-parts
- (list (mmelmo-imap4-node-id-to-string
- (mime-entity-node-id-internal entity)))))))
-
-;;; mime-elmo-imap4-entity class definitions.
-(luna-define-class mime-elmo-imap4-entity (mime-buffer-entity)
- (imap folder number msgdb size))
-(luna-define-internal-accessors 'mime-elmo-imap4-entity)
-
-(luna-define-method initialize-instance ((entity mime-elmo-imap4-entity)
- &rest init-args)
- "The initialization method for elmo-imap4.
-mime-elmo-entity has its own instance variable
-`imap', `folder', `msgdb', and `size'.
-These value must be specified as argument for `luna-make-entity'."
- (apply (car (luna-class-find-functions
- (luna-find-class 'standard-object)
- 'initialize-instance))
- entity init-args))
-
-(defun mmelmo-imap4-mime-entity-buffer (entity)
- (if (mime-buffer-entity-buffer-internal entity)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (unless (mime-root-entity-p entity)
- (unless mmelmo-imap4-fetched
- (setq mmelmo-imap4-skipped-parts nil) ; No need?
- (let ((mmelmo-imap4-threshold
- (mime-elmo-entity-size-internal entity)))
- (mime-buffer-entity-set-buffer-internal entity nil)
- (message "Fetching skipped part...")
- (mmelmo-imap4-mime-entity-buffer entity)
- (message "Fetching skipped part...done"))
- (setq mmelmo-imap4-fetched t)))
- (mime-buffer-entity-buffer-internal entity))
- ;; No buffer exist.
- (save-excursion
- (set-buffer (get-buffer-create
- (concat mmelmo-entity-buffer-name
- (mmelmo-imap4-node-id-to-string
- (mime-entity-node-id-internal entity)))))
- (mmelmo-original-mode)
- (mime-buffer-entity-set-buffer-internal entity (current-buffer))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (mime-entity-node-id entity)
- (if (mime-root-entity-p entity)
- (progn
- ;; root entity
- (setq mmelmo-imap4-current-message-structure entity)
- (setq mime-message-structure entity)
- (setq mmelmo-imap4-skipped-parts nil)
- ;; insert header
- (insert (elmo-imap4-read-part
- (mime-elmo-entity-folder-internal entity)
- (mime-elmo-entity-number-internal entity)
- "header"))
- (mime-buffer-entity-set-header-start-internal
- entity (point-min))
- (mime-buffer-entity-set-header-end-internal
- entity (max (- (point) 1) 1))
- (if (null (mime-entity-children-internal entity))
- (progn
- (mime-buffer-entity-set-body-start-internal
- entity (point))
- ;; insert body if size is OK.
- (mmelmo-imap4-insert-body entity)
- (mime-buffer-entity-set-body-end-internal
- entity (point)))))
- (setq mime-message-structure
- mmelmo-imap4-current-message-structure)
- (mmelmo-imap4-read-part entity)))
- (current-buffer))))
-
-; mime-entity-children
-(luna-define-method mime-entity-children ((entity
- mime-elmo-imap4-entity))
- (mime-entity-children-internal entity))
-
-;; override generic function for dynamic body fetching.
-(luna-define-method mime-entity-body ((entity
- mime-elmo-imap4-entity))
- (save-excursion
- (set-buffer (mmelmo-imap4-mime-entity-buffer entity))
- (buffer-substring (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity))))
-
-(luna-define-method mime-entity-content ((entity
- mime-elmo-imap4-entity))
- (save-excursion
- (set-buffer (mmelmo-imap4-mime-entity-buffer entity))
- (mime-decode-string
- (buffer-substring (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity))
- (mime-entity-encoding entity))))
-
-(luna-define-method mime-entity-fetch-field ((entity mime-elmo-imap4-entity)
- field-name)
- (save-excursion
- (save-restriction
- (when (mime-buffer-entity-buffer-internal entity)
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (if (and (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity))
- (progn
- (narrow-to-region
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity))
- (std11-fetch-field field-name))
- nil)))))
-
-(luna-define-method mime-insert-header ((entity mime-elmo-imap4-entity)
- &optional invisible-fields
- visible-fields)
- (mmelmo-insert-sorted-header-from-buffer
- (mmelmo-imap4-mime-entity-buffer entity)
- (mime-buffer-entity-header-start-internal entity)
- (mime-buffer-entity-header-end-internal entity)
- invisible-fields visible-fields))
-
-(luna-define-method mime-entity-header-buffer ((entity mime-elmo-imap4-entity))
- (mime-buffer-entity-buffer-internal entity))
-
-(luna-define-method mime-entity-body-buffer ((entity mime-elmo-imap4-entity))
- (mime-buffer-entity-buffer-internal entity))
-
-(luna-define-method mime-write-entity-content ((entity mime-elmo-imap4-entity)
- filename)
- (let ((mmelmo-imap4-threshold (mime-elmo-entity-size-internal entity)))
- (if (mime-buffer-entity-buffer-internal entity)
- (save-excursion
- (set-buffer (mime-buffer-entity-buffer-internal entity))
- (unless mmelmo-imap4-fetched
- (setq mmelmo-imap4-skipped-parts nil) ; No need?
- (mime-buffer-entity-set-buffer-internal entity nil) ; To re-fetch.
- ))
- (unless mmelmo-imap4-fetched
- (setq mmelmo-imap4-skipped-parts nil) ; No need?
- (let ((mmelmo-imap4-threshold (mime-elmo-entity-size-internal entity)))
- (mime-buffer-entity-set-buffer-internal entity nil) ; To re-fetch.
- (message "Fetching skipped part...")
- (mime-buffer-entity-set-buffer-internal
- entity
- (mmelmo-imap4-mime-entity-buffer entity))
- (message "Fetching skipped part...done")))
- (with-current-buffer (mime-buffer-entity-buffer-internal entity)
- (mime-write-decoded-region
- (mime-buffer-entity-body-start-internal entity)
- (mime-buffer-entity-body-end-internal entity)
- filename
- (or (mime-entity-encoding entity) "7bit"))))))
-
-(require 'product)
-(product-provide (provide 'mmelmo-imap4-2) (require 'elmo-version))
-
-;;; mmelmo-imap4-2.el ends here
;;; Code:
;;
-(static-if (fboundp 'luna-define-method)
- ;; FLIM 1.13 or later
- (require 'mmelmo-imap4-2)
- ;; FLIM 1.12
- (require 'mmelmo-imap4-1))
+(require 'mmbuffer)
+
+(require 'mmelmo)
+
+(defvar mmelmo-imap4-threshold nil)
+(defvar mmelmo-imap4-skipped-parts nil)
+(defvar mmelmo-imap4-current-message-structure nil)
+
+;; Buffer local variable.
+(defvar mmelmo-imap4-fetched nil)
+(make-variable-buffer-local 'mmelmo-imap4-fetched)
+
+(defun mmelmo-imap4-node-id-to-string (node-id)
+ (let ((i (length node-id))
+ result)
+ (while (> i 0)
+ (setq result
+ (concat result
+ (if result
+ (concat "." (int-to-string
+ (+ 1 (nth (- i 1) node-id))))
+ (int-to-string (or
+ (+ 1 (nth (- i 1) node-id))
+ 0)))))
+ (setq i (- i 1)))
+ (or result "0")))
+
+;; parse IMAP4 body structure entity recursively.
+(defun mmelmo-imap4-parse-bodystructure-object (folder
+ number msgdb
+ node-id object parent)
+ (cond
+ ((listp (car object));; multipart
+ (let (cur-obj children content-type ret-val (num 0))
+ (setq ret-val
+ (luna-make-entity
+ (mm-expand-class-name 'elmo-imap4)
+ :folder folder
+ :number number
+ :msgdb msgdb
+ :parent parent
+ :node-id node-id))
+ (while (and (setq cur-obj (car object))
+ (listp cur-obj))
+ (setq children
+ (append children
+ (list
+ (mmelmo-imap4-parse-bodystructure-object
+ folder number msgdb
+ (append (list num) node-id)
+ cur-obj
+ ret-val ; myself as parent
+ ))))
+ (setq num (+ num 1))
+ (setq object (cdr object)))
+ (mime-entity-set-children-internal ret-val children)
+ (setq content-type (list (cons 'type 'multipart)))
+ (if (elmo-imap4-nth 0 object)
+ (setq content-type (append content-type
+ (list (cons 'subtype
+ (intern
+ (downcase
+ (elmo-imap4-nth
+ 0
+ object))))))))
+ (setq content-type (append content-type
+ (mime-parse-parameters-from-list
+ (elmo-imap4-nth 1 object))))
+ (mime-entity-set-content-type-internal ret-val content-type)
+ ret-val))
+ (t ;; singlepart
+ (let (content-type ret-val)
+ ;; append size information into location
+ (setq content-type (list (cons 'type (intern (downcase (car object))))))
+ (if (elmo-imap4-nth 1 object)
+ (setq content-type (append content-type
+ (list
+ (cons 'subtype
+ (intern
+ (downcase
+ (elmo-imap4-nth 1 object))))))))
+ (if (elmo-imap4-nth 2 object)
+ (setq content-type (append content-type
+ (mime-parse-parameters-from-list
+ (elmo-imap4-nth 2 object)))))
+ (setq ret-val
+ (luna-make-entity
+ (mm-expand-class-name 'elmo-imap4)
+ :folder folder
+ :number number
+ :size (nth 6 object)
+ :content-type content-type
+ :parent parent
+ :node-id node-id))
+ (mime-entity-set-encoding-internal ret-val
+ (and (elmo-imap4-nth 5 object)
+ (downcase
+ (elmo-imap4-nth 5 object))))
+ ret-val))))
+
+(defun mmelmo-imap4-multipart-p (entity)
+ (eq (cdr (assq 'type (mime-entity-content-type entity))) 'multipart))
+
+(defun mmelmo-imap4-rfc822part-p (entity)
+ (eq (cdr (assq 'type (mime-entity-content-type entity))) 'rfc822))
+
+(defun mmelmo-imap4-textpart-p (entity)
+ (eq (cdr (assq 'type (mime-entity-content-type entity))) 'text))
+
+(defun mmelmo-imap4-get-mime-entity (folder number msgdb)
+ (let* ((spec (elmo-folder-get-spec folder))
+ (session (elmo-imap4-get-session spec)))
+ (elmo-imap4-session-select-mailbox session (elmo-imap4-spec-mailbox spec))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (mmelmo-imap4-parse-bodystructure-object
+ folder
+ number
+ msgdb
+ nil ; node-id
+ (elmo-imap4-response-value
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s bodystructure"
+ "fetch %s bodystructure")
+ number)) 'fetch) 'bodystructure)
+ nil ; parent
+ )))
+
+(defun mmelmo-imap4-read-part (entity)
+ (if (or (not mmelmo-imap4-threshold)
+ (not (mime-elmo-entity-size-internal entity))
+ (and (mime-elmo-entity-size-internal entity)
+ mmelmo-imap4-threshold
+ (<= (mime-elmo-entity-size-internal entity)
+ mmelmo-imap4-threshold)))
+ (progn
+ (cond ((mmelmo-imap4-multipart-p entity)) ; noop
+ (t (insert (elmo-imap4-read-part
+ (mime-elmo-entity-folder-internal entity)
+ (mime-elmo-entity-number-internal entity)
+ (mmelmo-imap4-node-id-to-string
+ (mime-entity-node-id-internal entity))))))
+ (setq mmelmo-imap4-fetched t)
+ (mime-buffer-entity-set-body-start-internal entity (point-min))
+ (mime-buffer-entity-set-body-end-internal entity (point-max)))
+ (setq mmelmo-imap4-fetched nil)
+ (mime-buffer-entity-set-body-start-internal entity (point-min))
+ (mime-buffer-entity-set-body-end-internal entity (point-min))
+ (setq mmelmo-imap4-skipped-parts
+ (append
+ mmelmo-imap4-skipped-parts
+ (list (mmelmo-imap4-node-id-to-string
+ (mime-entity-node-id-internal entity)))))))
+
+(defun mmelmo-imap4-insert-body (entity)
+ (mime-buffer-entity-set-body-start-internal entity (- (point) 1))
+ (if (or (not mmelmo-imap4-threshold)
+ (not (mime-elmo-entity-size-internal entity))
+ (and (mime-elmo-entity-size-internal entity)
+ mmelmo-imap4-threshold
+ (<= (mime-elmo-entity-size-internal entity)
+ mmelmo-imap4-threshold)))
+ (insert (elmo-imap4-read-part
+ (mime-elmo-entity-folder-internal entity)
+ (mime-elmo-entity-number-internal entity) "1"))
+ (setq mmelmo-imap4-skipped-parts
+ (append
+ mmelmo-imap4-skipped-parts
+ (list (mmelmo-imap4-node-id-to-string
+ (mime-entity-node-id-internal entity)))))))
+
+;;; mime-elmo-imap4-entity class definitions.
+(luna-define-class mime-elmo-imap4-entity (mime-buffer-entity)
+ (imap folder number msgdb size))
+(luna-define-internal-accessors 'mime-elmo-imap4-entity)
+
+(luna-define-method initialize-instance ((entity mime-elmo-imap4-entity)
+ &rest init-args)
+ "The initialization method for elmo-imap4.
+mime-elmo-entity has its own instance variable
+`imap', `folder', `msgdb', and `size'.
+These value must be specified as argument for `luna-make-entity'."
+ (apply (car (luna-class-find-functions
+ (luna-find-class 'standard-object)
+ 'initialize-instance))
+ entity init-args))
+
+(defun mmelmo-imap4-mime-entity-buffer (entity)
+ (if (mime-buffer-entity-buffer-internal entity)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (unless (mime-root-entity-p entity)
+ (unless mmelmo-imap4-fetched
+ (setq mmelmo-imap4-skipped-parts nil) ; No need?
+ (let ((mmelmo-imap4-threshold
+ (mime-elmo-entity-size-internal entity)))
+ (mime-buffer-entity-set-buffer-internal entity nil)
+ (message "Fetching skipped part...")
+ (mmelmo-imap4-mime-entity-buffer entity)
+ (message "Fetching skipped part...done."))
+ (setq mmelmo-imap4-fetched t)))
+ (mime-buffer-entity-buffer-internal entity))
+ ;; No buffer exist.
+ (save-excursion
+ (set-buffer (get-buffer-create
+ (concat mmelmo-entity-buffer-name
+ (mmelmo-imap4-node-id-to-string
+ (mime-entity-node-id-internal entity)))))
+ (mmelmo-original-mode)
+ (mime-buffer-entity-set-buffer-internal entity (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (mime-entity-node-id entity)
+ (if (mime-root-entity-p entity)
+ (progn
+ ;; root entity
+ (setq mmelmo-imap4-current-message-structure entity)
+ (setq mime-message-structure entity)
+ (setq mmelmo-imap4-skipped-parts nil)
+ ;; insert header
+ (insert (elmo-imap4-read-part
+ (mime-elmo-entity-folder-internal entity)
+ (mime-elmo-entity-number-internal entity)
+ "header"))
+ (mime-buffer-entity-set-header-start-internal
+ entity (point-min))
+ (mime-buffer-entity-set-header-end-internal
+ entity (max (- (point) 1) 1))
+ (if (null (mime-entity-children-internal entity))
+ (progn
+ (mime-buffer-entity-set-body-start-internal
+ entity (point))
+ ;; insert body if size is OK.
+ (mmelmo-imap4-insert-body entity)
+ (mime-buffer-entity-set-body-end-internal
+ entity (point)))))
+ (setq mime-message-structure
+ mmelmo-imap4-current-message-structure)
+ (mmelmo-imap4-read-part entity)))
+ (current-buffer))))
+
+; mime-entity-children
+(luna-define-method mime-entity-children ((entity
+ mime-elmo-imap4-entity))
+ (mime-entity-children-internal entity))
+
+;; override generic function for dynamic body fetching.
+(luna-define-method mime-entity-body ((entity
+ mime-elmo-imap4-entity))
+ (save-excursion
+ (set-buffer (mmelmo-imap4-mime-entity-buffer entity))
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))))
+
+(luna-define-method mime-entity-content ((entity
+ mime-elmo-imap4-entity))
+ (save-excursion
+ (set-buffer (mmelmo-imap4-mime-entity-buffer entity))
+ (mime-decode-string
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))
+ (mime-entity-encoding entity))))
+
+(luna-define-method mime-entity-fetch-field ((entity mime-elmo-imap4-entity)
+ field-name)
+ (save-excursion
+ (save-restriction
+ (when (mime-buffer-entity-buffer-internal entity)
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (if (and (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity))
+ (progn
+ (narrow-to-region
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity))
+ (std11-fetch-field field-name))
+ nil)))))
+
+(luna-define-method mime-insert-header ((entity mime-elmo-imap4-entity)
+ &optional invisible-fields
+ visible-fields)
+ (mmelmo-insert-sorted-header-from-buffer
+ (mmelmo-imap4-mime-entity-buffer entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity)
+ invisible-fields visible-fields))
+
+(luna-define-method mime-entity-header-buffer ((entity mime-elmo-imap4-entity))
+ (mime-buffer-entity-buffer-internal entity))
+
+(luna-define-method mime-entity-body-buffer ((entity mime-elmo-imap4-entity))
+ (mime-buffer-entity-buffer-internal entity))
+
+(luna-define-method mime-write-entity-content ((entity mime-elmo-imap4-entity)
+ filename)
+ (let ((mmelmo-imap4-threshold (mime-elmo-entity-size-internal entity)))
+ (if (mime-buffer-entity-buffer-internal entity)
+ (save-excursion
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (unless mmelmo-imap4-fetched
+ (setq mmelmo-imap4-skipped-parts nil) ; No need?
+ (mime-buffer-entity-set-buffer-internal entity nil) ; To re-fetch.
+ ))
+ (unless mmelmo-imap4-fetched
+ (setq mmelmo-imap4-skipped-parts nil) ; No need?
+ (let ((mmelmo-imap4-threshold (mime-elmo-entity-size-internal entity)))
+ (mime-buffer-entity-set-buffer-internal entity nil) ; To re-fetch.
+ (message "Fetching skipped part...")
+ (mime-buffer-entity-set-buffer-internal
+ entity
+ (mmelmo-imap4-mime-entity-buffer entity))
+ (message "Fetching skipped part...done.")))
+ (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (mime-write-decoded-region
+ (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity)
+ filename
+ (or (mime-entity-encoding entity) "7bit"))))))
(require 'product)
(product-provide (provide 'mmelmo-imap4) (require 'elmo-version))
;;; Code:
;;
-
(require 'elmo-vars)
(require 'elmo-util)
(require 'mime-parse)
(require 'mmbuffer)
+(require 'product)
+(product-provide (provide 'mmelmo) (require 'elmo-version))
+(require 'mmelmo-imap4)
+
+(eval-and-compile
+ (luna-define-class mime-elmo-entity (mime-buffer-entity)
+ (imap folder number msgdb size))
+ (luna-define-internal-accessors 'mime-elmo-entity))
+
+(defvar mmelmo-force-reload nil)
+(defvar mmelmo-sort-field-list nil)
+
(defvar mmelmo-header-max-column fill-column
"*Inserted header is folded with this value.
If function is specified, its return value is used.")
(kill-buffer x)))
(mapcar 'buffer-name (buffer-list))))
+;; For FLIM 1-13.x
+(defun-maybe mime-entity-body (entity)
+ (luna-send entity 'mime-entity-body))
+
(defun mmelmo-insert-sorted-header-from-buffer (buffer
start end
&optional invisible-fields
(setq attrlist (cdr (cdr attrlist))))
ret-val)))
-;;;(provide 'mmelmo) ; for circular dependency.
-(require 'product)
-(product-provide (provide 'mmelmo) (require 'elmo-version))
+(luna-define-method initialize-instance :after ((entity mime-elmo-entity)
+ &rest init-args)
+ "The initialization method for elmo.
+mime-elmo-entity has its own member variable,
+`imap', `folder', `msgdb' and `size'.
+imap: boolean. if non-nil, entity becomes mime-elmo-imap4-entity class.
+folder: string. folder name.
+msgdb: msgdb of elmo.
+size: size of the entity."
+ (if (mime-elmo-entity-imap-internal entity)
+ ;; use imap part fetching.
+ ;; child mime-entity's class becomes `mime-elmo-imap4-entity'
+ ;; which implements `entity-buffer' method.
+ (progn
+ (let (new-entity)
+ (mime-buffer-entity-set-buffer-internal entity nil)
+ (setq new-entity
+ (mmelmo-imap4-get-mime-entity
+ (mime-elmo-entity-folder-internal entity) ; folder
+ (mime-elmo-entity-number-internal entity) ; number
+ (mime-elmo-entity-msgdb-internal entity) ; msgdb
+ ))
+ (mime-entity-set-content-type-internal
+ entity
+ (mime-entity-content-type-internal new-entity))
+ (mime-entity-set-encoding-internal
+ entity
+ (mime-entity-encoding-internal new-entity))
+ (mime-entity-set-children-internal
+ entity
+ (mime-entity-children-internal new-entity))
+ (mime-elmo-entity-set-size-internal
+ entity
+ (mime-elmo-entity-size-internal new-entity))
+ (mime-entity-set-representation-type-internal
+ entity 'mime-elmo-imap4-entity)
+ entity))
+ (set-buffer (mime-buffer-entity-buffer-internal entity))
+ (mmelmo-original-mode)
+ (when (mime-root-entity-p entity)
+ (let ((buffer-read-only nil)
+ header-end body-start)
+ (erase-buffer)
+ (elmo-read-msg-with-buffer-cache
+ (mime-elmo-entity-folder-internal entity)
+ (mime-elmo-entity-number-internal entity)
+ (current-buffer)
+ (mime-elmo-entity-msgdb-internal entity)
+ mmelmo-force-reload)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$\\|^$" )
+ nil t)
+ (setq header-end (match-beginning 0)
+ body-start (if (= (match-end 0) (point-max))
+ (point-max)
+ (1+ (match-end 0))))
+ (setq header-end (point-min)
+ body-start (point-min)))
+ (mime-buffer-entity-set-header-start-internal entity (point-min))
+ (mime-buffer-entity-set-header-end-internal entity header-end)
+ (mime-buffer-entity-set-body-start-internal entity body-start)
+ (mime-buffer-entity-set-body-end-internal entity (point-max))
+ (save-restriction
+ (narrow-to-region (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity))
+ (mime-entity-set-content-type-internal
+ entity
+ (let ((str (std11-fetch-field "Content-Type")))
+ (if str
+ (mime-parse-Content-Type str)
+ ))))))
+ entity))
+
+(luna-define-method mime-insert-header ((entity mime-elmo-entity)
+ &optional invisible-fields
+ visible-fields)
+ (mmelmo-insert-sorted-header-from-buffer
+ (mime-buffer-entity-buffer-internal entity)
+ (mime-buffer-entity-header-start-internal entity)
+ (mime-buffer-entity-header-end-internal entity)
+ invisible-fields visible-fields mmelmo-sort-field-list))
+
+(luna-define-method mime-insert-text-content :around ((entity
+ mime-elmo-entity))
+ (luna-call-next-method)
+ (run-hooks 'mmelmo-entity-content-inserted-hook))
+
+(luna-define-method mime-entity-body ((entity mime-elmo-entity))
+ (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+ (buffer-substring (mime-buffer-entity-body-start-internal entity)
+ (mime-buffer-entity-body-end-internal entity))))
-(static-if (fboundp 'luna-define-method)
- ;; FLIM 1.13 or later
- (require 'mmelmo-2)
- ;; FLIM 1.12
- (require 'mmelmo-1))
+;(luna-define-method mime-entity-content ((entity mime-elmo-entity))
+; (mime-decode-string
+; (with-current-buffer (mime-buffer-entity-buffer-internal entity)
+; (buffer-substring (mime-buffer-entity-body-start-internal entity)
+; (mime-buffer-entity-body-end-internal entity)))
+; (mime-entity-encoding entity)))
;;; mmelmo.el ends here
projects / elisp / wanderlust.git / commitdiff