;;; wl-folder.el -- Folder mode for Wanderlust.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news
;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
(define-key wl-folder-mode-map "g" 'wl-folder-goto-folder)
(define-key wl-folder-mode-map "j" 'wl-folder-jump-to-current-entity)
(define-key wl-folder-mode-map "w" 'wl-draft)
- (define-key wl-folder-mode-map "W" 'wl-folder-write-current-newsgroup)
+ (define-key wl-folder-mode-map "W" 'wl-folder-write-current-folder)
(define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
(define-key wl-folder-mode-map "rS" 'wl-folder-sync-region)
(define-key wl-folder-mode-map "S" 'wl-folder-sync-current-entity)
(goto-char (point-min))))
(defun wl-folder-next-entity-skip-invalid (&optional hereto)
- "move to next entity. skip unsubscribed or removed entity."
+ "Move to next entity. skip unsubscribed or removed entity."
(interactive)
(beginning-of-line)
(if (not hereto)
(setq entity (wl-pop entities))
(cond
((consp entity)
-;; (if (and (string= name (car entity))
-;; (eq id (wl-folder-get-entity-id (car entity))))
-;; (setq found t))
+;;; (if (and (string= name (car entity))
+;;; (eq id (wl-folder-get-entity-id (car entity))))
+;;; (setq found t))
(and entities
(wl-push entities entity-stack))
(setq entities (nth 2 entity)))
wl-force-fetch-folders)))
(defun wl-folder-jump-to-current-entity (&optional arg)
- "Enter the current folder. If optional arg exists, update folder list. "
+ "Enter the current folder. If optional ARG exists, update folder list."
(interactive "P")
(beginning-of-line)
(let (entity beg end indent opened fname err fld-name)
(elmo-msgdb-expand-path entity))
entity)))
(cdr nums))
- (current-buffer)))
+ (get-buffer wl-folder-buffer-name)))
(setq wl-folder-info-alist-modified t)
(sit-for 0)
(list (if wl-folder-notify-deleted
(setq unread (or (cadr nums) 0))
(if (or (not unread-only)
(or (< 0 new) (< 0 unread)))
- (save-window-excursion
- (save-excursion
- (wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range entity)
- nil nil nil t)
- (wl-summary-exit))))))))
+ (let ((wl-summary-buffer-name (concat
+ wl-summary-buffer-name
+ (symbol-name this-command)))
+ (wl-message-buf-name (concat wl-message-buf-name
+ (symbol-name this-command))))
+ (save-window-excursion
+ (save-excursion
+ (wl-summary-goto-folder-subr entity
+ (wl-summary-get-sync-range entity)
+ nil nil nil t)
+ (wl-summary-exit)))))))))
(defun wl-folder-sync-current-entity (&optional unread-only)
"Synchronize the folder at position.
(message "Syncing %s is done!" entity-name)))))
(defun wl-folder-mark-as-read-all-entity (entity)
- "Mark as read all messages in the ENTITY"
+ "Mark as read all messages in the ENTITY."
(cond
((consp entity)
(let ((flist (nth 2 entity)))
(setq new (or (car nums) 0))
(setq unread (or (cadr nums) 0))
(if (or (< 0 new) (< 0 unread))
- (save-window-excursion
- (save-excursion
- (wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range entity)
- nil)
- (wl-summary-mark-as-read-all)
- (wl-summary-exit)))
+ (let ((wl-summary-buffer-name (concat
+ wl-summary-buffer-name
+ (symbol-name this-command)))
+ (wl-message-buf-name (concat wl-message-buf-name
+ (symbol-name this-command))))
+ (save-window-excursion
+ (save-excursion
+ (wl-summary-goto-folder-subr entity
+ (wl-summary-get-sync-range entity)
+ nil)
+ (wl-summary-mark-as-read-all)
+ (wl-summary-exit))))
(sit-for 0))))))
(defun wl-folder-mark-as-read-all-current-entity ()
(defun wl-folder-select-buffer (buffer)
(let ((gbw (get-buffer-window buffer))
- ret-val)
+ exists)
(if gbw
(progn (select-window gbw)
- (setq ret-val t))
- (condition-case ()
- (unwind-protect
- (split-window-horizontally wl-folder-window-width)
- (other-window 1))
- (error nil)))
+ (setq exists t))
+ (unless wl-folder-use-frame
+ (condition-case ()
+ (unwind-protect
+ (split-window-horizontally wl-folder-window-width)
+ (other-window 1))
+ (error nil))))
(set-buffer buffer)
- (switch-to-buffer buffer)
- ret-val
- ))
+ (if wl-folder-use-frame
+ (switch-to-buffer-other-frame buffer)
+ (switch-to-buffer buffer))
+ exists))
(defun wl-folder-toggle-disp-summary (&optional arg folder)
(interactive)
(select-window (get-buffer-window cur-buf)))))))))
(defun wl-folder-prev-unsync ()
- "move cursor to the previous unsync folder."
+ "Move cursor to the previous unsync folder."
(interactive)
(let (start-point)
(setq start-point (point))
(message "No more unsync folder"))))
(defun wl-folder-next-unsync (&optional plugged)
- "move cursor to the next unsync."
+ "Move cursor to the next unsync."
(interactive)
(let (start-point entity)
(setq start-point (point))
(message "No more unsync folder"))))
(defun wl-folder-prev-unread (&optional group)
- "move cursor to the previous unread folder."
+ "Move cursor to the previous unread folder."
(interactive "P")
(let (start-point)
(setq start-point (point))
nil)))
(defun wl-folder-next-unread (&optional group)
- "move cursor to the next unread folder."
+ "Move cursor to the next unread folder."
(interactive "P")
(let (start-point)
(setq start-point (point))
(defun wl-folder-mode ()
"Major mode for Wanderlust Folder.
-See info under Wanderlust for full documentation.
+See Info under Wanderlust for full documentation.
Special commands:
\\{wl-folder-mode-map}
(defun wl-folder (&optional arg)
(interactive "P")
(let (initialize)
-; (delete-other-windows)
+;;; (delete-other-windows)
(if (get-buffer wl-folder-buffer-name)
(switch-to-buffer wl-folder-buffer-name)
(switch-to-buffer (get-buffer-create wl-folder-buffer-name))
(if (setq buf (get-buffer wl-folder-buffer-name))
(wl-folder-entity-hashtb-set
wl-folder-entity-hashtb name value buf))
-;; (elmo-folder-set-info-hashtb (elmo-string name)
-;; nil
-;; (nth 2 value)
-;; (nth 0 value)
-;; (nth 1 value))
+;;; (elmo-folder-set-info-hashtb (elmo-string name)
+;;; nil
+;;; (nth 2 value)
+;;; (nth 0 value)
+;;; (nth 1 value))
(setq wl-folder-info-alist-modified t))))
(defun wl-folder-calc-finfo (entity)
(as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
beg
)
-; (insert indent "[" (if as-opened "-" "+") "]" (car entity) "\n")
-; (save-excursion (forward-line -1)
-; (wl-highlight-folder-current-line))
+;;; (insert indent "[" (if as-opened "-" "+") "]" (car entity) "\n")
+;;; (save-excursion (forward-line -1)
+;;; (wl-highlight-folder-current-line))
(setq beg (point))
(if (and as-opened
(not onlygroup))
(let (update-flist flist-unsub new-flist removed group-name-end)
-; (when (and (eq (cadr entity) 'access)
-; newest)
-; (message "fetching folder entries...")
-; (when (setq new-flist
-; (elmo-list-folders
-; (elmo-string (car entity))
-; (wl-string-member
-; (car entity)
-; wl-folder-hierarchy-access-folders)
-; ))
-; (setq update-flist
-; (wl-folder-update-access-group entity new-flist))
-; (setq flist (nth 1 update-flist))
-; (when (car update-flist) ;; diff
-; (setq flist-unsub (nth 2 update-flist))
-; (setq removed (nth 3 update-flist))
-; (elmo-msgdb-flist-save
-; (car entity)
-; (list
-; (wl-folder-make-save-access-list flist)
-; (wl-folder-make-save-access-list flist-unsub)))
-; ;;
-; ;; reconstruct wl-folder-entity-id-name-hashtb and
-; ;; wl-folder-entity-hashtb
-; ;;
-; (wl-folder-entity-assign-id
-; entity
-; wl-folder-entity-id-name-hashtb
-; t)
-; (setq wl-folder-entity-hashtb
-; (wl-folder-create-entity-hashtb
-; entity
-; wl-folder-entity-hashtb
-; t))
-; (setq wl-folder-newsgroups-hashtb
-; (or
-; (wl-folder-create-newsgroups-hashtb
-; entity nil)
-; wl-folder-newsgroups-hashtb))))
-; (message "fetching folder entries...done"))
+;;; (when (and (eq (cadr entity) 'access)
+;;; newest)
+;;; (message "fetching folder entries...")
+;;; (when (setq new-flist
+;;; (elmo-list-folders
+;;; (elmo-string (car entity))
+;;; (wl-string-member
+;;; (car entity)
+;;; wl-folder-hierarchy-access-folders)
+;;; ))
+;;; (setq update-flist
+;;; (wl-folder-update-access-group entity new-flist))
+;;; (setq flist (nth 1 update-flist))
+;;; (when (car update-flist) ;; diff
+;;; (setq flist-unsub (nth 2 update-flist))
+;;; (setq removed (nth 3 update-flist))
+;;; (elmo-msgdb-flist-save
+;;; (car entity)
+;;; (list
+;;; (wl-folder-make-save-access-list flist)
+;;; (wl-folder-make-save-access-list flist-unsub)))
+;;; ;;
+;;; ;; reconstruct wl-folder-entity-id-name-hashtb and
+;;; ;; wl-folder-entity-hashtb
+;;; ;;
+;;; (wl-folder-entity-assign-id
+;;; entity
+;;; wl-folder-entity-id-name-hashtb
+;;; t)
+;;; (setq wl-folder-entity-hashtb
+;;; (wl-folder-create-entity-hashtb
+;;; entity
+;;; wl-folder-entity-hashtb
+;;; t))
+;;; (setq wl-folder-newsgroups-hashtb
+;;; (or
+;;; (wl-folder-create-newsgroups-hashtb
+;;; entity nil)
+;;; wl-folder-newsgroups-hashtb))))
+;;; (message "fetching folder entries...done"))
(insert indent "[" (if as-opened "-" "+") "]"
(wl-folder-get-petname (car entity)))
(setq group-name-end (point))
(unread-diff 0)
;;(fld (elmo-string folder))
value newvalue entity-list)
- ;; Update folder-info
- ;;(elmo-folder-set-info-hashtb fld nil nil nil unread)
+;;; Update folder-info
+;;; (elmo-folder-set-info-hashtb fld nil nil nil unread)
(setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0))
(setq unread-diff (- (or unread 0) cur-unread))
(setq value (wl-folder-get-entity-info folder))
(elmo-folder-info-make-hashtb
info-alist
wl-folder-entity-hashtb)))
-;; (wl-folder-resume-entity-hashtb-by-finfo
-;; wl-folder-entity-hashtb
-;; info-alist)))
+;;; (wl-folder-resume-entity-hashtb-by-finfo
+;;; wl-folder-entity-hashtb
+;;; info-alist)))
(defun wl-folder-cleanup-variables ()
(setq wl-folder-entity nil
wl-nntp-posting-server
elmo-default-nntp-port
nil nil "nntp" add))
- ;; This hook may contain the functions `wl-plugged-init-icons' and
- ;; `wl-biff-init-icons' for reasons of system internal to accord
- ;; facilities for the Emacs variants.
(run-hooks 'wl-make-plugged-hook)))
(defvar wl-folder-init-func 'wl-local-folder-init)
(defun wl-folder-init ()
+ "Call `wl-folder-init-func' function."
(interactive)
(funcall wl-folder-init-func))
(defun wl-local-folder-init ()
+ "Initialize local folder."
(message "Initializing folder...")
(save-excursion
(set-buffer wl-folder-buffer-name)
(setq alist (cdr alist)))
hashtb))
+(defun wl-folder-get-newsgroups (folder)
+ "Return Newsgroups field value string for FOLDER newsgroup.
+If FOLDER is multi, return comma separated string (cross post)."
+ (let ((flist (elmo-folder-get-primitive-folder-list folder)) ; multi
+ 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)) "/" "\\."))))
+ ;; append newsgroup
+ (setq newsgroups (if (stringp newsgroups)
+ (concat newsgroups "," ret)
+ ret)))
+ (setq flist (cdr flist)))
+ (list nil nil newsgroups)))
+
+(defun wl-folder-guess-mailing-list-by-refile-rule (folder)
+ "Return ML address guess by FOLDER.
+Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'.
+Don't care multi."
+ (setq folder (car (elmo-folder-get-primitive-folder-list folder)))
+ (unless (memq (elmo-folder-get-type folder)
+ '(localnews nntp))
+ (let ((rules wl-refile-rule-alist)
+ mladdress tokey toalist histkey)
+ (while rules
+ (if (or (and (stringp (car (car rules)))
+ (string-match "[Tt]o" (car (car rules))))
+ (and (listp (car (car rules)))
+ (elmo-string-matched-member "to" (car (car rules))
+ 'case-ignore)))
+ (setq toalist (append toalist (cdr (car rules)))))
+ (setq rules (cdr rules)))
+ (setq tokey (car (rassoc folder toalist)))
+;;; (setq histkey (car (rassoc folder wl-refile-alist)))
+ ;; case-ignore search `wl-subscribed-mailing-list'
+ (if (stringp tokey)
+ (list
+ (elmo-string-matched-member tokey wl-subscribed-mailing-list t)
+ nil nil)
+ nil))))
+
+(defun wl-folder-guess-mailing-list-by-folder-name (folder)
+ "Return ML address guess by FOLDER name's last hierarchy.
+Use `wl-subscribed-mailing-list'."
+ (setq folder (car (elmo-folder-get-primitive-folder-list folder)))
+ (when (memq (elmo-folder-get-type folder)
+ '(localdir imap4 maildir))
+ (let (key mladdress)
+ (setq folder ; make folder name simple
+ (if (eq 'imap4 (elmo-folder-get-type folder))
+ (elmo-imap4-spec-mailbox (elmo-imap4-get-spec folder))
+ (substring folder 1)))
+ (when (string-match "[^\\./]+$" folder) ; last hierarchy
+ (setq key (regexp-quote
+ (concat (substring folder (match-beginning 0)) "@")))
+ (setq mladdress
+ (elmo-string-matched-member
+ key wl-subscribed-mailing-list 'case-ignore))
+ (if (stringp mladdress)
+ (list mladdress nil nil)
+ nil)))))
+
(defun wl-folder-update-diff-line (diffs)
(let ((inhibit-read-only t)
(buffer-read-only nil)
(beginning-of-line)
(setq id (get-text-property (point) 'wl-folder-entity-id))
(if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
- ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
+;;; (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
(progn
(delete-region (match-beginning 2)
(match-end 2))
(defun wl-folder-goto-folder-subr (&optional folder sticky)
(beginning-of-line)
(let (summary-buf fld-name entity id error-selecting)
-;; (setq fld-name (wl-folder-get-entity-from-buffer))
-;; (if (or (null fld-name)
-;; (assoc fld-name wl-folder-group-alist))
+;;; (setq fld-name (wl-folder-get-entity-from-buffer))
+;;; (if (or (null fld-name)
+;;; (assoc fld-name wl-folder-group-alist))
(setq fld-name wl-default-folder)
(setq fld-name (or folder
(wl-summary-read-folder fld-name)))
(set-buffer-modified-p nil)))
(defun wl-folder-open-close ()
- "open or close parent entity."
+ "Open or close parent entity."
(interactive)
(save-excursion
(beginning-of-line)
(list diff new-flist new-unsubscribes removes)))
(defun wl-folder-prefetch-entity (entity)
- "Prefetch all new messages in the ENTITY"
+ "Prefetch all new messages in the ENTITY."
(cond
((consp entity)
(let ((flist (nth 2 entity))
(setq count (+ count (wl-folder-count-incorporates entity)))
(if (or (null (car nums)) ; unknown
(< 0 count))
- (save-window-excursion
- (save-excursion
- (wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range entity)
- nil)
- (setq ret-val (wl-summary-incorporate))
- (wl-summary-exit)
- ret-val))
+ (let ((wl-summary-buffer-name (concat
+ wl-summary-buffer-name
+ (symbol-name this-command)))
+ (wl-message-buf-name (concat wl-message-buf-name
+ (symbol-name this-command))))
+ (save-window-excursion
+ (save-excursion
+ (wl-summary-goto-folder-subr entity
+ (wl-summary-get-sync-range entity)
+ nil)
+ (setq ret-val (wl-summary-incorporate))
+ (wl-summary-exit)
+ ret-val)))
(cons 0 0))))))
(defun wl-folder-count-incorporates (folder)
(wl-folder-prefetch-entity entity)))))
(defun wl-folder-drop-unsync-entity (entity)
- "Drop all unsync messages in the ENTITY"
+ "Drop all unsync messages in the ENTITY."
(cond
((consp entity)
(let ((flist (nth 2 entity)))
wl-summary-highlight wl-auto-select-first new)
(setq new (or (car nums) 0))
(if (< 0 new)
- (save-window-excursion
- (save-excursion
- (wl-summary-goto-folder-subr entity 'no-sync nil)
- (wl-summary-drop-unsync)
- (wl-summary-exit))))))))
+ (let ((wl-summary-buffer-name (concat
+ wl-summary-buffer-name
+ (symbol-name this-command)))
+ (wl-message-buf-name (concat wl-message-buf-name
+ (symbol-name this-command))))
+ (save-window-excursion
+ (save-excursion
+ (wl-summary-goto-folder-subr entity 'no-sync nil)
+ (wl-summary-drop-unsync)
+ (wl-summary-exit)))))))))
(defun wl-folder-drop-unsync-current-entity (&optional force-check)
"Drop all unsync messages in the folder at position.
(wl-folder-drop-unsync-entity entity)
(message "All unsync messages in %s are dropped!" entity-name)))))
-(defun wl-folder-write-current-newsgroup ()
+(defun wl-folder-write-current-folder ()
+ "Write message to current folder's newsgroup or mailing-list.
+Call `wl-summary-write-current-folder' with current folder name."
(interactive)
- (wl-summary-write-current-newsgroup (wl-folder-entity-name)))
+ (unless (wl-folder-buffer-group-p)
+ (wl-summary-write-current-folder
+ (wl-folder-get-realname (wl-folder-entity-name)))))
(defun wl-folder-mimic-kill-buffer ()
"Kill the current (Folder) buffer with query."
projects / elisp / wanderlust.git / blobdiff