X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-mime.el;h=1593d6b4cafb308b193654c7483b2ea75e1b1142;hb=7cda258222739c6726dcbc2c9ad21880493a6119;hp=df1ba13b1e9d441b38dceae727939f5f1476e5b2;hpb=8991841dee3fcd7d0c854836b894df0b6798b547;p=elisp%2Fwanderlust.git diff --git a/wl/wl-mime.el b/wl/wl-mime.el index df1ba13..1593d6b 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -1,10 +1,9 @@ ;;; wl-mime.el -- SEMI implementations of MIME processing on Wanderlust. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news -;; Time-stamp: <2000-04-20 17:43:19 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -36,32 +35,28 @@ (require 'mmelmo) (eval-when-compile - (defun-maybe Meadow-version ()) - (mapcar - (function - (lambda (symbol) - (unless (boundp symbol) - (set (make-local-variable symbol) nil)))) - '(xemacs-betaname - xemacs-codename - enable-multibyte-characters - mule-version))) + (defalias-maybe 'Meadow-version 'ignore)) + +(defvar xemacs-betaname) +(defvar xemacs-codename) +(defvar enable-multibyte-characters) +(defvar mule-version) ;;; Draft (defalias 'wl-draft-editor-mode 'mime-edit-mode) -(defalias 'wl-draft-decode-message-in-buffer +(defalias 'wl-draft-decode-message-in-buffer 'mime-edit-decode-message-in-buffer) (defun wl-draft-yank-current-message-entity () - "Yank currently displayed message entity. + "Yank currently displayed message entity. By setting following-method as yank-content." (let ((wl-draft-buffer (current-buffer)) - (mime-view-following-method-alist - (list (cons 'mmelmo-original-mode + (mime-view-following-method-alist + (list (cons 'mmelmo-original-mode (function wl-draft-yank-to-draft-buffer)))) - (mime-preview-following-method-alist + (mime-preview-following-method-alist (list (cons 'mmelmo-original-mode (function wl-draft-yank-to-draft-buffer))))) (if (get-buffer (wl-current-message-buffer)) @@ -73,98 +68,38 @@ By setting following-method as yank-content." (defalias 'wl-draft-enclose-digest-region 'mime-edit-enclose-digest-region) -;; SEMI 1.13.5 or later. -;; (mime-display-message -;; MESSAGE &optional -;; PREVIEW-BUFFER MOTHER DEFAULT-KEYMAP-OR-FUNCTION ORIGINAL-MAJOR-MODE) -;; SEMI 1.13.4 or earlier. -;; (mime-display-message -;; MESSAGE &optional -;; PREVIEW-BUFFER MOTHER DEFAULT-KEYMAP-OR-FUNCTION) -(static-if (or (and mime-user-interface-product - (eq (nth 0 (aref mime-user-interface-product 1)) 1) - (>= (nth 1 (aref mime-user-interface-product 1)) 14)) - (and mime-user-interface-product - (eq (nth 0 (aref mime-user-interface-product 1)) 1) - (eq (nth 1 (aref mime-user-interface-product 1)) 13) - (>= (nth 2 (aref mime-user-interface-product 1)) 5))) - ;; Has original-major-mode optional argument. - (defalias 'wl-mime-display-message 'mime-display-message) - (defmacro wl-mime-display-message (message &optional - preview-buffer mother - default-keymap-or-function - original-major-mode) - (` (mime-display-message (, message) (, preview-buffer) (, mother) - (, default-keymap-or-function)))) - ;; User agent field of XEmacs has problem on SEMI 1.13.4 or earlier. - (setq mime-edit-user-agent-value - (concat - (mime-product-name mime-user-interface-product) "/" - (mapconcat - #'number-to-string - (mime-product-version mime-user-interface-product) ".") - " (" (mime-product-code-name mime-user-interface-product) - ") " (mime-product-name mime-library-product) - "/" (mapconcat #'number-to-string - (mime-product-version mime-library-product) ".") - " (" (mime-product-code-name mime-library-product) ") " - (if (featurep 'xemacs) - (concat - (if (featurep 'mule) "MULE") - " XEmacs" - (if (string-match "\\s +\\((\\|\\\"\\)" emacs-version) - (concat "/" (substring emacs-version 0 - (match-beginning 0)) - (if (and (boundp 'xemacs-betaname) - ;; It does not exist in XEmacs - ;; versions prior to 20.3. - xemacs-betaname) - (concat " " xemacs-betaname) - "") - " (" xemacs-codename ") (" - system-configuration ")") - " (" emacs-version ")")) - (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) - (substring emacs-version 0 (match-beginning 0)) - emacs-version))) - (if (featurep 'mule) - (if (boundp 'enable-multibyte-characters) - (concat "Emacs/" ver - " (" system-configuration ")" - (if enable-multibyte-characters - (concat " MULE/" mule-version) - " (with unibyte mode)") - (if (featurep 'meadow) - (let ((mver (Meadow-version))) - (if (string-match "^Meadow-" mver) - (concat " Meadow/" - (substring mver - (match-end 0))))))) - (concat "MULE/" mule-version - " (based on Emacs " ver ")")) - (concat "Emacs/" ver " (" system-configuration ")"))))))) - -;; FLIM 1.12.7 -;; (mime-read-field FIELD-NAME &optional ENTITY) -;; FLIM 1.13.2 or later -;; (mime-entity-read-field ENTITY FIELD-NAME) -(static-if (fboundp 'mime-entity-read-field) - (defalias 'wl-mime-entity-read-field 'mime-entity-read-field) - (defmacro wl-mime-entity-read-field (entity field-name) - (` (mime-read-field (, field-name) (, entity))))) - (defun wl-draft-preview-message () + "" (interactive) - (let ((mime-display-header-hook 'wl-highlight-headers) - mime-view-ignored-field-list ; all header. - (mime-edit-translate-buffer-hook (append - (list 'wl-draft-config-exec) - mime-edit-translate-buffer-hook))) + (let* (recipients-message + (mime-display-header-hook 'wl-highlight-headers) + mime-view-ignored-field-list ; all header. + (mime-edit-translate-buffer-hook + (append + '((lambda () + (setq recipients-message + (concat "Recipients: " + (mapconcat + 'identity + (wl-draft-deduce-address-list + (current-buffer) + (point-min) + (save-excursion + (re-search-forward + (concat "^" + (regexp-quote mail-header-separator) + "$") + nil t) + (point))) + ", "))) + (run-hooks 'wl-draft-send-hook))) + mime-edit-translate-buffer-hook))) (mime-edit-preview-message) (let ((buffer-read-only nil)) - (when wl-highlight-body-too + (when wl-highlight-body-too (wl-highlight-body)) - (run-hooks 'wl-draft-preview-message-hook)))) + (run-hooks 'wl-draft-preview-message-hook)) + (message recipients-message))) (defalias 'wl-draft-caesar-region 'mule-caesar-region) @@ -195,7 +130,8 @@ By setting following-method as yank-content." (defun wl-message-request-partial (folder number) (elmo-set-work-buf (elmo-read-msg-no-cache folder number (current-buffer)) - (mime-parse-buffer nil))); 'mime-buffer-entity))) +;;;(mime-parse-buffer nil 'mime-buffer-entity) + (mime-parse-buffer nil))) (defalias 'wl-message-read 'mime-preview-scroll-up-entity) (defalias 'wl-message-next-content 'mime-preview-move-to-next) @@ -203,7 +139,8 @@ By setting following-method as yank-content." (defalias 'wl-message-play-content 'mime-preview-play-current-entity) (defalias 'wl-message-extract-content 'mime-preview-extract-current-entity) (defalias 'wl-message-quit 'mime-preview-quit) -(defalias 'wl-message-button-dispatcher 'mime-button-dispatcher) +(defalias 'wl-message-button-dispatcher-internal + 'mime-button-dispatcher) ;;; Summary (defun wl-summary-burst-subr (children target number) @@ -212,7 +149,7 @@ By setting following-method as yank-content." (while children (setq content-type (mime-entity-content-type (car children))) (if (eq (cdr (assq 'type content-type)) 'multipart) - (setq number (wl-summary-burst-subr + (setq number (wl-summary-burst-subr (mime-entity-children (car children)) target number)) @@ -221,24 +158,22 @@ By setting following-method as yank-content." (message (format "Bursting...%s" (setq number (+ 1 number)))) (setq message-entity (car (mime-entity-children (car children)))) - (save-restriction - (narrow-to-region (mime-entity-point-min message-entity) - (mime-entity-point-max message-entity)) - (elmo-append-msg target - ;;(mime-entity-content (car children)))) - (buffer-substring (point-min) (point-max)) - (std11-field-body "Message-ID"))))) + (elmo-append-msg target + (mime-entity-body (car children)) + (mime-entity-fetch-field message-entity + "Message-ID")))) (setq children (cdr children))) number)) (defun wl-summary-burst () + "" (interactive) (let ((raw-buf (wl-message-get-original-buffer)) children message-entity content-type target) (save-excursion (setq target wl-summary-buffer-folder-name) (while (not (elmo-folder-writable-p target)) - (setq target + (setq target (wl-summary-read-folder wl-default-folder "to extract to"))) (wl-summary-set-message-buffer-or-redisplay) (save-excursion @@ -249,7 +184,7 @@ By setting following-method as yank-content." (when children (message "Bursting...") (wl-summary-burst-subr children target 0) - (message "Bursting...done.")) + (message "Bursting...done")) (if (elmo-folder-plugged-p target) (elmo-commit target))) (wl-summary-sync-update3))) @@ -259,7 +194,7 @@ By setting following-method as yank-content." ;;; Yet another save method. (defun wl-mime-save-content (entity situation) (let ((filename (read-file-name "Save to file: " - (expand-file-name + (expand-file-name (or (mime-entity-safe-filename entity) ".") (or wl-mime-save-dir @@ -275,10 +210,9 @@ By setting following-method as yank-content." ;;; Yet another combine method. (defun wl-mime-combine-message/partial-pieces (entity situation) - "Internal method for wl to combine message/partial messages -automatically." + "Internal method for wl to combine message/partial messages automatically." (interactive) - (let* ((msgdb (save-excursion + (let* ((msgdb (save-excursion (set-buffer wl-message-buffer-cur-summary-buffer) wl-summary-buffer-msgdb)) (mime-display-header-hook 'wl-highlight-headers) @@ -293,13 +227,13 @@ automatically." (setq root-dir (concat root-dir "/" (replace-as-filename id))) (setq full-file (concat root-dir "/FULL")) (if (or (file-exists-p full-file) - (not (y-or-n-p "Merge partials?"))) + (not (y-or-n-p "Merge partials? "))) (with-current-buffer mother (mime-store-message/partial-piece entity situation)) - (setq subject-id + (setq subject-id (eword-decode-string - (decode-mime-charset-string - (wl-mime-entity-read-field entity 'Subject) + (decode-mime-charset-string + (mime-entity-read-field entity 'Subject) wl-summary-buffer-mime-charset))) (if (string-match "[0-9\n]+" subject-id) (setq subject-id (substring subject-id 0 (match-beginning 0)))) @@ -316,7 +250,7 @@ automatically." (elmo-msgdb-overview-entity-get-number (car overviews)))) (situation (mime-entity-situation message)) (the-id (or (cdr (assoc "id" situation)) ""))) - (when (string= (downcase the-id) + (when (string= (downcase the-id) (downcase id)) (with-current-buffer mother (mime-store-message/partial-piece message situation)) @@ -325,13 +259,20 @@ automatically." (setq overviews (cdr overviews))) (message "Not all partials found."))))) +(defun wl-mime-header-presentation-method (entity situation) + (let ((mmelmo-sort-field-list wl-message-sort-field-list)) + (mime-insert-header entity + wl-message-ignored-field-list + wl-message-visible-field-list) + (wl-highlight-headers))) + ;;; Setup methods. (defun wl-mime-setup () (set-alist 'mime-preview-quitting-method-alist 'mmelmo-original-mode 'wl-message-exit) (set-alist 'mime-view-over-to-previous-method-alist 'mmelmo-original-mode 'wl-message-exit) - (set-alist 'mime-view-over-to-next-method-alist + (set-alist 'mime-view-over-to-next-method-alist 'mmelmo-original-mode 'wl-message-exit) (set-alist 'mime-preview-over-to-previous-method-alist 'mmelmo-original-mode 'wl-message-exit) @@ -351,10 +292,10 @@ automatically." '((mode . "extract") (major-mode . mmelmo-original-mode) (method . wl-mime-save-content))) - (set-alist 'mime-preview-following-method-alist + (set-alist 'mime-preview-following-method-alist 'mmelmo-original-mode (function wl-message-follow-current-entity)) - (set-alist 'mime-view-following-method-alist + (set-alist 'mime-view-following-method-alist 'mmelmo-original-mode (function wl-message-follow-current-entity)) (set-alist 'mime-edit-message-inserter-alist @@ -362,16 +303,24 @@ automatically." (set-alist 'mime-edit-mail-inserter-alist 'wl-draft-mode (function wl-draft-insert-get-message)) (set-alist 'mime-edit-split-message-sender-alist - 'wl-draft-mode + 'wl-draft-mode (cdr (assq 'mail-mode mime-edit-split-message-sender-alist))) (set-alist 'mime-raw-representation-type-alist 'mmelmo-original-mode 'binary) ;; Sort and highlight header fields. - (setq mmelmo-sort-field-list wl-message-sort-field-list) - (add-hook 'mmelmo-header-inserted-hook 'wl-highlight-headers) + (or wl-message-ignored-field-list + (setq wl-message-ignored-field-list + mime-view-ignored-field-list)) + (or wl-message-visible-field-list + (setq wl-message-visible-field-list + mime-view-visible-field-list)) + (set-alist 'mime-header-presentation-method-alist + 'mmelmo-original-mode + (function wl-mime-header-presentation-method)) (add-hook 'mmelmo-entity-content-inserted-hook 'wl-highlight-body)) -(provide 'wl-mime) +(require 'product) +(product-provide (provide 'wl-mime) (require 'wl-version)) ;;; wl-mime.el ends here