;;; wl-summary.el -- Summary mode for Wanderlust.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
-;; Copyright 1999,2000 TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
-;; Copyright 1999,2000 Kenichi OKADA <okada@opaopa.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; Copyright (C) 1999,2000 TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
+;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
-;; TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
-;; Kenichi OKADA <okada@opaopa.org>
+;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
+;; Kenichi OKADA <okada@opaopa.org>
;; Keywords: mail, net news
;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
(defvar wl-summary-buffer-prev-folder-func nil)
(defvar wl-summary-buffer-next-folder-func nil)
(defvar wl-summary-buffer-exit-func nil)
+(defvar wl-summary-buffer-number-list nil)
+
(defvar wl-thread-indent-level-internal nil)
(defvar wl-thread-have-younger-brother-str-internal nil)
(defvar wl-thread-youngest-child-str-internal nil)
(defvar wl-summary-search-buf-name " *wl-search-subject*")
(defvar wl-summary-delayed-update nil)
+(defvar wl-summary-get-petname-func 'wl-address-get-petname-1)
+
(defvar wl-summary-message-regexp "^ *\\([0-9]+\\)")
(defvar wl-summary-shell-command-last "")
(make-variable-buffer-local 'wl-summary-buffer-prev-folder-func)
(make-variable-buffer-local 'wl-summary-buffer-next-folder-func)
(make-variable-buffer-local 'wl-summary-buffer-exit-func)
+(make-variable-buffer-local 'wl-summary-buffer-number-list)
;; internal functions (dummy)
(unless (fboundp 'wl-summary-append-message-func-internal)
(eword-decode-string
(if wl-use-petname
(or
- (wl-address-get-petname-1 to)
+ (funcall wl-summary-get-petname-func to)
(car
(std11-extract-address-components to))
to)
entity "newsgroups"))
(setq retval (concat "Ng:" ng)))))
(if wl-use-petname
- (setq retval (or (wl-address-get-petname-1 from)
+ (setq retval (or (funcall wl-summary-get-petname-func from)
(car (std11-extract-address-components from))
from))
(setq retval from)))
(defun wl-summary-simple-from (string)
(if wl-use-petname
- (or (wl-address-get-petname-1 string)
+ (or (funcall wl-summary-get-petname-func string)
(car (std11-extract-address-components string))
string)
string))
(define-key wl-summary-mode-map "P" 'wl-summary-up)
;;;(define-key wl-summary-mode-map "w" 'wl-draft)
(define-key wl-summary-mode-map "w" 'wl-summary-write)
- (define-key wl-summary-mode-map "W" 'wl-summary-write-current-newsgroup)
+ (define-key wl-summary-mode-map "W" 'wl-summary-write-current-folder)
;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file)
(define-key wl-summary-mode-map "e" 'wl-summary-save)
(define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
(defun wl-summary-mode ()
"Major mode for reading threaded messages.
-The keys that are defined for this mode are:\\<wl-summary-mode-map>
-
-SPC Read messages.
-DEL Back-scroll this message.
-. Force to display this message.
-RET Make this message scroll up with one line.
-M-RET - Make this message scroll down with one line.
-
-C-n Go to the next line.
-C-p Go to the previous line.
-n Move to below then display.
-N Move to next unread.
-p Move to above then display.
-P Move to previous unread.
-s Sync current folder.
-t Same as 's' but force update.
-g Go to the folder which you input.
-w Write a message. A new draft is prepared.
-a Answer to this message. A new draft is prepared in Draft mode.
-f Forward this message to a third person. A new draft is prepared in
- Draft mode and this message is automatically attached.
-v Toggle \"Summary and Folder view\".
- You can quickly put the delete marks since the next message is not
- displayed.
-i Prefetch message if uncached.
-o Put the refile mark('o') on this message.
-! Mark current message as unread.
-$ Toggle mark current message as important.
-d Put the delete mark('D') on this message.
-c Check all messages as read.
-* Put the temporal mark('*') on this message.
-u Cancel the mark on this message.
-x Process marked messages.
-
-mo Put the refile mark onto all messages marked with '*'.
- This is very convenient to refile all messages picked by '?'.
-md Put the delete mark onto all messages marked with '*'.
-mi Prefetch all messages marked with '*'.
-mu Unmark all target-marked messages.
-mt Put the '*' mark onto all messages which belong to th current thread.
-ma Put the '*' mark onto all messages.
-? Pick messages according to a pick pattern which you input,
- then put the '*' mark onto them.
-q Goto folder mode."
+See Info under Wanderlust for full documentation.
+
+Special commands:
+\\{wl-summary-mode-map}
+
+Entering Folder mode calls the value of `wl-summary-mode-hook'."
(interactive)
(unless (interactive-p) (kill-all-local-variables))
(setq major-mode 'wl-summary-mode)
wl-summary-buffer-folder-indicator
wl-summary-buffer-unread-status))
(easy-menu-add wl-summary-mode-menu)
+ (when wl-summary-lazy-highlight
+ (make-local-variable 'window-scroll-functions)
+ (add-hook 'window-scroll-functions 'wl-highlight-summary-window))
;; This hook may contain the function `wl-setup-summary' for reasons
;; of system internal to accord facilities for the Emacs variants.
(run-hooks 'wl-summary-mode-hook))
expunged)
(fset 'wl-summary-append-message-func-internal
(wl-summary-get-append-message-func))
+ (wl-summary-buffer-number-column-detect nil)
(erase-buffer)
(message "Re-scanning...")
(setq i 0)
(setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2)))
(setq wl-thread-entity-list nil)
(setq wl-thread-entities nil)
+ (setq wl-summary-buffer-number-list nil)
(setq wl-summary-buffer-target-mark-list nil)
(setq wl-summary-buffer-refile-list nil)
(setq wl-summary-buffer-delete-list nil)
(setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
(message "Constructing summary structure...done")
(set-buffer cur-buf)
- (when (eq wl-summary-buffer-view 'thread)
- (message "Inserting thread...")
- (wl-thread-insert-top)
- (message "Inserting thread...done"))
+ (if (eq wl-summary-buffer-view 'thread)
+ (progn
+ (message "Inserting thread...")
+ (wl-thread-insert-top)
+ (message "Inserting thread...done"))
+ (wl-summary-make-number-list))
(when wl-use-scoring
(setq wl-summary-scored nil)
(wl-summary-score-headers nil msgdb
(message "%s" ret-val))
ret-val))
+(defsubst wl-summary-sync-all-init ()
+ (wl-summary-cleanup-temp-marks)
+ (erase-buffer)
+ (wl-summary-set-message-modified)
+ (wl-summary-set-mark-modified)
+ (setq wl-thread-entity-hashtb (elmo-make-hash
+ (* (length (elmo-msgdb-get-number-alist
+ wl-summary-buffer-msgdb)) 2)))
+ (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil))
+ (setq wl-thread-entity-list nil)
+ (setq wl-thread-entities nil)
+ (setq wl-summary-buffer-number-list nil)
+ (setq wl-summary-buffer-target-mark-list nil)
+ (setq wl-summary-buffer-refile-list nil)
+ (setq wl-summary-buffer-copy-list nil)
+ (setq wl-summary-buffer-delete-list nil)
+ (wl-summary-buffer-number-column-detect nil))
+
(defun wl-summary-sync (&optional unset-cursor force-range)
(interactive)
(let* ((folder wl-summary-buffer-folder-name)
(msgdb-dir (elmo-msgdb-expand-path
folder))
(range (or force-range (wl-summary-input-range folder)))
- mes seen-list)
- (cond ((string= range "all")
+ mes seen-list killed-list)
+ (cond ((or (string= range "all")
+ (string= range "all-visible"))
;; initialize buffer local databases.
(unless (elmo-folder-plugged-p folder) ; forbidden
(error "Unplugged"))
- (wl-summary-cleanup-temp-marks)
(setq seen-list
(nconc
(elmo-msgdb-mark-alist-to-seen-list
(concat wl-summary-important-mark
wl-summary-read-uncached-mark))
(elmo-msgdb-seen-load msgdb-dir)))
- (setq wl-thread-entity-hashtb (elmo-make-hash
- (* (length (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)) 2)))
- (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil))
- (setq wl-thread-entity-list nil)
- (setq wl-thread-entities nil)
- (setq wl-summary-buffer-target-mark-list nil)
- (setq wl-summary-buffer-refile-list nil)
- (setq wl-summary-buffer-copy-list nil)
- (setq wl-summary-buffer-delete-list nil)
- (wl-summary-buffer-number-column-detect nil)
- (elmo-clear-killed folder)
- (setq mes (wl-summary-sync-update3 seen-list unset-cursor))
+ (setq killed-list (elmo-msgdb-killed-list-load msgdb-dir))
+ (elmo-clear-killed wl-summary-buffer-folder-name)
+ (condition-case nil
+ (setq mes (wl-summary-sync-update3 seen-list unset-cursor
+ (string= range "all")))
+ (quit
+ ;; Resume killed-list if quit.
+ (message "") ; clear minibuffer.
+ (elmo-msgdb-killed-list-save msgdb-dir killed-list)))
(elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
(if mes (message "%s" mes)))
;;; (wl-summary-sync-all folder t))
the-email
(elmo-get-hash-val the-email wl-address-petname-hash)
(wl-address-header-extract-realname
- (cdr (assoc (downcase the-email)
- wl-address-completion-list))) t)
+ (cdr (assoc
+ (let ((completion-ignore-case t) comp)
+ (setq comp
+ (try-completion the-email wl-address-completion-list))
+ (if (equal comp t) the-email comp))
+ wl-address-completion-list))) t)
"edited")
((eq char ?d)
;; Delete Addresses
(progn
(delete-region (match-beginning 0) (match-end 0))
(delete-char 1) ; delete '\n'
- )))
+ (setq wl-summary-buffer-number-list
+ (delq (car msgs) wl-summary-buffer-number-list)))))
(when (and deleting-info
(> len elmo-display-progress-threshold))
(setq i (1+ i))
(if (interactive-p) (message mes)))))
(defun wl-summary-confirm-appends (appends)
- (condition-case nil
- (let ((len (length appends))
- in)
- (if (> len wl-summary-update-confirm-threshold)
- (if (y-or-n-p (format "Too many messages(%d). Continue? " len))
- appends
- (setq in wl-summary-update-confirm-threshold)
- (catch 'end
- (while t
- (setq in (read-from-minibuffer "Update number: "
- (int-to-string in))
- in (string-to-int in))
- (if (< len in)
- (throw 'end len))
- (if (y-or-n-p (format "%d messages are disappeared. OK? "
- (max (- len in) 0)))
- (throw 'end in))))
- (nthcdr (max (- len in) 0) appends))
- appends))
- (quit nil)
- (error nil))) ;
-
-(defun wl-summary-sync-update3 (&optional seen-list unset-cursor)
+ (let ((len (length appends))
+ in)
+ (if (> len wl-summary-update-confirm-threshold)
+ (if (y-or-n-p (format "Too many messages(%d). Continue? " len))
+ appends
+ (setq in wl-summary-update-confirm-threshold)
+ (catch 'end
+ (while t
+ (setq in (read-from-minibuffer "Update number: "
+ (int-to-string in))
+ in (string-to-int in))
+ (if (< len in)
+ (throw 'end len))
+ (if (y-or-n-p (format "%d messages are disappeared. OK? "
+ (max (- len in) 0)))
+ (throw 'end in))))
+ (nthcdr (max (- len in) 0) appends))
+ appends)))
+
+(defun wl-summary-sync-update3 (&optional seen-list unset-cursor sync-all)
"Update the summary view."
(interactive)
(let* ((folder wl-summary-buffer-folder-name)
(cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (overview (elmo-msgdb-get-overview msgdb))
+ (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
+ (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
;;; (location (elmo-msgdb-get-location msgdb))
(case-fold-search nil)
(elmo-mime-charset wl-summary-buffer-mime-charset)
in-folder
in-db curp
overview-append
- entity ret-val crossed crossed2 sync-all
+ entity ret-val crossed crossed2
update-thread update-top-list mark
expunged msgs unreads importants)
;;; (setq seen-list nil) ;for debug.
(wl-folder-confirm-existence folder 'force)
(message "Checking folder diff...")
(elmo-commit folder)
- (setq in-folder (elmo-list-folder folder))
- (setq in-db (sort (mapcar 'car number-alist) '<))
- (when (or (eq msgdb nil) ; trick for unplugged...
- (and (null overview)
- (null number-alist)
- (null mark-alist)))
- (setq sync-all t)
- (wl-summary-set-message-modified)
- (wl-summary-set-mark-modified)
- (erase-buffer))
+ (setq in-folder (elmo-list-folder folder sync-all))
+ (setq in-db (unless sync-all (sort (mapcar 'car number-alist) '<)))
(if (not elmo-use-killed-list)
(setq diff (if (eq (elmo-folder-get-type folder) 'multi)
(elmo-multi-list-bigger-diff in-folder in-db)
(setq initial-append-list (car diff))
(setq delete-list (cadr diff))
(message "Checking folder diff...done")
+ ;; Confirm appended message number.
+ (setq append-list (wl-summary-confirm-appends initial-append-list))
+ (when (and elmo-use-killed-list
+ (not (eq (length initial-append-list)
+ (length append-list)))
+ (setq diff (elmo-list-diff initial-append-list append-list)))
+ (elmo-msgdb-append-to-killed-list folder (car diff)))
+ ;; Setup sync-all
+ (if sync-all (wl-summary-sync-all-init))
;; Don't delete important-marked msgs other than 'internal.
(unless (eq (elmo-folder-get-type folder) 'internal)
(setq delete-list
(elmo-nntp-max-number-precedes-list-active-p))
;; XXX this does not work correctly in rare case.
(setq delete-list
- (wl-summary-delete-canceled-msgs-from-list delete-list msgdb)))
+ (wl-summary-delete-canceled-msgs-from-list
+ delete-list
+ wl-summary-buffer-msgdb)))
(if (or (equal diff '(nil nil))
(equal diff '(nil))
(and (eq (length delete-list) 0)
(progn
;; For max-number update...
(if (and (elmo-folder-contains-type folder 'nntp)
- (elmo-nntp-max-number-precedes-list-active-p)
- (elmo-update-number folder msgdb))
+ (elmo-nntp-max-number-precedes-list-active-p)
+ (elmo-update-number folder wl-summary-buffer-msgdb))
(wl-summary-set-message-modified)
(setq ret-val (format "No update is needed for \"%s\"" folder))))
(when delete-list
(message "Deleting...")
- (elmo-msgdb-delete-msgs folder delete-list msgdb t) ; reserve cache.
+ (elmo-msgdb-delete-msgs folder delete-list
+ wl-summary-buffer-msgdb t) ; reserve cache.
;;; (set-buffer cur-buf)
(wl-summary-delete-messages-on-buffer delete-list "Deleting...")
(message "Deleting...done"))
(wl-summary-set-status-marks-on-buffer
wl-summary-new-mark
wl-summary-unread-uncached-mark)
- ;; Confirm appended message number.
- (setq append-list (wl-summary-confirm-appends initial-append-list))
- (when (and elmo-use-killed-list
- (not (eq (length initial-append-list)
- (length append-list)))
- (setq diff (elmo-list-diff initial-append-list append-list)))
- (elmo-msgdb-append-to-killed-list folder (car diff)))
(setq num (length append-list))
(if append-list
(progn
;; delete duplicated messages.
(when (elmo-folder-contains-multi folder)
(setq crossed (elmo-multi-delete-crossposts
- msgdb result))
+ wl-summary-buffer-msgdb result))
(setq result (cdr crossed))
(setq crossed (car crossed)))
(setq overview-append (car result))
- (setq msgdb (elmo-msgdb-append msgdb result t))
+ (setq wl-summary-buffer-msgdb
+ (elmo-msgdb-append wl-summary-buffer-msgdb result t))
;; set these value for append-message-func
- (setq overview (elmo-msgdb-get-overview msgdb))
- (setq number-alist (elmo-msgdb-get-number-alist msgdb))
- (setq mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (setq overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
+ (setq number-alist (elmo-msgdb-get-number-alist
+ wl-summary-buffer-msgdb))
+ (setq mark-alist (elmo-msgdb-get-mark-alist
+ wl-summary-buffer-msgdb))
;;; (setq location (elmo-msgdb-get-location msgdb))
(setq curp overview-append)
(setq num (length curp))
(message "Updating thread...done")
;;; (set-buffer cur-buf)
))
+ (unless (eq wl-summary-buffer-view 'thread)
+ (wl-summary-make-number-list))
(wl-summary-set-message-modified)
(wl-summary-set-mark-modified)
- (setq wl-summary-buffer-msgdb msgdb)
(when (and sync-all (eq wl-summary-buffer-view 'thread))
(elmo-kill-buffer wl-summary-search-buf-name)
(message "Inserting thread...")
;; scoring
(when wl-use-scoring
(setq wl-summary-scored nil)
- (wl-summary-score-headers nil msgdb
+ (wl-summary-score-headers nil wl-summary-buffer-msgdb
(and sync-all
(wl-summary-rescore-msgs number-alist))
sync-all)
(wl-folder-set-folder-updated folder (list 0
(wl-summary-count-unread
(elmo-msgdb-get-mark-alist
- msgdb))
+ wl-summary-buffer-msgdb))
(length in-folder)))
(wl-summary-update-modeline)
(wl-summary-buffer-number-column-detect t)
nil))))
(defun wl-summary-toggle-thread (&optional arg)
- "Toggle thread status (T)hread and (S)equencial.
+ "Toggle thread status (T)hread and (S)equential.
If ARG, without confirm."
(interactive "P")
(when (or arg
wl-summary-buffer-number-regexp
wl-summary-buffer-message-modified
wl-summary-buffer-mark-modified
- wl-summary-buffer-thread-modified)
+ wl-summary-buffer-thread-modified
+ wl-summary-buffer-number-list)
(and (eq wl-summary-buffer-view 'thread)
'(wl-thread-entity-hashtb
wl-thread-entities
(delete-window mes-win)
(run-hooks 'wl-summary-toggle-disp-off-hook))))
+(defun wl-summary-make-number-list ()
+ (setq wl-summary-buffer-number-list
+ (mapcar
+ (lambda (x) (elmo-msgdb-overview-entity-get-number x))
+ (elmo-msgdb-get-overview wl-summary-buffer-msgdb))))
+
(defun wl-summary-goto-folder-subr (&optional folder scan-type other-window
sticky interactive scoring)
"Display target folder on summary."
(let ((case-fold-search nil)
(inhibit-read-only t)
(buffer-read-only nil))
+ ;; Load msgdb
+ (setq wl-summary-buffer-msgdb nil) ; new msgdb
+ (setq wl-summary-buffer-msgdb
+ (wl-summary-msgdb-load-async fld))
+ (if (null wl-summary-buffer-msgdb)
+ (setq wl-summary-buffer-msgdb
+ (elmo-msgdb-load (elmo-string fld))))
(erase-buffer)
- ;; resume summary cache
+ ;; Resume summary view
(if wl-summary-cache-use
(let* ((dir (elmo-msgdb-expand-path fld))
(cache (expand-file-name wl-summary-cache-file dir))
(view (expand-file-name wl-summary-view-file dir)))
(when (file-exists-p cache)
- (as-binary-input-file
- (insert-file-contents cache))
+ (insert-file-contents-as-binary cache)
(elmo-set-buffer-multibyte
default-enable-multibyte-characters)
(decode-mime-charset-region
(setq wl-summary-buffer-view
(wl-summary-load-file-object view)))
(if (eq wl-summary-buffer-view 'thread)
- (wl-thread-resume-entity fld))))
- ;; Load msgdb
- (setq wl-summary-buffer-msgdb nil) ; new msgdb
- (setq wl-summary-buffer-msgdb
- (wl-summary-msgdb-load-async fld))
- (if (null wl-summary-buffer-msgdb)
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-load (elmo-string fld))))
+ (wl-thread-resume-entity fld)
+ (wl-summary-make-number-list)))
+ (setq wl-summary-buffer-view
+ (wl-summary-load-file-object
+ (expand-file-name wl-summary-view-file
+ (elmo-msgdb-expand-path fld))))
+ (wl-summary-rescan))
(wl-summary-count-unread
(elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
(wl-summary-update-modeline)))
(wl-summary-buffer-number-column-detect t)
(wl-summary-disp-msg fld (and reuse-buf keep-cursor))
(unless (and reuse-buf keep-cursor)
- (setq hilit wl-summary-highlight)
+ ;(setq hilit wl-summary-highlight)
(unwind-protect
(let ((wl-summary-highlight (if reuse-buf wl-summary-highlight))
(wl-use-scoring
(set-buffer-modified-p nil)
(goto-char (point-min))
(if (wl-summary-cursor-down t)
- (let ((unreadp (wl-thread-next-mark-p
- (wl-thread-entity-get-mark
- (wl-summary-message-number))
- wl-summary-move-order)))
+ (let ((unreadp (wl-summary-next-message
+ (wl-summary-message-number)
+ 'down nil)))
(cond ((and wl-auto-select-first unreadp)
(setq retval 'disp-msg))
((not unreadp)
(forward-line -1)
(wl-summary-prev))
(setq retval 'more-next))
- (setq wl-summary-highlight hilit)
+ ;(setq wl-summary-highlight hilit)
(if (and wl-summary-highlight
+ (not wl-summary-lazy-highlight)
(not reuse-buf))
(if (and wl-summary-highlight-partial-threshold
(> (count-lines (point-min) (point-max))
(defun wl-summary-default-subject-filter (subject)
(let ((case-fold-search t))
- (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\):" ""))
+ (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" ""))
(setq subject (elmo-replace-in-string subject "[ \t]" ""))
(elmo-replace-in-string subject "^\\[.*\\]" "")))
wl-folder-entity-hashtb))
nil nil (or init wl-default-spec)
'wl-read-folder-hist)))
- (setq fld (elmo-string (wl-folder-get-realname fld)))
- (if (string-match "\n" fld)
- (error "Not supported folder name: %s" fld))
(if (or (string= fld wl-default-spec)
(string= fld ""))
(setq fld default))
+ (setq fld (elmo-string (wl-folder-get-realname fld)))
+ (if (string-match "\n" fld)
+ (error "Not supported folder name: %s" fld))
(unless no-create
(if ignore-error
(ignore-errors (wl-folder-confirm-existence fld))
(or (and (memq number wl-summary-buffer-delete-list) "D")
(and (assq number wl-summary-buffer-copy-list) "O")
(and (assq number wl-summary-buffer-refile-list) "o")
- (and (assq number wl-summary-buffer-target-mark-list) "*")))
+ (and (memq number wl-summary-buffer-target-mark-list) "*")))
(defsubst wl-summary-reserve-temp-mark-p (mark)
"Return t if temporal MARK should be reserved."
(or (wl-refile-guess entity) wl-trash-folder)
(format "for %s" copy-or-refile)))))
;; Cache folder hack by okada@opaopa.org
- (if (and (eq (car (elmo-folder-get-spec folder)) 'cache)
+ (if (and (eq (car (elmo-folder-get-spec
+ (wl-folder-get-realname folder))) 'cache)
(not (string= folder
(setq tmp-folder
(concat "'cache/"
(when (and (not (wl-summary-no-auto-refile-message-p number
mark-alist))
(setq dst
- (wl-refile-guess-by-rule
- (elmo-msgdb-overview-get-entity
- number wl-summary-buffer-msgdb)))
+ (wl-folder-get-realname
+ (wl-refile-guess-by-rule
+ (elmo-msgdb-overview-get-entity
+ number wl-summary-buffer-msgdb))))
(not (equal dst spec)))
(when (not (member dst checked-dsts))
(wl-folder-confirm-existence dst)
(unless no-server-update
(elmo-unmark-important folder (list number) msgdb)
(elmo-msgdb-global-mark-delete message-id))
+ ;; Remove cache if local folder.
+ (if (elmo-folder-local-p folder)
+ (elmo-cache-delete message-id folder number))
(when visible
(delete-region (match-beginning 2) (match-end 2))
(insert " "))
(wl-match-string 1 wday-str)
(elmo-date-get-week year month mday))))
-(defmacro wl-summary-cursor-move-regex ()
- (` (let ((mark-alist
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- (cond ((eq wl-summary-move-order 'new)
- (list
- (list
- wl-summary-new-mark)
- (list
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark
- wl-summary-important-mark)))
- ((eq wl-summary-move-order 'unread)
- (list
- (list
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark
- wl-summary-new-mark)
- (list
- wl-summary-important-mark)))
- (t
- (list
- (list
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark
- wl-summary-new-mark
- wl-summary-important-mark))))
- (cond ((eq wl-summary-move-order 'unread)
- (list
- (list
- wl-summary-unread-cached-mark)
- (list
- wl-summary-important-mark)))
- (t
- (list
- (list
- wl-summary-unread-cached-mark
- wl-summary-important-mark)))))))
- (mapcar
- (function
- (lambda (mark-list)
- (concat wl-summary-message-regexp
- ".\\("
- (mapconcat 'regexp-quote
- mark-list
- "\\|")
- "\\)\\|"
- wl-summary-message-regexp "\\*")))
- mark-alist))))
-
-;;
-;; Goto unread or important
-;;
-(defun wl-summary-cursor-up (&optional hereto)
- (interactive "P")
- (if (and (not wl-summary-buffer-target-mark-list)
- (eq wl-summary-buffer-view 'thread))
- (progn
- (if (eobp)
- (forward-line -1))
- (wl-thread-jump-to-prev-unread hereto))
- (if hereto
- (end-of-line)
- (beginning-of-line))
- (let ((case-fold-search nil)
- regex-list)
- (setq regex-list (wl-summary-cursor-move-regex))
- (catch 'done
- (while regex-list
- (when (re-search-backward
- (car regex-list)
- nil t nil)
- (beginning-of-line)
- (throw 'done t))
- (setq regex-list (cdr regex-list)))
- (beginning-of-line)
- (throw 'done nil)))))
-
+(defvar wl-summary-move-spec-plugged-alist
+ (` ((new . ((t . nil)
+ (p . (, wl-summary-new-mark))
+ (p . (, (wl-regexp-opt
+ (list wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark))))
+ (p . (, (regexp-quote wl-summary-important-mark)))))
+ (unread . ((t . nil)
+ (p . (, (wl-regexp-opt
+ (list wl-summary-new-mark
+ wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark))))
+ (p . (, (regexp-quote wl-summary-important-mark))))))))
+
+(defvar wl-summary-move-spec-unplugged-alist
+ (` ((new . ((t . nil)
+ (p . (, wl-summary-unread-cached-mark))
+ (p . (, (regexp-quote wl-summary-important-mark)))))
+ (unread . ((t . nil)
+ (p . (, wl-summary-unread-cached-mark))
+ (p . (, (regexp-quote wl-summary-important-mark))))))))
+
+(defsubst wl-summary-next-message (num direction hereto)
+ (let ((cur-spec (cdr (assq wl-summary-move-order
+ (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
+ wl-summary-move-spec-plugged-alist
+ wl-summary-move-spec-unplugged-alist))))
+ (nums (memq num (if (eq direction 'up)
+ (reverse wl-summary-buffer-number-list)
+ wl-summary-buffer-number-list)))
+ marked-list nums2)
+ (unless hereto (setq nums (cdr nums)))
+ (setq nums2 nums)
+ (if cur-spec
+ (catch 'done
+ (while cur-spec
+ (setq nums nums2)
+ (cond ((eq (car (car cur-spec)) 'p)
+ (if (setq marked-list (elmo-msgdb-list-messages-mark-match
+ wl-summary-buffer-msgdb
+ (cdr (car cur-spec))))
+ (while nums
+ (if (memq (car nums) marked-list)
+ (throw 'done (car nums)))
+ (setq nums (cdr nums)))))
+ ((eq (car (car cur-spec)) 't)
+ (while nums
+ (if (and wl-summary-buffer-target-mark-list
+ (memq (car nums)
+ wl-summary-buffer-target-mark-list))
+ (throw 'done (car nums)))
+ (setq nums (cdr nums)))))
+ (setq cur-spec (cdr cur-spec))))
+ (car nums))))
+
+(defsubst wl-summary-cursor-move (direction hereto)
+ (when (and (eq direction 'up)
+ (eobp))
+ (forward-line -1)
+ (setq hereto t))
+ (let (num)
+ (when (setq num (wl-summary-next-message (wl-summary-message-number)
+ direction hereto))
+ (wl-thread-jump-to-msg num)
+ t)))
;;
;; Goto unread or important
;; returns t if next message exists in this folder.
(defun wl-summary-cursor-down (&optional hereto)
(interactive "P")
- (if (and (null wl-summary-buffer-target-mark-list)
- (eq wl-summary-buffer-view 'thread))
- (wl-thread-jump-to-next-unread hereto)
- (if hereto
- (beginning-of-line)
- (end-of-line))
- (let ((case-fold-search nil)
- regex-list)
- (setq regex-list (wl-summary-cursor-move-regex))
- (catch 'done
- (while regex-list
- (when (re-search-forward
- (car regex-list)
- nil t nil)
- (beginning-of-line)
- (throw 'done t))
- (setq regex-list (cdr regex-list)))
- (beginning-of-line)
- (throw 'done nil)))))
+ (wl-summary-cursor-move 'down hereto))
+
+(defun wl-summary-cursor-up (&optional hereto)
+ (interactive "P")
+ (wl-summary-cursor-move 'up hereto))
(defun wl-summary-save-view-cache ()
(save-excursion
(let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
(cache (expand-file-name wl-summary-cache-file dir))
(view (expand-file-name wl-summary-view-file dir))
-;;; (coding-system-for-write wl-cs-cache)
-;;; (output-coding-system wl-cs-cache)
(save-view wl-summary-buffer-view)
(tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
(charset wl-summary-buffer-mime-charset))
(widen)
(encode-mime-charset-region
(point-min) (point-max) charset)
- (as-binary-output-file
- (write-region (point-min)
- (point-max) cache nil 'no-msg))
- (write-region (point-min) (point-max) cache nil
- 'no-msg)))
+ (write-region-as-binary (point-min)(point-max)
+ cache nil 'no-msg)))
(when (file-writable-p view) ; 'thread or 'sequence
(save-excursion
(set-buffer tmp-buffer)
"returns update or all or rescan."
;; for the case when parts are expanded in the bottom of the folder
(let ((input-range-list '("update" "all" "rescan" "first:" "last:"
- "no-sync" "rescan-noscore"))
+ "no-sync" "rescan-noscore" "all-visible"))
(default (or (wl-get-assoc-list-value
wl-folder-sync-range-alist
folder)
(run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
(select-window (get-buffer-window cur-buf)))
)
- (save-excursion
- ;; hide message window
- (let ((mes-win (get-buffer-window view-message-buffer))
- (wl-stay-folder-window t))
- (if mes-win (delete-window mes-win))
- (select-window (get-buffer-window cur-buf))
- ;; display wl-folder window!!
- (if (setq fld-buf (get-buffer wl-folder-buffer-name))
- (if (setq fld-win (get-buffer-window fld-buf))
- ;; folder win is already displayed.
- (select-window fld-win)
- ;; folder win is not displayed...occupy all.
- (switch-to-buffer fld-buf))
- ;; no folder buf
- (wl-folder))
- (split-window-horizontally wl-folder-window-width)
- (other-window 1)
- (switch-to-buffer cur-buf)
- ;; resume message window.
- (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
- (when mes-win
- (wl-select-buffer view-message-buffer)
- (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
- (select-window (get-buffer-window cur-buf))))
- )))))
+ ;; hide message window
+ (let ((mes-win (get-buffer-window view-message-buffer))
+ (wl-stay-folder-window t))
+ (if mes-win (delete-window mes-win))
+ (select-window (get-buffer-window cur-buf))
+ ;; display wl-folder window!!
+ (if (setq fld-buf (get-buffer wl-folder-buffer-name))
+ (if (setq fld-win (get-buffer-window fld-buf))
+ ;; folder win is already displayed.
+ (select-window fld-win)
+ ;; folder win is not displayed...occupy all.
+ (switch-to-buffer fld-buf))
+ ;; no folder buf
+ (wl-folder))
+ (split-window-horizontally wl-folder-window-width)
+ (other-window 1)
+ (switch-to-buffer cur-buf)
+ ;; resume message window.
+ (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
+ (when mes-win
+ (wl-select-buffer view-message-buffer)
+ (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
+ (select-window (get-buffer-window cur-buf))))
+ ))))
(run-hooks 'wl-summary-toggle-disp-folder-hook))
(defun wl-summary-toggle-disp-msg (&optional arg)
(split-window-vertically))
(other-window 1)
(when (setq mes-buf (wl-message-get-original-buffer))
- (wl-draft-reply mes-buf (not arg) summary-buf)
+ (wl-draft-reply mes-buf arg summary-buf)
(unless without-setup-hook
(run-hooks 'wl-mail-setup-hook)))
t)))))
(run-hooks 'wl-mail-setup-hook)
(mail-position-on-field "To"))
-(defun wl-summary-write-current-newsgroup (&optional folder)
- ""
+(defvar wl-summary-write-current-folder-functions
+ '(wl-folder-get-newsgroups
+ wl-folder-guess-mailing-list-by-refile-rule
+ wl-folder-guess-mailing-list-by-folder-name)
+ "Newsgroups or Mailing List address guess functions list.
+Call from `wl-summary-write-current-folder'")
+
+(defun wl-summary-write-current-folder (&optional folder)
+ "Write message to current FOLDER's newsgroup or mailing-list.
+Use function list is `wl-summary-write-current-folder-functions'."
(interactive)
- (let* ((folder (or folder wl-summary-buffer-folder-name))
- (flist (elmo-folder-get-primitive-folder-list folder))
- newsgroups fld ret)
- (while (setq fld (car flist))
- (if (setq ret
- (cond ((eq 'nntp (elmo-folder-get-type fld))
- (nth 1 (elmo-folder-get-spec fld)))
- ((eq 'localnews (elmo-folder-get-type fld))
- (elmo-replace-in-string
- (nth 1 (elmo-folder-get-spec fld)) "/" "\\."))))
- (setq newsgroups (cond (newsgroups
- (concat newsgroups "," ret))
- (t ret))))
- (setq flist (cdr flist)))
- (if newsgroups
- (progn
- (wl-draft nil nil nil nil nil newsgroups)
- (run-hooks 'wl-mail-setup-hook))
- (error "%s is not newsgroup" folder))))
+ (let (newsgroups to cc)
+ ;; default FOLDER is current buffer folder
+ (setq folder (or folder wl-summary-buffer-folder-name))
+ (let ((flist wl-summary-write-current-folder-functions)
+ guess-list)
+ (while flist
+ (setq guess-list (funcall (car flist) folder))
+ (if (or (nth 0 guess-list) ; To:
+;;; (nth 1 guess-list) ; Cc:
+ (nth 2 guess-list)) ; Newsgroups:
+ (setq flist nil)
+ (setq flist (cdr flist))))
+ (if guess-list
+ (progn
+ (wl-draft (nth 0 guess-list) ; To:
+ nil nil
+ (nth 1 guess-list) ; Cc:
+ nil
+ (nth 2 guess-list)) ; Newsgroups:
+ (run-hooks 'wl-mail-setup-hook))
+;;; (error "%s is not newsgroup" folder)
+ (error "Can't guess by folder %s" folder)))))
(defun wl-summary-forward (&optional without-setup-hook)
""
(if (setq message-buf (wl-message-get-original-buffer))
(set-buffer message-buf))
(unless (wl-message-news-p)
- (error "This is not a news article; canceling is impossible"))
+ (set-buffer summary-buf)
+ (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ 'nntp)
+ (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
+ (progn
+ (wl-summary-redisplay t)
+ (wl-summary-supersedes-message))
+ (error "This is not a news article; supersedes is impossible")))
(when (yes-or-no-p "Do you really want to cancel this article? ")
(let (from newsgroups message-id distribution buf)
(save-excursion
(if (setq message-buf (wl-message-get-original-buffer))
(set-buffer message-buf))
(unless (wl-message-news-p)
- (error "This is not a news article; supersedes is impossible"))
+ (set-buffer summary-buf)
+ (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ 'nntp)
+ (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
+ (progn
+ (wl-summary-redisplay t)
+ (wl-summary-supersedes-message))
+ (error "This is not a news article; supersedes is impossible")))
(save-excursion
(setq from (std11-field-body "from"))
;; Make sure that this article was written by the user.
(message "Dropping...done"))))
(defun wl-summary-default-get-next-msg (msg)
- (let (next)
- (if (and (not wl-summary-buffer-target-mark-list)
- (eq wl-summary-buffer-view 'thread)
- (if (eq wl-summary-move-direction-downward nil)
- (setq next (wl-thread-get-prev-unread msg))
- (setq next (wl-thread-get-next-unread msg))))
- next
- (save-excursion
- (wl-summary-jump-to-msg msg)
- (let (wl-summary-buffer-disp-msg)
- (if (eq wl-summary-move-direction-downward nil)
- (unless (wl-summary-cursor-up)
- (wl-summary-prev))
- (unless (wl-summary-cursor-down)
- (wl-summary-next)))
- (wl-summary-message-number))))))
+ (or (wl-summary-next-message msg
+ (if wl-summary-move-direction-downward 'down
+ 'up)
+ nil)
+ (cadr (memq msg (if wl-summary-move-direction-downward
+ wl-summary-buffer-number-list
+ (reverse wl-summary-buffer-number-list))))))
(defsubst wl-cache-prefetch-p (fld &optional num)
(cond ((and num wl-cache-prefetch-folder-type-list)
(defun wl-cache-prefetch-next (fld msg &optional summary)
(if (wl-cache-prefetch-p fld)
- (if (not elmo-use-buffer-cache)
+ (if elmo-use-buffer-cache
;;; (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
(save-excursion
(set-buffer (or summary (get-buffer wl-summary-buffer-name)))
folder next)))))
(if wl-cache-prefetch-debug
(message "Reading %d..." msg))
- (elmo-buffer-cache-message folder next msgdb)
+ (elmo-buffer-cache-message folder next msgdb nil 'unread)
(if wl-cache-prefetch-debug
(message "Reading %d... done" msg))))))))))
projects / elisp / wanderlust.git / blobdiff