X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=297e4a3ef507f3078a38e76469af722adc3ee891;hb=1f17ca3778008a59589a183a9440329055089d01;hp=f323d3b68de0ded0bf35ab59025ed292ed3e6e54;hpb=e3e5f572d472484c24a40f53375103b9c9a0a7a9;p=elisp%2Fwanderlust.git diff --git a/wl/wl-message.el b/wl/wl-message.el index f323d3b..297e4a3 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -1,6 +1,6 @@ ;;; wl-message.el -- Message displaying modules for Wanderlust. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news @@ -39,16 +39,10 @@ (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") @@ -60,12 +54,10 @@ (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) @@ -95,9 +87,9 @@ (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 @@ -137,16 +129,16 @@ (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))) @@ -190,6 +182,14 @@ (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) @@ -212,11 +212,9 @@ (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) @@ -236,7 +234,7 @@ (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)) @@ -269,7 +267,7 @@ (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)) @@ -288,7 +286,11 @@ (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)) @@ -336,13 +338,13 @@ (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 @@ -406,8 +408,7 @@ (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) @@ -422,10 +423,10 @@ (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 @@ -442,10 +443,10 @@ 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." @@ -496,10 +497,8 @@ (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 @@ -558,9 +557,40 @@ 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) @@ -582,7 +612,7 @@ 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))))) @@ -592,23 +622,28 @@ (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