;;; wl-message.el -- Message displaying modules for Wanderlust.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
-;; Time-stamp: <2000-03-17 10:19:41 teranisi>
;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
(require 'mime-view)
(require 'mmelmo-imap4))
(require 'tm-wl))
- (mapcar
- (function
- (lambda (symbol)
- (unless (boundp symbol)
- (set (make-local-variable symbol) nil))))
- '(mime-view-ignored-field-list mmelmo-imap4-skipped-parts))
- (defun-maybe event-window (a))
- (defun-maybe posn-window (a))
- (defun-maybe event-start (a))
- (defun-maybe mime-open-entity (a b)))
+ (defalias-maybe 'event-window 'ignore)
+ (defalias-maybe 'posn-window 'ignore)
+ (defalias-maybe 'event-start 'ignore)
+ (defalias-maybe 'mime-open-entity 'ignore))
(defvar wl-original-buf-name "*Message*")
(defvar wl-message-buf-name "Message")
(defvar wl-original-buffer-cur-number nil)
(defvar wl-original-buffer-cur-msgdb nil)
-(mapcar
- (function make-variable-buffer-local)
- (list 'wl-message-buffer-cur-folder
- 'wl-message-buffer-cur-number))
+(defvar mmelmo-imap4-skipped-parts)
-(provide 'wl-message)
+(make-variable-buffer-local 'wl-message-buffer-cur-folder)
+(make-variable-buffer-local 'wl-message-buffer-cur-number)
(defvar wl-fixed-window-configuration nil)
(setq gbw nil))
(if gbw
(select-window gbw)
-; (if (or (null mes)
-; wl-stay-folder-window)
-; (delete-other-windows))
+;;; (if (or (null mes)
+;;; wl-stay-folder-window)
+;;; (delete-other-windows))
(when wl-fixed-window-configuration
(delete-other-windows)
(and wl-stay-folder-window
(if (bobp)
()
(scroll-down))
- (select-window (get-buffer-window cur-buf))))
+ (select-window (get-buffer-window cur-buf))))
(defun wl-message-scroll-up (amount)
(let ((view-message-buffer (get-buffer-create wl-message-buf-name))
(widen)
(forward-page 1)
(if (pos-visible-in-window-p (point))
- (wl-message-narrow-to-page 1)))) ;Go to next page.
+ (wl-message-narrow-to-page 1)))) ; Go to next page.
(if (eobp)
()
(scroll-up))
(select-window (get-buffer-window cur-buf))))
(defun wl-message-follow-current-entity (buffer)
- "Follow to current message"
+ "Follow to current message."
(wl-draft-reply (wl-message-get-original-buffer)
- 'to-all wl-message-buffer-cur-summary-buffer)
+ nil wl-message-buffer-cur-summary-buffer) ; reply to all
(let ((mail-reply-buffer buffer))
(wl-draft-yank-from-mail-reply-buffer nil)))
(select-window (get-buffer-window summary-buf))))
(run-hooks 'wl-message-exit-hook)))
+(defvar wl-message-mode-map nil)
+(if wl-message-mode-map
+ ()
+ (setq wl-message-mode-map (make-sparse-keymap))
+ (define-key wl-message-mode-map "q" 'wl-message-exit)
+ (define-key wl-message-mode-map "n" 'wl-message-exit)
+ (define-key wl-message-mode-map "p" 'wl-message-exit))
+
(defun wl-message-decode (outbuf inbuf flag)
(cond
((eq flag 'all-header)
(save-excursion
(set-buffer inbuf)
(let ((buffer-read-only nil))
- (decode-mime-charset-region (point-min)
+ (decode-mime-charset-region (point-min)
(save-excursion
(goto-char (point-min))
(re-search-forward "^$" nil t)
(save-excursion
(set-buffer inbuf)
(let ((buffer-read-only nil))
- (save-excursion
+ (save-excursion
(set-buffer outbuf)
(elmo-set-buffer-multibyte nil))
(copy-to-buffer outbuf (point-min) (point-max))
(set-buffer outbuf)
- (local-set-key "q" 'wl-message-exit)
- (local-set-key "p" 'wl-message-exit)
- (local-set-key "n" 'wl-message-exit)
+ (use-local-map wl-message-mode-map)
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
- ;;(decode-mime-charset-region (point-min) (point-max) wl-mime-charset)
+;;; (decode-mime-charset-region (point-min) (point-max) wl-mime-charset)
;; we can call decode-coding-region() directly, because multibyte flag is t.
(decode-coding-region (point-min) (point-max) wl-cs-autoconv)
(wl-highlight-message (point-min)
(save-excursion
(set-buffer inbuf)
(let ((buffer-read-only nil))
- (decode-mime-charset-region (point-min)
+ (decode-mime-charset-region (point-min)
(save-excursion
(goto-char (point-min))
(re-search-forward "^$" nil t)
(wl-message-decode-mode outbuf inbuf))))
(defun wl-message-prev-page (&optional lines)
- "Scroll down this message. Returns non-nil if top of message"
+ "Scroll down this message. Returns non-nil if top of message."
(interactive)
(let ((cur-buf (current-buffer))
(view-message-buffer (get-buffer-create wl-message-buf-name))
- ret-val)
+ ret-val)
(wl-select-buffer view-message-buffer)
(move-to-window-line 0)
(if (and wl-break-pages
(static-if (fboundp 'luna-make-entity)
(defsubst wl-message-make-mime-entity (backend number backend folder msgdb)
(luna-make-entity (mm-expand-class-name 'elmo)
- :location (get-buffer-create
+ :location (get-buffer-create
(concat mmelmo-entity-buffer-name "0"))
- :imap (eq backend 'elmo-imap4)
+ :imap (eq backend 'elmo-imap4)
:folder folder
:number number
:msgdb msgdb :size 0))
(mime-open-entity backend (list folder number msgdb nil))))
(defun wl-message-next-page (&optional lines)
- "Scroll up this message. Returns non-nil if bottom of message"
+ "Scroll up this message. Returns non-nil if bottom of message."
(interactive)
(let ((cur-buf (current-buffer))
(view-message-buffer (get-buffer-create wl-message-buf-name))
(wl-message-narrow-to-page 1)
(setq ret-val nil))
(condition-case ()
- (scroll-up lines)
+ (static-if (boundp 'window-pixel-scroll-increment)
+ ;; XEmacs 21.2.20 and later.
+ (let (window-pixel-scroll-increment)
+ (scroll-up lines))
+ (scroll-up lines))
(end-of-buffer
(goto-char (point-max))))
(setq ret-val nil))
(setq wl-message-buffer-cur-summary-buffer sum-buf)))))
(defun wl-message-normal-get-original-buffer ()
- (let (ret-val)
- (if (setq ret-val (get-buffer wl-original-buf-name))
- ret-val
- (set-buffer (setq ret-val
- (get-buffer-create wl-original-buf-name)))
- (wl-message-original-mode)
- ret-val)))
+ (let ((ret-val (get-buffer wl-original-buf-name)))
+ (if (not ret-val)
+ (save-excursion
+ (set-buffer (setq ret-val
+ (get-buffer-create wl-original-buf-name)))
+ (wl-message-original-mode)))
+ ret-val))
(if wl-use-semi
- (defalias 'wl-message-get-original-buffer
+ (defalias 'wl-message-get-original-buffer
'mmelmo-get-original-buffer)
- (defalias 'wl-message-get-original-buffer
+ (defalias 'wl-message-get-original-buffer
'wl-message-normal-get-original-buffer))
(defvar wl-message-redisplay-func 'wl-normal-message-redisplay)
;; nil means don't fetch all.
(defun wl-message-decide-backend (folder number message-id size)
- (let ((dont-do-that (and
+ (let ((dont-do-that (and
(not (setq wl-message-cache-used
(or
(elmo-buffer-cache-hit
(list folder number message-id))
- (elmo-cache-exists-p message-id
+ (elmo-cache-exists-p message-id
folder number))))
(integerp size)
(not (elmo-local-file-p folder number))
wl-fetch-confirm-threshold
(>= size wl-fetch-confirm-threshold)
- (not (y-or-n-p
- (format "Fetch entire message? (%dbytes)"
+ (not (y-or-n-p
+ (format "Fetch entire message? (%dbytes)"
size))))))
(message "")
(cond ((and dont-do-that
&optional force-reload)
(let* ((cur-buf (current-buffer))
(view-message-buffer (wl-message-get-buffer-create))
- (message-id (cdr (assq number
+ (message-id (cdr (assq number
(elmo-msgdb-get-number-alist msgdb))))
(size (elmo-msgdb-overview-entity-get-size
- (assoc message-id
- (elmo-msgdb-get-overview msgdb))))
+ (elmo-msgdb-overview-get-entity number msgdb)))
(backend (wl-message-decide-backend folder number message-id size))
cur-entity ret-val header-end real-fld-num summary-win)
(require 'mmelmo)
(wl-select-buffer view-message-buffer)
(set-buffer view-message-buffer)
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows nil)
+ (setq truncate-lines wl-message-truncate-lines)
(unwind-protect
(progn
(setq wl-message-buffer-cur-summary-buffer cur-buf)
(erase-buffer)
(if backend
(let (mime-display-header-hook ;; bind to nil...
- (mime-view-ignored-field-list
+ (wl-message-ignored-field-list
(if (eq flag 'all-header)
nil
- mime-view-ignored-field-list))
+ wl-message-ignored-field-list))
(mmelmo-force-reload force-reload)
(mmelmo-imap4-threshold wl-fetch-confirm-threshold))
(setq real-fld-num (elmo-get-real-folder-number
folder number))
(setq cur-entity
(wl-message-make-mime-entity
- backend
+ backend
(if (eq backend 'elmo-imap4)
(cdr real-fld-num)
number)
folder)
msgdb))
(setq mmelmo-imap4-skipped-parts nil)
- ;;; mime-display-message sets buffer-read-only variable as t.
- ;;; which makes buffer read-only status confused...
- (wl-mime-display-message cur-entity view-message-buffer
- nil nil 'mmelmo-original-mode)
+ ;; mime-display-message sets buffer-read-only variable as t.
+ ;; which makes buffer read-only status confused...
+ (mime-display-message cur-entity view-message-buffer
+ nil nil 'mmelmo-original-mode)
(if mmelmo-imap4-skipped-parts
(progn
(message "Skipped fetching of %s."
- (mapconcat
+ (mapconcat
(lambda (x)
(format "[%s]" x))
mmelmo-imap4-skipped-parts ","))))
ret-val
))
-(defun wl-normal-message-redisplay (folder number flag msgdb
+(defun wl-normal-message-redisplay (folder number flag msgdb
&optional force-reload)
(interactive)
(let* ((cur-buf (current-buffer))
(original-message-buffer (wl-message-get-original-buffer))
(view-message-buffer (wl-message-get-buffer-create))
- (message-id (cdr (assq number
+ (message-id (cdr (assq number
(elmo-msgdb-get-number-alist msgdb))))
(size (elmo-msgdb-overview-entity-get-size
- (assoc message-id
- (elmo-msgdb-get-overview msgdb))))
- header-end ret-val summary-win
- )
+ (elmo-msgdb-overview-get-entity number msgdb)))
+ header-end ret-val summary-win)
(wl-select-buffer view-message-buffer)
(unwind-protect
(progn
(setq buffer-read-only nil)
(erase-buffer)
(if (or (eq (elmo-folder-number-get-type folder number) 'localdir)
- (not (and (integerp size)
+ (not (and (not
+ (setq wl-message-cache-used
+ (or
+ (elmo-buffer-cache-hit
+ (list folder number message-id))
+ (elmo-cache-exists-p message-id
+ folder number))))
+ (integerp size)
wl-fetch-confirm-threshold
(>= size wl-fetch-confirm-threshold)
- (not (elmo-cache-exists-p message-id
- folder number))
(not (y-or-n-p
- (format "Fetch entire message? (%dbytes)"
+ (format "Fetch entire message? (%dbytes)"
size))))))
(progn
(save-excursion
(elmo-read-msg-with-buffer-cache
folder number original-message-buffer msgdb force-reload)))
;; decode MIME message.
- (wl-message-decode
- view-message-buffer
+ (wl-message-decode
+ view-message-buffer
original-message-buffer flag)
(setq ret-val t))
(save-excursion
(wl-message-narrow-to-page)
(error nil)) ; ignore errors.
(setq mode-line-buffer-identification
- (format "Wanderlust: << %s / %s >>"
+ (format "Wanderlust: << %s / %s >>"
(if (memq 'modeline wl-use-folder-petname)
(wl-folder-get-petname folder)
folder)
(unwind-protect
(run-hooks 'wl-message-redisplay-hook)
;; go back to summary mode
- (set-buffer-modified-p nil)
+ (set-buffer-modified-p nil)
(setq buffer-read-only t)
(set-buffer cur-buf)
(setq summary-win (get-buffer-window cur-buf))
ret-val
)))
+(defvar wl-message-button-map (make-sparse-keymap))
+
+(defun wl-message-add-button (from to function &optional data)
+ "Create a button between FROM and TO with callback FUNCTION and DATA."
+ (add-text-properties
+ from to
+ (nconc (list 'wl-message-button-callback function)
+ (if data
+ (list 'wl-message-button-data data))))
+ (let ((ov (make-overlay from to)))
+ (overlay-put ov 'mouse-face 'highlight)
+ (overlay-put ov 'local-map wl-message-button-map)
+ (overlay-put ov 'evaporate t)))
+
+(defun wl-message-button-dispatcher (event)
+ "Select the button under point."
+ (interactive "@e")
+ (mouse-set-point event)
+ (let ((callback (get-text-property (point) 'wl-message-button-callback))
+ (data (get-text-property (point) 'wl-message-button-data)))
+ (if callback
+ (funcall callback data)
+ (wl-message-button-dispatcher-internal event))))
+
+(defun wl-message-button-refer-article (data)
+ "Read article specified by Message-ID DATA at point."
+ (switch-to-buffer-other-window
+ wl-message-buffer-cur-summary-buffer)
+ (if (wl-summary-jump-to-msg-by-message-id data)
+ (wl-summary-redisplay)))
+
(defun wl-message-refer-article-or-url (e)
- "Read article specified by message-id around point. If failed,
- attempt to execute button-dispatcher."
+ "Read article specified by message-id around point.
+If failed, attempt to execute button-dispatcher."
(interactive "e")
(let ((window (get-buffer-window (current-buffer)))
mouse-window point beg end msg-id)
(setq beg (save-excursion (beginning-of-line) (point)))
(setq end (save-excursion (end-of-line) (point)))
(search-forward ">" end t) ;Move point to end of "<....>".
- (if (and (re-search-backward "\\(<[^<> \t\n]+@[^<> \t\n]+>\\)"
+ (if (and (re-search-backward "\\(<[^<> \t\n]+@[^<> \t\n]+>\\)"
beg t)
- (not (string-match "mailto:"
+ (not (string-match "mailto:"
(setq msg-id (wl-match-buffer 1)))))
(progn
(goto-char point)
- (switch-to-buffer-other-window
+ (switch-to-buffer-other-window
wl-message-buffer-cur-summary-buffer)
(if (wl-summary-jump-to-msg-by-message-id msg-id)
(wl-summary-redisplay)))
- (wl-message-button-dispatcher e)))
+ (wl-message-button-dispatcher-internal e)))
(if (eq mouse-window (get-buffer-window (current-buffer)))
(select-window window)))))
(search-forward "\n\n")
(let ((sp (point))
ep filename case-fold-search)
- (if first
- (progn
- (re-search-forward "^begin[ \t]+[0-9]+[ \t]+\\([^ ].*\\)" nil t)
- (setq filename (buffer-substring (match-beginning 1)(match-end 1))))
- (re-search-forward "^M.*$" nil t)) ; uuencoded string
- (beginning-of-line)
- (setq sp (point))
- (goto-char (point-max))
- (if last
- (re-search-backward "^end" sp t)
- (re-search-backward "^M.*$" sp t)) ; uuencoded string
- (forward-line 1)
- (setq ep (point))
- (set-buffer outbuf)
- (goto-char (point-max))
- (insert-buffer-substring buf sp ep)
- (set-buffer buf)
- filename)))
+ (catch 'done
+ (if first
+ (progn
+ (if (re-search-forward "^begin[ \t]+[0-9]+[ \t]+\\([^ ].*\\)" nil t)
+ (setq filename (buffer-substring (match-beginning 1)(match-end 1)))
+ (throw 'done nil)))
+ (re-search-forward "^M.*$" nil t)) ; uuencoded string
+ (beginning-of-line)
+ (setq sp (point))
+ (goto-char (point-max))
+ (if last
+ (re-search-backward "^end" sp t)
+ (re-search-backward "^M.*$" sp t)) ; uuencoded string
+ (forward-line 1)
+ (setq ep (point))
+ (set-buffer outbuf)
+ (goto-char (point-max))
+ (insert-buffer-substring buf sp ep)
+ (set-buffer buf)
+ filename))))
+
+(require 'product)
+(product-provide (provide 'wl-message) (require 'wl-version))
;;; wl-message.el ends here
projects / elisp / wanderlust.git / blobdiff