;;; -*- Emacs-Lisp -*- ;;; procmail reader for Mew on GNU Emacs. ;;; $Id: prom-mew.el,v 1.8 2000/12/14 02:04:57 makoto Exp $ ;;; by Masahiro MURATA ;;; following line give you fairly good information ;;; egrep 'defun|@' ~/mule/lisp/prom-mew.el ;;; OR ;;; egrep 'defun|@' ~/mule/lisp/prom-mew.el | grep mew ;;; (defconst prom-version "Prom-Mew 1.94") ;; !!! this version is required by Mew version 1.94 or later !!! ;;; @ Document ;;; ;; Please set in ~/.procmailrc ;; ;; LOCKFILE=/home/hoge/Mail/.lock ;; ;; and set in ~/.emacs ;; (autoload 'prom-mew "prom-mew" "mew for using procmail" t) ;; (setq proc-log-list (list "~/Mail/from-log" "~/Mail/from-ML")) ;; ;; list of LOGFILE in ~/.procmailrc ;; (setq proc-keep-log "~/Mail/listlog") ;; (setq proc-lock-file "~/Mail/.lock") ;; LOCKFILE in ~/.procmailrc ;; for the rest, see the prom-usage.jis ;;; @ require ;;; (require 'mew) (require 'mew-summary) ;;; @ Customization: ;;; (defvar proc-log-list nil "*Logfile list of procmailrc. (setq proc-log-list \'(\"~/Mail/from-log\" \"~/Mail/ml-log\")) ") (defvar proc-keep-log nil "*Keeping logfile. If nil, not keeping. (setq proc-keep-log \"~/Mail/listlog\") disk に以前の記録を残す (nil)" ) (defvar proc-lock-file "~/Mail/.lock" "*Global lockfile of procmail.") (defvar prom-sort-folder-list '("+inbox") "*Order of folders. これに順を書いておくと便利 (+inbox) ") (defvar prom-sort-folder-list-2 nil "*Order of folders. Each elements are regexp. If non-nil, ignored prom-sort-folder-list. 表示する folder の順を 正規表現で書く。設定すると prom-sort-folder-list の方は無視される(nil) ") (defvar prom-auto-select-first t "*Select the first unread letter automatically if non-nil. But non-nil has problem for multipart letter. 一番最初の未読を開けて表示する (t)") (defvar prom-auto-select-first-for-checked-folder t "*Select the first unread letter automatically if non-nil, when reading checked folder. folder の中に入った時に、未読を開ける (t)") (defvar prom-wait-auto-select-first t "*If non-nil, Wait for select the first unread letter automatically.") (defvar prom-auto-select-next t "*If non-nil, offer to go to the next folder from the end of the previous. 一つ folder が終った時に、次を開ける (t)") (defvar prom-auto-select-next-ignored-command-list (list 'mew-summary-delete 'mew-summary-refile 'mew-summary-refile-again 'exit-minibuffer) "*List of command in mew-summary-mode that don't go to the next folder. 設定されている操作(関数)では、次の folder に行かない") (defvar prom-full-window t "*If non-nil, use the entire Emacs screen. Emacs の全画面を使う (t) ") ;; nil にはどうなるか ? XXX (defvar prom-kill-mew-buffer nil "*If non-nil, kill buffer of mew when exiting folder or going to other folder. folder から出る時と別の folder に行く時に mew の buffer を捨てる (nil)") (defvar prom-exit-kill-all-mew-buffer t "*If non-nil, kill all folder buffers of mew when exiting prom. prom 終了の際に mew の buffer を全て捨てる (t)") (defvar prom-get-new-mail-optional-method nil "*Optional method called at prom-get-new-mail. (setq prom-get-new-mail-optional-method \'prom-check-unread-folders) or (setq prom-get-new-mail-optional-method \'prom-check-list-folders) prom-get-new-mail の時に別の方法を使う ") (defvar prom-check-folders nil "*Folders list of check unread folder. (setq prom-check-folders \'(\"+inbox\" \"+private\")) 未読を調べる folder ") (defvar prom-ignore-no-mewcache-folders nil "*If non-nil, ignored folder that there is no `.mew-cache' file, when check unread folders. 未読を調べる時に、.mew-cache がないものは無視する folder ") (defvar prom-ignore-check-folders '("/$" "^\\+trash" "^\\+tmp" "^\\+draft") "*Ignored folders when check unread folders. Each elements are regexp. (setq prom-ignore-check-folders \'(\"/$\" \"^\\\\+drafts\" \"^\\\\+tmp$\")) 未読を調べる時に無視する folder を列記する。正規表現を使う。 ") (defvar prom-highlight-folder t "*Use highlight folders in prom folder mode. prom-folder-mode の時に強調表示する (t) ") (defvar prom-highlight-mouse-line t "*Use highlight folders in prom folder mode. prom-folder-mode の時に mouse のある行を強調表示する (t) ") (defvar prom-highlight-mouse-line-function (function mode-motion-highlight-line) "*A function to highlight the mouse line in Prom mode prom-mode の時に mouse の行を強調する時に使う関数 (function mode-motion-highlight-line)" ) (defvar prom-mew-compatible nil "*If non-nil become same behavior when goto folder and exit in mew summary mode. But, normally don't set `t', if prom-mew use. folder を移る時、出る時に、mew summary mode と同じ挙動に設定する しかし prom-mew を使うなら、t には設定しないこと (nil) ") (defvar prom-list-display-header t "*If non-nil, display mail header at prom-list-folders. prom-list-folder の時に mail header を表示する (t) ") (defvar prom-list-display-from t "*If non-nil display \'from\' at prom-list-folders. If `prom-list-display-header' is nil, ignored. prom-list-folder の時に from を表示する (t) prom-list-diplay-header が nil なら、この変数は無視される ") (defvar prom-folder-toggle-move-key nil "*If non-nil, change move-function\'s key bind. move-function の鍵割当を切換える (nil) ") (defvar prom-use-lockfile t "*If non-nil, use lockfile program of procmail package. procmail に含まれる lockfile 操作を使う (t) ") (defvar prom-mew-xheader '(concat prom-version " (procmail reader for Mew)") "*A value or function inserted into X-Prom-Mew: field in draft mode. X-Prom-Mew の値または生成する関数を設定する ") (defvar prom-init-no-get-new-mail nil "*If non-nil, don't get new mail on prom-mew init. prom-mew を起動する時に、新しいメールを取込まない (nil) ") (defvar prom-summary-ls-always-last nil "*If non-nil, always scan last in prom-summary-ls. prom-summary-ls の最後を必ず調べる (nil) ") (defvar prom-lock-optional-method t "*If non-nil, lock on `prom-get-new-mail-optional-method'. prom-get-new-mail-optional-method の時に lock する (t) ") (defvar prom-lock-at-exist-log t) (defvar prom-start-list-folders nil "Value is 'all or 'nomail-all or nil. ") (defvar prom-keep-log-max-size nil "*Max size of file that specified `proc-keep-log'. proc-keep-log で指定する譜の(大きさの)最大値 ") (defvar prom-mew-addrbook-for-prom 'nickname "*How to replace an address in folder list with Addrbook. See \"mew-addrbook-switch\". folder list の表示の際に、 Addressbook にある名前を何で置き換えるかを指定する ") ;; Hooks (defvar prom-previous-hook nil "*Hook called at previous initialize time.") (defvar prom-hook nil "*Hook called at initialize time.") (defvar prom-exit-hook nil "*Hook called when exiting prom.") (defvar prom-list-folders-hook nil "*Hook called when listing folder.") (defvar prom-select-folder-hook nil "*Hook called at select folder.") (defvar prom-get-new-mail-pre-hook nil "*Hook called at previous get new mail.") (defvar prom-get-new-mail-hook nil "*Hook called at get new mail.") (defvar prom-mew-load-hook nil "*Hook called at load prom-mew.") (defvar prom-folder-mode-hook nil "*Hook called when prom-folder mode.") (defvar prom-get-proc-log-hook nil "*Hook called after prom-set-promrc-log.") ;;; @ global variables ;;; (defvar prom-startup-file ".promrc.el" " file to store unread mails. 未読を記憶する譜名" ) (defvar prom-interactive-catchup t) (defvar promrc-log-assoc nil) (defvar promrc-old-log-assoc nil) (defvar promrc-prev-log-assoc nil) (defvar promrc-log-assoc-presort nil) (defvar promrc-log-assoc-aftsort nil) (defvar prom-folder-name nil) (defvar prom-previous-window-config nil) (defvar prom-window-config nil) (defvar prom-seen-list nil) (defvar prom-cursol-point nil) (defvar prom-status-list-all-folders nil "Show the status of list-all-folders done or not.") (defvar prom-unread-mails 0) (defvar prom-mew-setup nil) (defvar prom-do-lock nil) (defvar prom-prog-lockfile "lockfile") (defvar prom-prog-lockfile-arg-list '("-2" "-r4" "-l10") "*Argument list for lockfile program") (defvar prom-lockfile-arg-list prom-prog-lockfile-arg-list "*Argument list for lockfile program. This variable is obsolate, use `prom-prog-lockfile-arg-list'.") ;;; 定数 (defconst prom-folder-buffer "*Prom*") (defconst prom-buffer-tmp " *prom tmp*") (defconst prom-folder-list-regexp " %4d: %s\n") (defconst prom-folder-search-regexp "^%s[ \t]*\\(%s\\):") (defconst prom-folder-name-regexp "^ *[0-9]+:[ \t]+\\([^ \t\n]+\\)\\([ \t].*\\|$\\)") ;; (defvar prom-tmp-auto-select-next nil) (defvar prom-folder-mode-map nil) ;;; @ environment set ;;; (defvar prom-folder-mode-menu-spec '("Prom" ["Read" prom-folder-read-folder t] ["Next unread folder" prom-folder-next-unread-folder t] ["Previous unread folder" prom-folder-prev-unread-folder t] ["Next folder" prom-folder-next-folder t] ["Previous folder" prom-folder-prev-folder t] ["Jump to folder" prom-folder-jump-to-folder t] "----" ["Get new mail" prom-get-new-mail t] ["Get all new mail" prom-get-new-all-mail t] ["Suspend" prom-suspend t] ["Exit" prom-exit t] ["Quit" prom-quit t] ["Catchup" prom-folder-catchup t] ["List folders" prom-folder-list-folders t] ["List all folders" prom-folder-list-all-folders t] ["Toggle Folder/Full" prom-folder-toggle-display-header t] ["Go to folder" prom-folder-goto-folder t] "----" ["Write a mail" mew-send t] ["Status Update" mew-status-update t] ) " Emacs/Menu を設定する" ) ;;; @ code ;;; (defun prom-folder-define-key () " Define key assignment. " (if prom-folder-mode-map () (setq prom-folder-mode-map (make-sparse-keymap)) (let ((prom-folder-toggle-move-key (not prom-folder-toggle-move-key))) (prom-folder-toggle-move-key)) ;; default key bind (define-key prom-folder-mode-map "\r" 'prom-folder-read-folder) (define-key prom-folder-mode-map " " 'prom-folder-read-folder) (define-key prom-folder-mode-map "t" 'prom-folder-toggle-move-key) (define-key prom-folder-mode-map "h" 'prom-folder-toggle-display-header) (define-key prom-folder-mode-map "j" 'prom-folder-jump-to-folder) (define-key prom-folder-mode-map "s" 'prom-get-new-mail) (define-key prom-folder-mode-map "S" 'prom-save-promrc-file ) (define-key prom-folder-mode-map "\es" 'prom-get-new-all-mail) (define-key prom-folder-mode-map "z" 'prom-suspend) (define-key prom-folder-mode-map "q" 'prom-exit) (define-key prom-folder-mode-map "Q" 'prom-quit) (define-key prom-folder-mode-map "c" 'prom-folder-catchup) (define-key prom-folder-mode-map "l" 'prom-folder-list-folders) (define-key prom-folder-mode-map "L" 'prom-folder-list-all-folders) (define-key prom-folder-mode-map "g" 'prom-folder-goto-folder) (define-key prom-folder-mode-map "v" 'prom-version) (define-key prom-folder-mode-map "V" 'prom-summary-virtual) ;; mew commands (define-key prom-folder-mode-map "w" 'mew-send) (define-key prom-folder-mode-map "Z" 'mew-status-update) (define-key prom-folder-mode-map "\C-c\C-o" 'mew-summary-jump-to-draft-buffer) ;; menu bar (if mew-xemacs-p (define-key prom-folder-mode-map 'button2 'prom-folder-mouse-show) (define-key prom-folder-mode-map [mouse-2] 'prom-folder-mouse-show) (easy-menu-define prom-folder-mode-menu prom-folder-mode-map "Menu used in Prom folder mode." prom-folder-mode-menu-spec )) )) ; prom-mew-init/ prom-mew-resetup の二か所から呼ばれる ; (defun prom-mew-setup () "Initialize, called by prom-mew-init and prom-mew-resetup." (if prom-mew-setup nil (add-hook 'mew-message-hook 'prom-add-seen-list) (add-hook 'mew-summary-mode-hook '(lambda () (define-key mew-summary-mode-map "q" 'prom-summary-exit) (define-key mew-summary-mode-map "g" 'prom-summary-goto-folder) )) (and (boundp 'mew-virtual-mode-map) (add-hook 'mew-virtual-mode-hook '(lambda () (define-key mew-virtual-mode-map "q" 'prom-summary-exit) (define-key mew-virtual-mode-map "g" 'prom-summary-goto-folder) ))) ;; for mew-draft (if prom-mew-xheader (let ((x-prom-mew (assoc "X-Prom-Mew:" mew-header-alist))) (if x-prom-mew (setcdr x-prom-mew (eval prom-mew-xheader)) (setq mew-header-alist (cons (cons "X-Prom-Mew:" (eval prom-mew-xheader)) mew-header-alist))) )) ;; end of setup (setq prom-mew-setup t) )) ;;; @ Macros ;;; (defmacro prom-push (v l) (list 'setq l (list 'cons v l))) ; これがとても時間がかかる気がする (defmacro prom-set-log-promrc (log promrc) (` (setq (, promrc) ; item ; value ; (and alist) (prom-put-alist (car (, log)) (cdr (, log)) (, promrc) t)) )) (defmacro prom-get-promrc (folder promrc-assoc) (` (assoc (, folder) (, promrc-assoc)))) (defmacro prom-promrc-unread-count (folder promrc-assoc) (` (car (cdr (prom-get-promrc (, folder) (, promrc-assoc)))))) (defmacro prom-promrc-mail-log (folder promrc-assoc) (` (cdr (cdr (prom-get-promrc (, folder) (, promrc-assoc)))))) (defmacro prom-info-folder-name (folder-info) (` (car (, folder-info)))) (defmacro prom-info-unread-count (folder-info) (` (car (cdr (, folder-info))))) (defmacro prom-info-mail-log (folder-info) (` (cdr (cdr (, folder-info))))) (defmacro prom-make-promrc-log (folder unread-count mail-log) (` (append (list (, folder) (, unread-count)) (, mail-log)))) ;;; @ prom-folder-mode ;;; mode line に List of folders と表示されるのはこの状態 ;;; prom-mew-init から呼ばれる (defun prom-folder-mode () "Major mode for procmail log listing. \\{prom-folder-mode-map} " (interactive) (kill-all-local-variables) (setq major-mode 'prom-folder-mode) (setq mode-name "Prom") (setq mode-line-modified "-- ") (setq mode-line-buffer-identification (format "%s: List of folders" prom-version)) (setq mode-line-process nil) (use-local-map prom-folder-mode-map) (setq truncate-lines t) ;; (if mew-xemacs-p (progn ;;(set-specifier scrollbar-height (cons (current-buffer) 0)) (set-buffer-menubar current-menubar) (add-submenu nil prom-folder-mode-menu-spec) )) ;; (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) (run-hooks 'prom-folder-mode-hook)) ;;; @ prom enter and exit ;;; ;;; prom-mew-init -> prom-folder-mode と呼ぶ ;;; (defun prom-mew (&optional arg) "Intended to start prom-mew, invoke prom-mew-init and prom-folder-mode." (interactive "P") (let ((buf prom-folder-buffer)) (run-hooks 'prom-previous-hook) (setq prom-previous-window-config (current-window-configuration)) (if (or (boundp 'mew-init-p) mew-mail-path) ; for mew-1.94 () (mew-init)) (prom-mew-init buf arg) (run-hooks 'prom-hook) )) ;;; @ prom enter and exit (2) ;;; (defun prom-exit () "To exit from prom-mew gracefully. See prom-quit" (interactive) ;; (prom-save-promrc-file) (prom-clean-variables) (if prom-exit-kill-all-mew-buffer (progn (mew-buffer-message-clean-up (function mew-kill-buffer)) (mew-buffers-clean-up) (mew-temp-dir-clean-up) (mew-mark-clean-up))) (mew-kill-buffer prom-folder-buffer) (if prom-previous-window-config (set-window-configuration prom-previous-window-config)) (run-hooks 'prom-exit-hook)) ;;; @ prom enter and exit (3) ;;; (defun prom-quit () "To quit from prom-mew without cleanup. See prom-exit" (interactive) (prom-save-promrc-file) (prom-clean-variables) (mew-summary-quit) (mew-kill-buffer prom-buffer-tmp) (mew-kill-buffer prom-folder-buffer) (if prom-previous-window-config (set-window-configuration prom-previous-window-config)) (run-hooks 'prom-exit-hook)) ;;; @ prom enter and exit (4) ;;; (defun prom-suspend () " Suspend prom-mew, normally assigned to z key" (interactive) (if prom-previous-window-config (set-window-configuration prom-previous-window-config)) ) ;;; @ prom enter and exit (5) ;;; prom-mew -> prom-mew-init -> prom-folder-mode -> prom-mew-setup ;;; (defun prom-mew-init (buf &optional arg) " Initiaze prom-mew, called from prom-mew-setup" (cond ((get-buffer buf) (switch-to-buffer (get-buffer buf)) ) (t (switch-to-buffer (get-buffer-create buf)) (if prom-full-window (delete-other-windows)) (prom-folder-define-key) (prom-folder-mode) (prom-mew-setup) (prom-read-promrc-file) (prom-del-folder-promrc-log) )) (if arg (prom-folder-goto-folder) (or prom-init-no-get-new-mail (prom-get-new-mail) )) ) ;;; exit and clean で呼ばれる(だけ) (defun prom-clean-variables () "Clean variables, invoked by prom-exit and prom-clean." (setq promrc-log-assoc nil promrc-old-log-assoc nil promrc-prev-log-assoc nil prom-status-list-all-folders nil)) ;;; @ Commands for prom-folder-mode ;;; (defun prom-get-new-mail (&optional arg) ; command s "Get New mail, from procmail log files. If arg is non-nil, check unread folders. Normally assigned to key s." (interactive "P") (let ((folder (prom-folder-folder-name)) status) (run-hooks 'prom-get-new-mail-pre-hook) (or prom-status-list-all-folders (prom-del-folder-promrc-log)) ;; (or prom-lock-optional-method (and prom-get-new-mail-optional-method (funcall prom-get-new-mail-optional-method arg))) (setq status (prom-lock proc-lock-file)) (cond ((eq status 'error) ;; lock failed (message "lock file `%s' exists!! Please wait a minute." proc-lock-file) (sit-for 1)) (status ;; lock successed (and prom-lock-optional-method (and prom-get-new-mail-optional-method (funcall prom-get-new-mail-optional-method arg))) (prom-get-proc-log) (prom-unlock proc-lock-file))) (run-hooks 'prom-get-new-mail-hook) (prom-sort-folder) (if (not (eq status 'error)) (cond ((eq prom-start-list-folders 'nomail-all) (if promrc-log-assoc (prom-list-folders t) (prom-folder-list-all-folders t))) (prom-start-list-folders (prom-folder-list-all-folders t)) (t (prom-list-folders t)))) (if folder (prom-folder-jump-to-folder folder)) )) (defun prom-get-new-all-mail (&optional arg) ; command M-s "Get New mail, from procmail log files and unread folders. If arg, check no '.mew-cache' folders. Normally assigned to M-s. " (interactive "P") (let ((prom-get-new-mail-optional-method 'prom-check-unread-folders)) (prom-get-new-mail arg))) (defun prom-folder-mouse-show (e) ; command (2nd mouse) " Read mail in folder, by (usuall 2nd) mouse button. マウス中ボタンでメールを読む" (interactive "e") (mouse-set-point e) (beginning-of-line) (prom-folder-read-folder)) (defun prom-folder-read-folder (&optional arg) ; command SPACE or r "Read mail in folder, normally assigned to SPACE or r." (interactive "P") (let ((folder (prom-folder-folder-name))) (if folder (progn (if (string-match "^\\(.:\\)?/" folder) (error "This path is not folder. Please catchup('c') and check ~/.procmailrc.")) (prom-read-folder folder nil arg))) )) (defun prom-folder-goto-folder (&optional arg folder range) ; command g "Goto folder, normally assigned to g." (interactive "P") (mew-window-push) (if (interactive-p) (call-interactively 'prom-summary-goto-folder) (prom-summary-goto-folder arg folder range)) (run-hooks 'prom-select-folder-hook)) (defun prom-folder-jump-to-folder (folder) ; command j "Jump to folder, normally assigned to j" (interactive (list (completing-read "folder: " promrc-log-assoc nil 'require-match))) (let ((case-fold-search nil)) (goto-char (point-min)) (re-search-forward (prom-folder-make-regexp folder) nil t) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) )) (defun prom-folder-next-folder (n) ; command n "Go to next N'th folder, normally assigned to n, but can be toggled by t key to N." (interactive "p") (while (and (> n 1) (prom-folder-search-forward nil t)) (setq n (1- n))) (or (prom-folder-search-forward nil t) (message "No more folder"))) (defun prom-folder-next-unread-folder (n) ; command N "Go to next N'th unread folder, normally assigned to N, but can be toggled by t key to n." (interactive "p") (while (and (> n 1) (prom-folder-search-forward nil nil)) (setq n (1- n))) (or (prom-folder-search-forward nil nil) (message "No more unread folder"))) (defun prom-folder-prev-folder (n) ; command p "Go to previous N'th folder, normally assigned to p, but can be toggled by t key to P." (interactive "p") (while (and (> n 1) (prom-folder-search-forward t t)) (setq n (1- n))) (or (prom-folder-search-forward t t) (message "No more folder"))) (defun prom-folder-prev-unread-folder (n) ; command P "Go to previous N'th folder,normally assigned to P, but can be toggled by t key to p." (interactive "p") (while (and (> n 1) (prom-folder-search-forward t nil)) (setq n (1- n))) (or (prom-folder-search-forward t nil) (message "No more unread folder"))) (defun prom-folder-toggle-move-key (&optional arg) ; command t "Toggle n/N p/P for next folder or unread next folder." (interactive "P") (setq prom-folder-toggle-move-key (if (null arg) (not prom-folder-toggle-move-key) (> (prefix-numeric-value arg) 0))) (if prom-folder-toggle-move-key (progn (define-key prom-folder-mode-map "n" 'prom-folder-next-folder) (define-key prom-folder-mode-map "p" 'prom-folder-prev-folder) (define-key prom-folder-mode-map "N" 'prom-folder-next-unread-folder) (define-key prom-folder-mode-map "P" 'prom-folder-prev-unread-folder)) (define-key prom-folder-mode-map "n" 'prom-folder-next-unread-folder) (define-key prom-folder-mode-map "p" 'prom-folder-prev-unread-folder) (define-key prom-folder-mode-map "N" 'prom-folder-next-folder) (define-key prom-folder-mode-map "P" 'prom-folder-prev-folder)) ) (defun prom-folder-toggle-display-header (&optional arg) ; command h "Toggle List-of-folders buffer, with mail header or just folders. Normally assigned to h. Folder 名だけを表示するか、中のメールの一覧まで表示するか切換える" (interactive "P") (setq prom-list-display-header (if (null arg) (not prom-list-display-header) (> (prefix-numeric-value arg) 0))) (prom-folder-search-forward t t t) (let ((folder (prom-folder-folder-name))) (prom-list-folders nil t) (and folder (prom-folder-jump-to-folder folder))) ) ; 一度 c してもまた現われるものがあるのは unread でないものが表示されているから ? (defun prom-folder-catchup () ; command c "Mark all messages as unread in current folder as read. normally assigned to key c." (interactive) (let* ((folder (prom-folder-folder-name))) (and folder (or (not prom-interactive-catchup) ;Without confirmation? (y-or-n-p "Delete all messages as read? ")) (progn (message "") ;Clear "Yes or No" question. ;; Any marked messages will be preserved. (prom-update-unread-messages folder t) ; ここで作業して (prom-list-folders) ; 表示しなおして (prom-folder-jump-to-folder folder) ; (prom-folder-next-folder 1))) )) (defun prom-folder-list-folders (&optional arg) ; command l "Show only the folders having unread mails. Normally assigned to key l." (interactive "P") (setq prom-status-list-all-folders (if (null arg) (not prom-status-list-all-folders) arg)) (if prom-status-list-all-folders (prom-folder-list-all-folders) (prom-del-folder-promrc-log) (prom-list-folders nil t) (setq prom-status-list-all-folders nil))) (defun prom-folder-list-all-folders (&optional mes) ; command L "Show all the folders. Normally assigned to key L." (interactive "P") (let ((folder-list mew-folder-list)) (message "Listing all folders ...") (while folder-list (prom-add-promrc-log (car folder-list) nil nil nil) (setq folder-list (cdr folder-list))) (prom-sort-folder) (prom-list-folders mes) (setq prom-status-list-all-folders t) (message "Listing all folders ... done") )) (defun prom-summary-virtual () ; command V "Start Virtual folder mode, normally assigned to key V. Ask folders name, (default to virtual) and ask pick pattern to find." (interactive) (let ((folder (concat "++" (mew-input-string "Virtual folder name %s(%s): " "" ;; dummy "virtual"))) (folders (mew-input-folders (or (prom-folder-folder-name) prom-folder-name ))) (grep (if (fboundp 'mew-input-pick-pattern) (mew-input-pick-pattern) (mew-read-pick-pattern)))) (mew-summary-scan-body args nil 'virtual))) (defun prom-mew-resetup () "Initialize prom-mew again, nothing assigned. Interactive use only." (interactive) (let ((prom-mew-setup nil)) (prom-mew-setup))) (defun prom-version () ; command v "Show prom-mew version. Assigned to key v." (interactive) (message "%s with %s" prom-version mew-version)) ;;; @ Commands or Functions for mew-summary-mode ;;; (defun prom-add-seen-list (&optional msgnum) " Called in prom::mew-summary-mark-as." (let ((prom-msg (or msgnum (cdr (mew-current-get 'message))))) (and (stringp prom-msg) (setq prom-msg (string-to-int prom-msg))) (if (not (memq prom-msg prom-seen-list)) (prom-push prom-msg prom-seen-list))) ) ;; [[ replace functions in mew-summary.el, mew-mark.el (defun prom::mew-summary-down () (if (orig::mew-summary-down) t (if (not (get-buffer prom-folder-buffer)) ;;(message "No more message") () (let* ((cmd (if mew-xemacs-p last-command-char (string-to-char (this-command-keys)))) (cmd-key (if mew-xemacs-p (single-key-description cmd) (key-description (char-to-string cmd)))) (folder (prom-summary-search-folder)) (select-next (and prom-auto-select-next prom-tmp-auto-select-next (not (member this-command prom-auto-select-next-ignored-command-list))))) (message "No more message%s" (if select-next (if folder (format " (Type %s for %s)" cmd-key folder) (format " (Type %s to exit %s)" cmd-key prom-folder-name )) "")) ;; Select next unread folder automatically. (cond (select-next (let (key keve) (setq key (car (setq keve (prom-read-event-char)))) (if (equal key cmd) (prom-summary-next-folder) (prom-push (cdr keve) unread-command-events)))) ))) ;; nil) ) (defun prom::mew-summary-mark-as (mark &optional force) "Mark this message if possible" (orig::mew-summary-mark-as mark) (let ((msg (mew-summary-message-number))) (prom-add-seen-list msg))) ;; (defconst prom-replace-function-list (list 'mew-summary-down 'mew-summary-mark-as)) (defun prom-replace-function () (mapcar (lambda (function) (if (not (fboundp (intern (format "orig::%s" function)))) (progn (fset (intern (format "orig::%s" function)) (symbol-function function)) (fset function (intern (format "prom::%s" function))) ))) prom-replace-function-list )) (prom-replace-function) ;; ]] (defun prom-summary-next-folder () "Called by prom::mew-summary-down (), to go next-unread folder, not assigned to any key." (interactive) (prom-summary-jump-to-folder prom-folder-name) (let ((folder (prom-summary-search-folder))) (if (null folder) (progn (message "Exiting %s..." prom-folder-name) (prom-summary-exit) (message "")) (message "Selecting %s..." folder) (prom-summary-exit t) ;Exit Summary mode temporary. (prom-summary-jump-to-folder folder) (prom-read-folder folder t) )) ) (defun prom-summary-exit (&optional temporary) "Exit reading current folder, and then return to folder selection mode. Assigend to q in virtual and summary mode." (interactive "P") (if prom-folder-name (prom-update-unread-messages prom-folder-name)) (setq prom-seen-list nil) (or prom-mew-compatible (prom-kill-buffer)) (mew-summary-suspend) (if (and (not prom-mew-compatible) (get-buffer prom-folder-buffer)) (set-buffer prom-folder-buffer)) (if (and prom-mew-compatible (not (equal (buffer-name) prom-folder-buffer))) nil (prom-list-folders) (if prom-folder-name (prom-folder-jump-to-folder prom-folder-name)) ) ) (defun prom-summary-goto-folder (&optional arg fld range) "Assigend to g in virtual and summary mode." (interactive "P") (let (dir folder prev-folder) (if (interactive-p) (progn (setq prev-folder (buffer-name)) (call-interactively 'mew-summary-goto-folder); ; (call-interactively 'mew-summary-switch-to-folder); (setq folder (buffer-name)) (if (equal prev-folder folder) nil (if prom-folder-name (prom-update-unread-messages prom-folder-name)) (if folder (setq prom-folder-name folder)) (setq prom-seen-list nil) (setq prom-tmp-auto-select-next nil) )) (setq folder (or fld (mew-input-folder mew-inbox-folder)) dir (mew-expand-folder folder)) (cond ((mew-folder-newsp folder) (prom-summary-switch-to-folder folder range arg)) ((mew-folder-imapp folder) (if (or (file-directory-p dir) (and (y-or-n-p (format "Cache directory for %s does not exist. Create it? " folder)) (mew-make-directory dir))) (prom-summary-switch-to-folder folder range arg))) (t ;; mail or local news (if (null dir) (message "Folder is wrong") (if (not (file-directory-p dir)) (message "No such folder %s" folder) (prom-summary-switch-to-folder folder range arg) (if mew-summary-trace-directory (cd dir))))))) )) (defun prom-summary-switch-to-folder (folder range arg) "Internal, only used inside of prom-summary-goto-folder()." (let ((ofolder (mew-summary-folder-name 'ext)) new-folder) (cond ((get-buffer folder) (switch-to-buffer folder) (if (not (mew-folder-virtualp folder)) (mew-summary-folder-cache-load)) (if (not (string= ofolder folder)) (mew-window-configure 'summary))) (t (setq new-folder t) (switch-to-buffer (get-buffer-create folder)) (mew-folder-insert folder) (mew-buffers-setup folder) (if (mew-folder-virtualp folder) (mew-virtual-mode) (mew-summary-mode) (if (and mew-summary-trace-directory (mew-folder-localp folder)) (cd (mew-expand-folder folder))) (mew-summary-folder-cache-load)) (mew-window-configure 'summary))) new-folder)) ; (let (new-folder) ; (if (get-buffer folder) ; (switch-to-buffer folder) ; (mew-summary-folder-create folder) ; (setq new-folder t)) ; (prom-summary-ls folder range (or arg new-folder) t))) (defun prom-summary-ls (&optional prom-folder range jump arg) "Internal, only called from prom-summary-switch-to-folder()." (let ((folder (or prom-folder (buffer-name))) scanp lines) (mew-summary-folder-cache-manage folder) (mew-mark-clean) (if jump (goto-char (point-max))) (mew-buffers-setup folder) (cond (range (setq range (prom-adj-range2 folder range)) (setq scanp t)) ((mew-folder-remotep folder);; xxx (setq range (mew-input-range folder mew-range-interactive-alist t)) (setq scanp t)) ((and mew-summary-cache-use (mew-summary-folder-dir-newp)) (setq range (mew-input-range folder mew-range-auto-alist mew-ask-range)) (setq scanp t))) (if (not scanp) (or arg (goto-char (point-max))) (or arg (goto-char (point-max))) (mew-decode-syntax-delete) (if (equal (car range) "all") (setq lines (mew-summary-mark-collect3 mew-mark-review))) (mew-summary-scan-body (mew-scan-mewls-src folder range) lines)))) ;;; @ Functions of commands for prom-folder-mode ;;; (defun prom-folder-dir-newp (folder) "Internal, only used in prom-unread-count()." ;; buffer switched (let* ((dir (file-chase-links (mew-expand-folder folder))) (tdir (nth 5 (file-attributes dir))) (da (car tdir)) (db (car (cdr tdir))) (cache (expand-file-name mew-summary-cache-file dir)) (tcache (nth 5 (file-attributes cache))) (fa (car tcache)) (fb (car (cdr tcache)))) (cond ((null tdir) nil) ((null tcache) t) ;; no cache, do update! ((> da fa) t) ((= da fa) (if (> db fb) t nil)) ;; nil if same (t nil) ) )) (defun prom-mew-directory-msgs (folder) "*Return (list begin-msg eng-msg msgs) in folder, used in prom-unread-count()." (let* ((dir (mew-expand-folder folder))) (if (file-exists-p dir) (let ((files (sort (mapcar 'string-to-int (directory-files dir nil "^[0-9]+$" t)) '<))) (if files (list (car files) (car (reverse files)) (length files)))) nil) )) (defun prom-mew-cache-lastnum (folder &optional cache) "Internal, used only in prom-unread-count()." (let ((mew-folder-buffer (get-buffer folder)) (mew-cache (or cache (mew-expand-folder folder mew-summary-cache-file)))) (save-excursion (if mew-folder-buffer (set-buffer mew-folder-buffer) (set-buffer (get-buffer-create prom-buffer-tmp)) (erase-buffer) (if (file-exists-p mew-cache) (mew-frwlet mew-cs-text-for-read mew-cs-dummy (insert-file-contents mew-cache)))) (goto-char (point-max)) (if (bobp) 0 (forward-line -1) (string-to-int (save-excursion (beginning-of-line) (if (looking-at mew-summary-message-regex) (mew-match 1) "0"))) )) )) (defun prom-unread-count (folder &optional disp) "*Return (list unread-count begin-msg eng-msg) in folders. Ignored if `mew-summary-cache-use' is nil." (let ((cache (mew-expand-folder folder mew-summary-cache-file)) (unread-count nil) (cache-lastnum nil) (lastnum nil) msgs begin-msg) (if (and mew-summary-cache-use (prom-folder-dir-newp folder)) (save-excursion (if (or (prom-member-regex folder prom-ignore-check-folders) (and (not (file-exists-p cache)) prom-ignore-no-mewcache-folders)) nil (if disp (message "Checking unread folders ... (%s)" folder)) (if (setq msgs (prom-mew-directory-msgs folder)) (progn (setq lastnum (car (cdr msgs))) (setq cache-lastnum (prom-mew-cache-lastnum folder cache)) (cond ((= 0 cache-lastnum) (setq begin-msg (car msgs)) (setq unread-count (nth 2 msgs))) (t (setq unread-count (- lastnum cache-lastnum)) (setq begin-msg (1+ cache-lastnum)))) (if (> 0 unread-count) (setq unread-count 0)) )) ))) (if (and unread-count (> unread-count 0)) (list unread-count begin-msg lastnum)) )) (defun prom-member-regex (str regex-alist) (let ((regex)) (catch 'found (while (setq regex (car regex-alist)) (if (string-match regex str) (throw 'found regex)) (setq regex-alist (cdr regex-alist))) nil) )) (defun prom-check-unread-folders (&optional arg folder-list) "Check unread folders. If arg is non-nul, check no '.mew-cache' folders. If folder-list is given, check `folder-list'. if nil, check `mew-folder-list' " (let ((prom-ignore-no-mewcache-folders (if arg nil prom-ignore-no-mewcache-folders))) (if (not prom-ignore-no-mewcache-folders) (call-interactively 'mew-status-update)) (setq folder-list (or folder-list mew-folder-list)) (message "Checking unread folders ...") (while folder-list (let ((unread-list (prom-unread-count (car folder-list) t))) (and (car unread-list) (prom-add-promrc-log (car folder-list) (nth 1 unread-list) nil nil (car unread-list))) (setq folder-list (cdr folder-list)))) (message "Checking unread folders ... done") )) (defun prom-check-list-folders (&optional arg) "Check `prom-check-folders' folders. If arg, check `mew-folder-list' folders." (if arg (prom-check-unread-folders t) (prom-check-unread-folders nil prom-check-folders))) (defun prom-folder-jump-message (msg) (goto-char (point-min)) (if (re-search-forward (format "^[ ]*%d[^0-9:]+" msg) nil t) (beginning-of-line) )) (defun prom-list-folders (&optional mes force) (if (and (not force) (equal promrc-prev-log-assoc promrc-log-assoc)) nil (prom-list-folders-builtin mes) (prom-folder-highlight-mouse) (run-hooks 'prom-list-folders-hook)) (if (zerop (buffer-size)) nil (goto-char (point-min)) (prom-folder-search-forward nil nil t)) (if mes (cond ((eq prom-unread-mails 0) (message "No unread mail")) ((eq prom-unread-mails 1) (message " 1 unread mail")) (t (message " %d unread mails" prom-unread-mails)))) (setq promrc-prev-log-assoc (copy-alist promrc-log-assoc)) ) (defun prom-folder-highlight-mouse () (if (and window-system prom-highlight-mouse-line) (cond (mew-temacs-p (save-excursion (let ((buffer-read-only nil) (regexp prom-folder-name-regexp)) (goto-char (point-min)) (while (not (eobp)) (if (re-search-forward regexp nil t) (overlay-put (make-overlay (match-beginning 1) (match-end 1)) 'mouse-face 'highlight)) (forward-line 1) )) )) (mew-xemacs-p (setq mode-motion-hook prom-highlight-mouse-line-function)) ))) (defun prom-list-folders-builtin (&optional mes) "Internal, only for prom-list-folders()." (let ((buffer-read-only nil) (promrc promrc-log-assoc)) (erase-buffer) (setq prom-unread-mails 0) (while promrc (let* ((folder-info (car promrc)) (folder-name (prom-info-folder-name folder-info)) (mail-log-all (prom-info-mail-log folder-info)) (unread-count (prom-info-unread-count folder-info)) (unread-mail (or unread-count (length mail-log-all))) ) (setq prom-unread-mails (+ prom-unread-mails unread-mail)) (insert (format prom-folder-list-regexp unread-mail folder-name)) ;; if unread-count is non-nil, this folder is checked folder. (if (and (not unread-count) prom-list-display-header) (while mail-log-all (let ((mail-log (car mail-log-all))) (insert (format (concat " %5d" (if prom-list-display-from " (%-14s)" "%s") " %s\n") (car mail-log) ;; From (if prom-list-display-from (substring-e (prom-get-display-name (nth 1 mail-log)) 0 14) "") ;; Subject (prom-header-decode (nth 2 mail-log)) ))) (setq mail-log-all (cdr mail-log-all)))) (setq promrc (cdr promrc)))) )) (defun prom-folder-search-forward (backward norest &optional heretoo) "Search for the next (or previous) folder. If 1st argument BACKWARD is non-nil, search backward instead. If 2nd argument NOREST is non-nil, don't care about folder property. If optional argument HERETOO is non-nil, current line is searched for, too." (let ((case-fold-search nil) (func (if backward (function re-search-backward) (function re-search-forward))) (regexp (format prom-folder-search-regexp (if norest ".." " [ \t]") (if norest "[0-9]+" "[1-9][0-9]*"))) (found nil)) (if backward (if heretoo (end-of-line) (beginning-of-line)) (if heretoo (beginning-of-line) (end-of-line))) (setq found (funcall func regexp nil t)) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) ;; Return T if found. found )) (defun prom-folder-folder-name () "Get folder name around point." (save-excursion (beginning-of-line) (if (looking-at prom-folder-name-regexp) (mew-match 1)) )) (defun prom-read-folder (folder &optional no-message arg) (let* ((folder-info (prom-get-promrc folder promrc-log-assoc)) (mail-log (prom-info-mail-log folder-info)) (unread-count (prom-info-unread-count folder-info)) (begin-msg (car (car mail-log))) (end-msg (car (car (reverse mail-log)))) (range nil) (prom-auto-select-first prom-auto-select-first)) (setq prom-folder-name folder) (if (null no-message) (setq prom-window-config (current-window-configuration))) (setq prom-cursol-point (point)) (if (null begin-msg) (progn (setq prom-tmp-auto-select-next nil) (prom-folder-goto-folder arg folder) ) (setq prom-tmp-auto-select-next t) (setq range (concat (int-to-string begin-msg) "-" (if (or unread-count prom-summary-ls-always-last) "last" (int-to-string end-msg)) )) ;; if unread-count is non-nil, this folder is checked folder. (if unread-count (progn (prom-update-unread-messages folder t) (setq prom-auto-select-first prom-auto-select-first-for-checked-folder))) (setq prom-seen-list nil) (prom-folder-goto-folder arg folder (list range nil 'update)) ;; not erase (if (and begin-msg prom-auto-select-first) (progn (if (processp mew-summary-buffer-process) (if (and (not prom-wait-auto-select-first) (fboundp 'accept-process-output)) (while (and mew-summary-buffer-process (equal (process-status mew-summary-buffer-process) 'run) (not (prom-search-message begin-msg))) (accept-process-output mew-summary-buffer-process) (sit-for 0.1)) (while mew-summary-buffer-process (sit-for 1))) ) (mew-summary-jump-message begin-msg) (mew-summary-display nil))) ))) (defun prom-search-message (msg) (save-excursion ;; (goto-char (point-min)) (if (re-search-forward (format "^[ ]*%s[^0-9]+" msg) nil t) (progn (beginning-of-line) t) nil))) (defun prom-adj-range (folder range) "return (range erase 'update)" (string-match "\\(.*\\)-\\(.*\\)" (car range)) (let ((end-num (mew-match 2 (car range)))) (cond ((get-buffer folder) (save-excursion (set-buffer folder) (if (equal (point-min) (point-max)) range ;; default (goto-char (point-max)) (forward-line -1) (list (concat (int-to-string (1+ (string-to-int (mew-summary-message-number)))) "-" end-num) nil 'update) ;; not erase )) ) (t range) ;; default ))) (defun prom-adj-range2 (folder range) "return (range erase-update)" (string-match "\\(.*\\)-\\(.*\\)" (car range)) (let ((end-num (mew-match 2 (car range)))) (cond ((get-buffer folder) (save-excursion (set-buffer folder) (if (equal (point-min) (point-max)) range ;; default (goto-char (point-max)) (forward-line -1) (list (concat (int-to-string (1+ (string-to-int (mew-summary-message-number)))) "-" end-num) 'update) ;; not erase ))) (t range) ;; default ))) (defun prom-kill-buffer (&optional buf) (if prom-kill-mew-buffer (progn (if (null buf) (setq buf (current-buffer))) (let ((buf-name (buffer-name buf))) (if (not (equal buf-name prom-folder-buffer)) (progn ;;(mew-summary-folder-mark-exec) (mew-mark-clean) (if (get-buffer (mew-buffer-message)) (delete-windows-on (mew-buffer-message))) (kill-buffer buf) (setq mew-buffers (delete buf-name mew-buffers))))) (mew-kill-buffer (mew-buffer-message)) ))) (defun prom-lock (lockfile) (setq prom-do-lock t) (if prom-lock-at-exist-log (setq prom-do-lock (let ((log-list proc-log-list) proc-log) (catch 'exist (while log-list (setq proc-log (car log-list)) (if (file-exists-p proc-log) (throw 'exist t)) (setq log-list (cdr log-list))) nil)))) (if prom-do-lock (setq prom-do-lock (or (cond (prom-use-lockfile (prom-wait-lock lockfile)) (t (prom-make-lock lockfile))) 'error))) prom-do-lock ) (defun prom-unlock (lockfile) (if (and prom-do-lock (file-exists-p lockfile)) (delete-file lockfile))) (defun prom-make-lock (lockfile) (let ((status (call-process "ln" nil nil nil "-s" "prom-mew" (expand-file-name lockfile)))) (if (= 0 status) t (message "lock file exists!!") nil ))) (defun prom-wait-lock (lockfile) (message "Now locking..." lockfile) (let ((status (apply (function call-process) prom-prog-lockfile nil nil nil (append prom-prog-lockfile-arg-list (list (expand-file-name lockfile)))))) (if (= 0 status) (progn (message "") t) (message "lock failed!!") nil ))) ;;; @ Functions for promrc-log-assoc ;;; (defun prom-get-proc-log () (save-excursion (set-buffer (get-buffer-create prom-buffer-tmp)) (buffer-disable-undo (current-buffer)) (let ((log-list proc-log-list)) (erase-buffer) (while log-list (let ((proc-log (car log-list))) (cond ((file-exists-p proc-log) (goto-char (point-max)) (mew-flet (insert-file-contents proc-log)) (delete-file proc-log)) ) (setq log-list (cdr log-list)))) (if (zerop (buffer-size)) nil (prom-append-keep-log) (prom-set-promrc-log) (run-hooks 'prom-get-proc-log-hook) )) )) (defun prom-append-keep-log () (if proc-keep-log (let ((log-size (nth 7 (file-attributes proc-keep-log)))) (if (and prom-keep-log-max-size log-size (> log-size prom-keep-log-max-size)) (rename-file proc-keep-log (concat proc-keep-log ".bak") t)) (if (file-writable-p proc-keep-log) (save-excursion (write-region (point-min) (point-max) proc-keep-log t 'no-msg)) (message "not writable file! `%s'" proc-keep-log))))) (defun prom-get-display-name (from) (or (when (and (boundp 'mew-addrbook-switch) (fboundp 'mew-addrbook-func)) (let ((func (mew-addrbook-func prom-mew-addrbook-for-prom))) (and func (funcall func from)))) from)) (defun prom-set-promrc-log () (let (folder msg from subject) (save-excursion (goto-char (point-min)) (while (re-search-forward "^ Folder: \\(.+\\)" nil t) (let ((folder-body (mew-match 1))) (if (string-match "^\\(.+\\)/\\([0-9]+\\)" folder-body) (let ((path (mew-match 1 folder-body)) (num (mew-match 2 folder-body))) (setq msg (string-to-int num)) (cond ((string-match "^[+=]" path) (setq folder path) ) ;; Absolute path (include DriveLetter) ((string-match "^\\(.:\\)?/" path) (cond ((string-match (concat "^" (expand-file-name mew-mail-path) "/*") path) (setq folder (concat "+" (substring path (match-end 0)))) ) ((string-match (concat "^" (expand-file-name mew-news-path) "/*") path) (setq folder (concat "=" (substring path (match-end 0)))) ) (t (setq folder path)) )) ;; mail folder (t (setq folder (concat "+" path)) )) (save-excursion (forward-line -1) (beginning-of-line) (if (looking-at "^ Subject: \\(.+\\)") (progn (setq subject (mew-match 1)) (setq subject (or (mew-cs-decode-string subject mew-cs-text-for-read) "")) (forward-line -1) (beginning-of-line)) (setq subject "")) (if (looking-at "^From \\([^ \t\n]+\\) +") (setq from (mew-match 1)) (setq from ""))) ;; (prom-add-promrc-log folder msg from subject)))))))) (defun prom-sort-folder () (cond (prom-sort-folder-list-2 (prom-sort-folder-2)) (t (prom-sort-folder-1)))) (defun prom-sort-folder-1 () (let ((folder-list (reverse prom-sort-folder-list))) (while folder-list (let* ((folder (car folder-list)) (folder-info (prom-get-promrc folder promrc-log-assoc))) (if folder-info (setq promrc-log-assoc (cons folder-info (delq folder-info promrc-log-assoc))) )) (setq folder-list (cdr folder-list))))) (defun prom-sort-folder-2 () (let ((sort-list prom-sort-folder-list-2) (promrc-log-assoc-2 nil)) (if (equal promrc-log-assoc-presort promrc-log-assoc) (setq promrc-log-assoc (copy-alist promrc-log-assoc-aftsort)) (setq promrc-log-assoc-presort (copy-alist promrc-log-assoc)) (while sort-list (let* ((sort-key (car sort-list)) (alist promrc-log-assoc) folder-info n) (while alist (setq folder-info (car alist)) (setq n (car folder-info)) (if (string-match sort-key n) (progn (setq promrc-log-assoc-2 (append promrc-log-assoc-2 (list folder-info))) (setq promrc-log-assoc (delq folder-info promrc-log-assoc)))) (setq alist (cdr alist))) ) (setq sort-list (cdr sort-list))) (setq promrc-log-assoc (append promrc-log-assoc-2 promrc-log-assoc)) (setq promrc-log-assoc-aftsort (copy-alist promrc-log-assoc)) ))) (defun prom-add-promrc-log (folder msg from subject &optional unread-count) (let ((add-log (and msg (list (list msg from subject)))) (promrc promrc-log-assoc) new-folder-info found) (setq found (prom-get-promrc folder promrc)) (if found (let* ((folder-name (prom-info-folder-name found)) (old-unread-count (prom-info-unread-count found)) (mail-log (prom-info-mail-log found))) (if add-log (let ((new-mail-log (if old-unread-count add-log (if (and unread-count mail-log) (progn (setq unread-count nil) mail-log) (append mail-log add-log))))) (setq new-folder-info (prom-make-promrc-log folder-name unread-count new-mail-log))) (setq new-folder-info (prom-make-promrc-log folder-name old-unread-count mail-log))) ) (setq new-folder-info (prom-make-promrc-log folder unread-count add-log)) ) (prom-set-log-promrc new-folder-info promrc-log-assoc) )) ; promrc-log-assoc から、読んだものを除く (defun prom-del-folder-promrc-log () (let ((promrc promrc-log-assoc)) ; promrc はこの中での作業用 (while promrc (let* ((folder-info (car promrc)) ; 一つ目が folder (unread-count (prom-info-unread-count folder-info))) ; (未読数 folder-info) の組を作っておいて (if (and (null (prom-info-mail-log folder-info)) (or (null unread-count) (zerop unread-count))) ; という条件の時には (setq promrc-log-assoc ; 未読情報から (delq folder-info promrc-log-assoc)))) ; 一つ取除く (setq promrc (cdr promrc))) ; 作業用の方も取除く )) (defun prom-update-unread-messages (folder &optional all) (if all (prom-del-allmsg-promrc-log folder) (prom-del-msg-promrc-log folder prom-seen-list))) (defun prom-del-allmsg-promrc-log (folder) "Mark as delete all the messages in folder, only for prom-update-unread-messages(folder t)." (let (log found) (setq found (prom-get-promrc folder promrc-log-assoc)) (if found (progn (setq log (list (prom-info-folder-name found))) (prom-set-log-promrc log promrc-log-assoc) )))) (defun prom-del-msg-promrc-log (folder msg-list) "Mark as delete selected the messages (msg-list) in folder, only for prom-update-unread-messages(folder)." (let (promrc) (setq promrc (prom-get-promrc folder promrc-log-assoc)) (if promrc (while msg-list (let* ((old-unread-count (prom-info-unread-count promrc)) (log-all (prom-info-mail-log promrc)) (log log-all) (msg (car msg-list)) (found nil) info) (while (and (not found) log) (if (equal msg (car (car log))) (let* ((new-log (delq (car log) log-all)) (unread-count (and old-unread-count (length new-log)))) (setq info (prom-make-promrc-log folder unread-count new-log)) (prom-set-log-promrc info promrc-log-assoc) (setq found t)) (setq log (cdr log)))) (setq msg-list (cdr msg-list))))) )) (defun prom-read-promrc-file () "Read startup FILE." (let ((startup (expand-file-name prom-startup-file mew-mail-path))) (if (file-readable-p startup) (load startup t t t) ) (setq promrc-old-log-assoc (copy-alist promrc-log-assoc)))) ; 抜ける時のため、初期値を覚えておく (defun prom-save-promrc-file () (interactive) "Save to .promrc FILE and cache file." (prom-del-folder-promrc-log) ; promrc-log から読んだものを消す (if (equal promrc-old-log-assoc promrc-log-assoc) ; もし初期値と同じだったら何もしない nil (save-excursion (set-buffer (get-buffer-create " *proc-promrc*")) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert "(setq promrc-log-assoc '" (prin1-to-string promrc-log-assoc) ")\n") (let ((make-backup-files nil) (version-control nil) (require-final-newline t) ;Don't ask even if requested. (startup (expand-file-name prom-startup-file mew-mail-path))); XXX この変数いいのかな。 (write-region (point-min) (point-max) startup nil 'no-msg) (kill-buffer (current-buffer)) (message "Saving %s... Done" startup)) ) )) ;;; @ Misc ;;; (defun substring-e (string start end) (substring (concat string (make-string (- end start) ?\ )) start end)) ;; from tl-list.el (Tools for MIME), Modified by M.Murata (defun prom-put-alist (item value alist &optional last) "If there is a pair whose car is , replace its cdr by . If there is not such pair, create new pair ( . ) and return new alist whose car is the new pair and cdr is . " (if (assoc item alist) ; もし item が alist に入っていたら、 (progn ; 入替え (rplacd (assoc item alist) value) alist) (if last ; もし最後に付けるというなら、append (append alist (list (cons item value))) (cons (cons item value) alist)) ; 以上でなかったら、これを実行 )) ;;; @ Modified functions in mew-header.el 1.70 ;;; (defun prom-header-decode (str) (if (null str) (setq str "") (if (not (string-match mew-header-decode-regex str)) ;;(setq str (mew-cs-decode-string str mew-cs-scan)) nil (while (string-match mew-header-decode-regex str) (let* ((charset (mew-match 1 str)) (encode (mew-match 2 str)) (enstr (mew-match 3 str)) (head (substring str 0 (match-beginning 0))) (tail (substring str (match-end 0) (length str))) ;;(func (cdr (mew-assoc-match encode mew-header-decode-switch 0))) (destr "")) (setq destr (mew-header-decode charset encode enstr)) (setq str (concat head destr tail)) )))) str ) ;;; @ Modified functions in gnus.el (GNUS 4) ;;; (defun prom-summary-search-folder (&optional backward) "Search for next unread folder. If optional argument BACKWARD is non-nil, search backward instead." (save-excursion (set-buffer prom-folder-buffer) (save-excursion (if prom-cursol-point (goto-char prom-cursol-point)) (if (prom-folder-search-forward backward nil) (prom-folder-folder-name)) ))) (defun prom-folder-make-regexp (folder) "Return regexp that matches for a line of folder." (concat "^.+: " (regexp-quote folder) "\\([ \t].*\\|$\\)")) (defun prom-summary-jump-to-folder (folder) "Move point to folder in message mode buffer." ;; Keep update point of Group mode buffer if visible. (if (eq (current-buffer) (get-buffer prom-folder-buffer)) (save-window-excursion ;; Take care of tree window mode. (if (get-buffer-window prom-folder-buffer) (pop-to-buffer prom-folder-buffer)) (prom-folder-jump-to-folder folder)) (save-excursion ;; Take care of tree window mode. (if (get-buffer-window prom-folder-buffer) (pop-to-buffer prom-folder-buffer) (set-buffer prom-folder-buffer)) (prom-folder-jump-to-folder folder)))) ;; Modified functions in gnus-util.el (Gnus 5.4) (defun prom-read-event-char () "Get the next event." (let ((event (read-event))) ;; should be gnus-characterp, but this can't be called in XEmacs anyway (cons (and (numberp event) event) event))) (defun prom-xmas-read-event-char () "Get the next event." (let ((event (next-command-event))) (sit-for 0) ;; We junk all non-key events. Is this naughty? (while (not (or (key-press-event-p event) (button-press-event-p event))) (dispatch-event event) (setq event (next-command-event))) (cons (and (key-press-event-p event) (event-to-character event)) event))) (if mew-xemacs-p (fset 'prom-read-event-char 'prom-xmas-read-event-char)) ;;; @ end ;;; (run-hooks 'prom-mew-load-hook) (provide 'prom-mew) ;;; Local variables: ;;; mode: outline-minor ;;; outline-regexp: ";;; @+\\|(......" ;;; End: