header.
* wl-vars.el (wl-summary-mode-line-format-spec-alist): Added spec "m".
(wl-message-mode-line-format-spec-alist): Ditto.
(wl-message-mode-line-format): Ditto.
(wl-summary-mode-line-format): Ditto for docstring.
(wl-summary-no-mime-folder-list): Fix typo.
* wl-util.el (wl-current-message-buffer): Call
`wl-message-buffer-display' with `as-is' and `all-header' as nil.
* wl-summary.el (wl-summary-buffer-display-as-is): New buffer-local
variable.
(wl-summary-mode-map): Bind 'M' as `wl-summary-toggle-mime' instead
of `wl-summary-redisplay-no-mime'.
(wl-summary-goto-folder-subr): Set up wl-summary-buffer-display-as-is.
(wl-summary-toggle-mime): New function.
(wl-summary-redisplay-all-header): Rewrite.
(wl-summary-redisplay-no-mime): Ditto.
(wl-summary-redisplay-internal): Added argument `as-is' and
`all-header'.
* wl-refile.el (wl-refile-default-from-folder-path-separator):
New variable.
(wl-refile-guess-functions): Added wl-refile-guess-by-from at the
bottom.
(wl-refile-guess-by-history): Don't use wl-refile-guess-by-from.
(wl-refile-guess-by-from): Rewrite to fix the bug which inserts
"/" unconditionally.
* wl-mime.el (wl-draft-yank-current-message-entity): Use
wl-mime-preview-follow-no-mime for as-is content.
(wl-mime-preview-follow-no-mime): New function.
(wl-mime-preview-follow-current-region): Fixed parenthesis.
* wl-message.el (wl-message-redisplay): Removed argument `display-type'
and added `as-is', `all-header'.
(wl-message-buffer-display): Ditto.
(wl-message-buffer-display-type): New function.
+2004-09-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-mime.el (elmo-mime-display-as-is-internal): Insert decoded
+ header.
+
2004-09-23 Yuuichi Teranishi <teranisi@gohome.org>
* modb-standard.el (modb-standard-load-entity): Don't bind inhibit-quit
;; Humm...
(set-buffer-multibyte nil)
- (mime-insert-entity message)
+ (insert (mime-entity-body message))
(set-buffer-multibyte t)
(decode-coding-region (point-min) (point-max)
elmo-mime-display-as-is-coding-system)
- (save-restriction
- (std11-narrow-to-header)
- (run-hooks 'elmo-message-header-inserted-hook))
+ (goto-char (point-min))
+ (insert "\n")
+ (goto-char (point-min))
+
+ (let ((method (cdr (assq original-major-mode
+ mime-header-presentation-method-alist))))
+ (if (functionp method)
+ (funcall method message nil)))
+
;; set original major mode for mime-preview-quit
(put-text-property (point-min) (point-max)
'mime-view-situation
`((major-mode . ,original-major-mode)))
+ (put-text-property (point-min) (point-max)
+ 'elmo-as-is-entity message)
(use-local-map
(or keymap
(if default-keymap-or-function
(mime-view-define-keymap default-keymap-or-function)
mime-view-mode-default-map)))
- (let ((point
- (next-single-property-change (point-min) 'mime-view-entity)))
- (if point
- (goto-char point)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
(run-hooks 'mime-view-mode-hook)
(set-buffer-modified-p nil)
(setq buffer-read-only t)
+2004-09-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-vars.el (wl-summary-mode-line-format-spec-alist): Added spec "m".
+ (wl-message-mode-line-format-spec-alist): Ditto.
+ (wl-message-mode-line-format): Ditto.
+ (wl-summary-mode-line-format): Ditto for docstring.
+ (wl-summary-no-mime-folder-list): Fix typo.
+
+ * wl-util.el (wl-current-message-buffer): Call
+ `wl-message-buffer-display' with `as-is' and `all-header' as nil.
+
+ * wl-summary.el (wl-summary-buffer-display-as-is): New buffer-local
+ variable.
+ (wl-summary-mode-map): Bind 'M' as `wl-summary-toggle-mime' instead
+ of `wl-summary-redisplay-no-mime'.
+ (wl-summary-goto-folder-subr): Set up wl-summary-buffer-display-as-is.
+ (wl-summary-toggle-mime): New function.
+ (wl-summary-redisplay-all-header): Rewrite.
+ (wl-summary-redisplay-no-mime): Ditto.
+ (wl-summary-redisplay-internal): Added argument `as-is' and
+ `all-header'.
+
+ * wl-refile.el (wl-refile-default-from-folder-path-separator):
+ New variable.
+ (wl-refile-guess-functions): Added wl-refile-guess-by-from at the
+ bottom.
+ (wl-refile-guess-by-history): Don't use wl-refile-guess-by-from.
+ (wl-refile-guess-by-from): Rewrite to fix the bug which inserts
+ "/" unconditionally.
+
+ * wl-mime.el (wl-draft-yank-current-message-entity): Use
+ wl-mime-preview-follow-no-mime for as-is content.
+ (wl-mime-preview-follow-no-mime): New function.
+ (wl-mime-preview-follow-current-region): Fixed parenthesis.
+
+ * wl-message.el (wl-message-redisplay): Removed argument `display-type'
+ and added `as-is', `all-header'.
+ (wl-message-buffer-display): Ditto.
+ (wl-message-buffer-display-type): New function.
+
2004-09-21 Yoichi NAKAYAMA <yoichi@geiin.org>
* wl-vars.el (wl-message-header-button-alist): Change default
(nth 3 entry) (match-string (nth 4 entry))))
(goto-char end)))))))
-(defun wl-message-redisplay (folder number display-type &optional force-reload)
+(defun wl-message-redisplay (folder number as-is all-header
+ &optional force-reload)
(let* ((default-mime-charset wl-mime-charset)
(buffer-read-only nil)
(summary-buf (current-buffer))
summary-win delim flags)
(setq buffer-read-only nil)
(setq cache-used (wl-message-buffer-display
- folder number display-type force-reload))
+ folder number as-is all-header force-reload))
(setq wl-message-buffer (car cache-used))
(setq message-buf wl-message-buffer)
(wl-message-select-buffer wl-message-buffer)
(wl-message-add-buttons-to-header (point-min) (point))
(wl-message-add-buttons-to-body (point) (point-max)))
(when (and wl-message-use-header-narrowing
- (not (memq display-type '(all-header as-is))))
+ (not all-header))
(wl-message-header-narrowing))
(goto-char (point-min))
(ignore-errors (run-hooks 'wl-message-redisplay-hook))
(select-window summary-win))
cache-used))
+(defun wl-message-buffer-display-type (as-is all-header)
+ (let ((type ""))
+ (if as-is
+ (setq type (concat type "as-is"))
+ (setq type (concat type "mime")))
+ (when all-header (setq type (concat type "-all-header")))
+ (intern type)))
+
;; Use message buffer cache.
-(defun wl-message-buffer-display (folder number display-type
+(defun wl-message-buffer-display (folder number as-is all-header
&optional force-reload unread)
(let* ((msg-id (ignore-errors (elmo-message-field folder number
'message-id)))
(widen)
(goto-char (point-min))
(ignore-errors (wl-message-narrow-to-page))
- (unless (eq wl-message-buffer-cur-display-type display-type)
+ (unless (eq wl-message-buffer-cur-display-type
+ (wl-message-buffer-display-type as-is all-header))
(setq read t))))
;; delete tail and add new to the top.
(setq hit (wl-message-buffer-cache-add (list fname number msg-id)))
(set-buffer hit)
(setq
cache-used
- (wl-message-display-internal folder number display-type
+ (wl-message-display-internal folder number as-is all-header
force-reload unread))
- (setq wl-message-buffer-cur-display-type display-type))
+ (setq wl-message-buffer-cur-display-type
+ (wl-message-buffer-display-type as-is all-header)))
(quit
(wl-message-buffer-cache-delete)
(error "Display message %s/%s is quitted" fname number))
nil))) ;; will not be used
(cons hit cache-used)))
-(defun wl-message-display-internal (folder number display-type
+(defun wl-message-display-internal (folder number as-is all-header
&optional force-reload unread)
(let ((default-mime-charset wl-mime-charset)
(elmo-mime-charset wl-mime-charset))
- (setq wl-message-buffer-require-all-header (eq display-type
- 'all-header))
+ (setq wl-message-buffer-require-all-header all-header)
(prog1
- (if (eq display-type 'as-is)
+ (if as-is
(let (wl-highlight-x-face-function)
(prog1 (elmo-mime-display-as-is folder number
(current-buffer)
(set-buffer message-buffer)
(save-restriction
(widen)
- (if (wl-region-exists-p)
- (wl-mime-preview-follow-current-region)
- (mime-preview-follow-current-entity))))
+ (cond
+ ((wl-region-exists-p)
+ (wl-mime-preview-follow-current-region))
+ ((get-text-property (point-min) 'mime-view-entity)
+ (mime-preview-follow-current-entity))
+ (t
+ (wl-mime-preview-follow-no-mime)))))
(error "No message."))))
;; modified mime-preview-follow-current-entity from mime-view.el
+(defun wl-mime-preview-follow-no-mime ()
+ "Write follow message to current message, without mime.
+It calls following-method selected from variable
+`mime-preview-following-method-alist'."
+ (interactive)
+ (let* ((mode (mime-preview-original-major-mode 'recursive))
+ (new-name (format "%s-no-mime" (buffer-name)))
+ new-buf beg end
+ (entity (get-text-property (point-min) 'elmo-as-is-entity))
+ (the-buf (current-buffer))
+ fields)
+ (save-excursion
+ (goto-char (point-min))
+ (setq beg (re-search-forward "^$" nil t)
+ end (point-max)))
+ (save-excursion
+ (set-buffer (setq new-buf (get-buffer-create new-name)))
+ (erase-buffer)
+ (insert-buffer-substring the-buf beg end)
+ (goto-char (point-min))
+ ;; Insert all headers.
+ (mime-insert-header entity)
+ (let ((f (cdr (assq mode mime-preview-following-method-alist))))
+ (if (functionp f)
+ (funcall f new-buf)
+ (message
+ "Sorry, following method for %s is not implemented yet."
+ mode))))))
+
+;; modified mime-preview-follow-current-entity from mime-view.el
(defun wl-mime-preview-follow-current-region ()
"Write follow message to current region.
It calls following-method selected from variable
(mime-insert-header current-entity fields)
t))
(setq fields (std11-collect-field-names)
- current-entity (mime-entity-parent current-entity))
- ))
+ current-entity (mime-entity-parent current-entity))))
(let ((rest mime-view-following-required-fields-list)
field-name ret)
(while rest
entity field-name))))
(setq entity (mime-entity-parent entity)))))
(if ret
- (insert (concat field-name ": " ret "\n"))
- )))
- (setq rest (cdr rest))
- ))
- )
+ (insert (concat field-name ": " ret "\n")))))
+ (setq rest (cdr rest)))))
(let ((f (cdr (assq mode mime-preview-following-method-alist))))
(if (functionp f)
(funcall f new-buf)
(message
"Sorry, following method for %s is not implemented yet."
- mode)
- ))
- )))
+ mode))))))
(defalias 'wl-draft-enclose-digest-region 'mime-edit-enclose-digest-region)
(defvar wl-refile-subject-alist nil)
(defvar wl-refile-subject-alist-file-name "refile-subject-alist")
+(defvar wl-refile-default-from-folder-path-separator "/")
+
(defvar wl-refile-alist-max-length 1000)
(defun wl-refile-alist-setup ()
'(wl-refile-guess-by-rule
wl-refile-guess-by-msgid
wl-refile-guess-by-subject
- wl-refile-guess-by-history)
+ wl-refile-guess-by-history
+ wl-refile-guess-by-from)
"*Functions in this list are used for guessing refile destination folder.")
;; 2000-11-05: *-func-list -> *-functions
(if (setq ret-val (cdr (assoc (car tocc-list) wl-refile-alist)))
(setq tocc-list nil)
(setq tocc-list (cdr tocc-list))))
- (or ret-val
- (wl-refile-guess-by-from entity))))
+ ret-val))
(defun wl-refile-get-account-part-from-address (address)
(if (string-match "\\([^@]+\\)@[^@]+" address)
address))
(defun wl-refile-guess-by-from (entity)
- (let ((from
- (downcase (wl-address-header-extract-address
- (elmo-message-entity-field entity 'from)))))
+ (let ((from (downcase (wl-address-header-extract-address
+ (elmo-message-entity-field entity 'from))))
+ (folder (elmo-make-folder wl-refile-default-from-folder))
+ (elmo-path-sep wl-refile-default-from-folder-path-separator))
;; search from alist
(or (cdr (assoc from wl-refile-alist))
- (elmo-concat-path wl-refile-default-from-folder
- (wl-refile-get-account-part-from-address from)))))
+ (concat
+ (elmo-folder-prefix-internal folder)
+ (elmo-concat-path
+ (substring wl-refile-default-from-folder
+ (length (elmo-folder-prefix-internal folder)))
+ (wl-refile-get-account-part-from-address from))))))
(defun wl-refile-guess-by-msgid (entity)
(cdr (assoc (elmo-message-entity-field entity 'references)
(defvar wl-summary-buffer-line-format nil)
(defvar wl-summary-buffer-mode-line-formatter nil)
(defvar wl-summary-buffer-mode-line nil)
+(defvar wl-summary-buffer-display-as-is nil)
(defvar wl-thread-indent-level-internal nil)
(defvar wl-thread-have-younger-brother-str-internal nil)
(make-variable-buffer-local 'wl-summary-buffer-line-format)
(make-variable-buffer-local 'wl-summary-buffer-mode-line-formatter)
(make-variable-buffer-local 'wl-summary-buffer-mode-line)
+(make-variable-buffer-local 'wl-summary-buffer-display-as-is)
(defvar wl-datevec)
(defvar wl-thr-indent-string)
(define-key wl-summary-mode-map "\C-c\C-p" 'wl-summary-previous-buffer)
(define-key wl-summary-mode-map "\C-c\C-n" 'wl-summary-next-buffer)
(define-key wl-summary-mode-map "H" 'wl-summary-redisplay-all-header)
- (define-key wl-summary-mode-map "M" 'wl-summary-redisplay-no-mime)
+ (define-key wl-summary-mode-map "M" 'wl-summary-toggle-mime)
(define-key wl-summary-mode-map "B" 'wl-summary-burst)
(define-key wl-summary-mode-map "Z" 'wl-status-update)
(define-key wl-summary-mode-map "#" 'wl-summary-print-message)
(unless (eq major-mode 'wl-summary-mode)
(wl-summary-mode))
(wl-summary-buffer-set-folder folder)
+ (setq wl-summary-buffer-display-as-is
+ (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
(setq wl-summary-buffer-disp-msg nil)
(setq wl-summary-buffer-last-displayed-msg nil)
(setq wl-summary-buffer-current-msg nil)
(if (null number-list)
(message "No message.")
(if inverse
- (elmo-folder-unset-flag folder number-list 'read no-folder-mark)
- (elmo-folder-set-flag folder number-list 'read no-folder-mark))
+ (elmo-folder-set-flag folder number-list 'unread no-folder-mark)
+ (elmo-folder-unset-flag folder number-list 'unread no-folder-mark))
(dolist (number number-list)
(setq visible (wl-summary-jump-to-msg number))
(unless inverse
(progn
(set-buffer wl-message-buffer)
t)
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime-internal folder number)
- (wl-summary-redisplay-internal folder number))
+ (wl-summary-redisplay-internal folder number nil
+ wl-summary-buffer-display-as-is)
(when (buffer-live-p wl-message-buffer)
(set-buffer wl-message-buffer))
nil)))
(wl-summary-redisplay)))
(message "No last message.")))
+(defun wl-summary-toggle-mime ()
+ "Toggle MIME decoding."
+ (interactive)
+ (setq wl-summary-buffer-display-as-is
+ (not wl-summary-buffer-display-as-is))
+ (wl-summary-redisplay)
+ (wl-summary-update-modeline)
+ (message "MIME decoding: %s"
+ (if wl-summary-buffer-display-as-is "OFF" "ON")))
+
(defun wl-summary-redisplay (&optional arg)
+ "Redisplay message."
+ (interactive "P")
+ (wl-summary-redisplay-internal nil nil arg
+ wl-summary-buffer-display-as-is))
+
+(defun wl-summary-redisplay-all-header (&optional arg)
+ "Redisplay message with all header."
(interactive "P")
- (if (and (not arg)
- (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
- (wl-summary-redisplay-no-mime)
- (wl-summary-redisplay-internal nil nil arg)))
+ (wl-summary-redisplay-internal nil nil arg
+ wl-summary-buffer-display-as-is 'all-header))
+
+(defun wl-summary-redisplay-no-mime (&optional ask-coding)
+ "Display message without MIME decoding.
+If ASK-CODING is non-nil, coding-system for the message is asked."
+ (interactive "P")
+ (let ((elmo-mime-display-as-is-coding-system
+ (if ask-coding
+ (or (read-coding-system "Coding system: ")
+ elmo-mime-display-as-is-coding-system)
+ elmo-mime-display-as-is-coding-system)))
+ (wl-summary-redisplay-internal nil nil nil t 'all-header)))
-(defun wl-summary-redisplay-internal (&optional folder number force-reload)
+(defun wl-summary-redisplay-internal (&optional folder number force-reload
+ as-is all-header)
(let* ((folder (or folder wl-summary-buffer-elmo-folder))
(num (or number (wl-summary-message-number)))
(wl-mime-charset wl-summary-buffer-mime-charset)
(setq no-folder-mark
;; If cache is used, change folder-mark.
(if (wl-message-redisplay folder num
- 'mime
+ as-is all-header
(or
force-reload
(string= (elmo-folder-name-internal
(run-hooks 'wl-summary-redisplay-hook))
(message "No message to display."))))
-(defun wl-summary-redisplay-no-mime (&optional ask-coding)
- "Display message without MIME decoding.
-If ASK-CODING is non-nil, coding-system for the message is asked."
- (interactive "P")
- (let ((elmo-mime-display-as-is-coding-system
- (if ask-coding
- (or (read-coding-system "Coding system: ")
- elmo-mime-display-as-is-coding-system)
- elmo-mime-display-as-is-coding-system)))
- (wl-summary-redisplay-no-mime-internal)))
-
-(defun wl-summary-redisplay-no-mime-internal (&optional folder number)
- (let* ((fld (or folder wl-summary-buffer-elmo-folder))
- (num (or number (wl-summary-message-number)))
- wl-break-pages)
- (if num
- (progn
- (setq wl-summary-buffer-disp-msg t)
- (setq wl-summary-buffer-last-displayed-msg
- wl-summary-buffer-current-msg)
- (setq wl-current-summary-buffer (current-buffer))
- (wl-message-redisplay fld num 'as-is
- (string= (elmo-folder-name-internal fld)
- wl-draft-folder))
- (when (elmo-message-use-cache-p fld num)
- (elmo-message-set-cached fld num t))
- (ignore-errors
- (if (elmo-message-flagged-p fld num 'unread)
- (wl-summary-mark-as-read num); no-folder-mark)
- (wl-summary-update-persistent-mark)))
- (setq wl-summary-buffer-current-msg num)
- (when wl-summary-recenter
- (recenter (/ (- (window-height) 2) 2))
- (if (not wl-summary-indent-length-limit)
- (wl-horizontal-recenter)))
- (wl-highlight-summary-displaying)
- (run-hooks 'wl-summary-redisplay-hook))
- (message "No message to display.")
- (wl-ask-folder 'wl-summary-exit
- "No more messages. Type SPC to go to folder mode."))))
-
-(defun wl-summary-redisplay-all-header (&optional folder number)
- (interactive)
- (let* ((fld (or folder wl-summary-buffer-elmo-folder))
- (num (or number (wl-summary-message-number)))
- (wl-mime-charset wl-summary-buffer-mime-charset)
- (default-mime-charset wl-summary-buffer-mime-charset))
- (if num
- (progn
- (setq wl-summary-buffer-disp-msg t)
- (setq wl-summary-buffer-last-displayed-msg
- wl-summary-buffer-current-msg)
- (setq wl-current-summary-buffer (current-buffer))
- (when (elmo-message-use-cache-p fld num)
- (elmo-message-set-cached fld num t))
- (if (wl-message-redisplay fld num 'all-header
- (string= (elmo-folder-name-internal fld)
- wl-draft-folder))
- (wl-summary-mark-as-read num))
- (setq wl-summary-buffer-current-msg num)
- (when wl-summary-recenter
- (recenter (/ (- (window-height) 2) 2))
- (if (not wl-summary-indent-length-limit)
- (wl-horizontal-recenter)))
- (wl-highlight-summary-displaying)
- (run-hooks 'wl-summary-redisplay-hook))
- (message "No message to display."))))
-
(defun wl-summary-jump-to-current-message ()
"Jump into Message buffer."
(interactive)
(and (wl-summary-message-number)
(car (wl-message-buffer-display wl-summary-buffer-elmo-folder
(wl-summary-message-number)
- 'mime)))))))
+ nil nil)))))))
(defmacro wl-kill-buffers (regexp)
(` (mapcar (function
wl-summary-buffer-elmo-folder))
(elmo-folder-name-internal wl-summary-buffer-elmo-folder)))
(?t (if (eq wl-summary-buffer-view 'thread) "T" "S"))
+ (?m (if wl-summary-buffer-display-as-is "-" "M"))
(?n wl-summary-buffer-new-count)
(?u wl-summary-buffer-unread-count)
(?a (length wl-summary-buffer-number-list)))
%f The folder name.
%t The thread status of the summary ('T' for thread, 'S' for sequential).
+%m The mime analysis status of the summary ('M' for MIME ON)
%n The number of new messages.
%u The number of unread messages (includes new messages).
%a The number of all messages."
:group 'wl-summary-marks)
(defcustom wl-summary-no-mime-folder-list nil
- "*All folders that match this list don't analysis mime."
+ "*All folders that match this list don't analyze mime."
:type '(repeat string)
:group 'wl-summary)
'((?f (if (memq 'modeline wl-use-folder-petname)
(wl-folder-get-petname wl-message-buffer-cur-folder)
wl-message-buffer-cur-folder))
+ (?m (if (get-text-property (point-min) 'mime-view-entity)
+ "MIME" "AS-IS"))
(?F wl-message-buffer-flag-indicator)
(?n wl-message-buffer-cur-number))
"An alist of format specifications for message buffer's mode-lines.
SPEC is a character for format specification.
STRING-EXP is an expression to get string to insert.")
-(defcustom wl-message-mode-line-format "Wanderlust: << %f / %n %F>>"
+(defcustom wl-message-mode-line-format "Wanderlust: << %f / %n %F>> [%m]"
"*A format string for message buffer's mode-line of Wanderlust.
It may include any of the following format specifications
which are replaced by the given information:
%f The folder name.
%n The number of the message.
+%m The MIME analysis status.
%F The global flag indicator."
:group 'wl-pref
:type 'string)
projects / elisp / wanderlust.git / commitdiff