mew-indays.el -- mew indays.

mew-indays.el

;; mew-indays.el -- mew indays.
;; Copyright (C) 2018, 2022 fubuki
;; @(#)$Revision: 1.3 $

;; Author: fubuki@frill.org
;; Keywords: Mail Mew

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; mew 上のメッセージファイルのタイムスタンプが、
;; 現在から `mew-indays-default' 日以内のメッセージを集めます. デフォルトは 1日以内です.
;; メールの中の "Date:" からではなくファイルのタイムスタンプなので、
;; メッセージを受信した日かリファイルした日付けが対象とされます.
;; 収集結果は着順ではなくフォルダごとの着順になるので、受信したときとは違った並びになります.

;; 日数は prefix によって指定できます.

;;   C-u 3 M-x mew-days

;; prefix の引数を省略した場合 `mew-indays-prefix-default' の値になります.
;; こちらのデフォルトは 7日以内です.

;;; Installation:

;; (require 'mew-indays)
;; (add-hook 'mew-summary-mode-hook #'(lambda () (local-set-key "kD" 'mew-indays)))

;;; Code:
(require 'mew)
(require 'mew-search-with-builtin)

(defgroup mew-indays nil
  "Mew day selection."
  :group   'mew
  :version "26.1")

(defcustom mew-indays-default 1
  "*no prefix default days."
  :type 'integer
  :group 'mew-indays)

(defcustom mew-indays-prefix-default 7
  "*prefix but no value default days."
  :type 'integer
  :group 'mew-indays)

(defun mew-indays (&optional days folders)
  "タイムスタンプが DAYS 日以内のメッセージを FOLDERS から集める.
DAYS は prefix からも指定可能."
  (interactive
   (let ((days (if (consp current-prefix-arg)
                   mew-indays-prefix-default
                 (or
                  current-prefix-arg
                  (prefix-numeric-value current-prefix-arg)
                  mew-indays-default))))
     (list days nil)))
  (let* ((ofolder (mew-summary-folder-name 'ext))
         (days (or days mew-indays-default))
	 file dfunc opts rttl file-rttl)
    (mew-summary-switch-to-folder (format "*within %d day(s)" days))
    (mew-vinfo-set-mode 'selection)
    (mew-vinfo-set-physical-folder nil)
    (mew-vinfo-set-original-folder ofolder) ; Original folder
    (make-local-variable 'mew-summary-form-mark-delete)
    (setq mew-summary-form-mark-delete nil)
    (make-local-variable 'mew-summary-form-mark-spam)
    (setq mew-summary-form-mark-spam nil)
    (when (mew-summary-exclusive-p)
      (with-temp-buffer
	(mew-set-buffer-multibyte t)
	(mew-piolet mew-cs-text-for-read mew-cs-text-for-write
	  (setq file-rttl (mew-indays-selection days folders)))))
    (mew-set '(file rttl) file-rttl)
    (setq dfunc `(lambda () (mew-delete-file ,file)))
    (setq opts (list "-i" file))
    (mew-local-retrieve 'vir opts dfunc nil nil rttl)))

(defun mew--indays-selection (current-time days path)
  "PATH の中を再帰的に降りて集めた `mbs-mew-message-file-name' から
CURRENT-TIME から DAYS 内のタイムスタンプのファイルの list を \"CD:\" 付で返す.
PATH が atom なら `directory-files' に渡して file の list にし
list ならそのまま file list として処理をする."
  (let* ((files (if (consp path) path (directory-files path t)))
         (all (length files))
         (count all)
         chdir result att temp)
    (message "Scan directory %s..." path)
    (dolist (file files)
      (setq att (file-attributes file))
      (mbs-progress-message all count "Scan directory %s...%d%%" path)
      (cond
       ((null att)
        (message "File can't open %s." file))
       ((and (car att)
             (not (string-match "/\\.\\.?\\'" file))
             (string-equal "drwx" (substring (nth 8 att) 0 4)))
        (setq result (append (mew--indays-selection current-time days file) result)))
       ((string-match mbs-mew-message-file-name file)
        (when (< (- current-time (float-time (sixth att))) (* 86400 days))
          (or chdir
              (setq chdir
                    (cons (concat "CD:" mew-folder-local (mbs-path-to-mew-folder file)) nil)))
          (setq temp (cons (concat (file-name-nondirectory file)) temp)))))
      (setq count (1- count)))
    (setq result (append (mbs-sort temp) chdir result))))

(defun mew-indays-selection (&optional days folders)
  (let* ((path (mbs-split-arg-to-path (or folders mew-folder-local))) ;; "~/Mail" 取得
         (days (or days mew-indays-default))
	 (file (mew-make-temp-name))
         (current-time (float-time))
         (msgs (nreverse (mew--indays-selection current-time days path))))
    (insert (mapconcat #'identity msgs "\n"))
    (mew-frwlet mew-cs-text-for-read mew-cs-text-for-write
      (write-region (point-min) (point-max) file nil 'no-msg))
    (list file (mbs-file-only-length msgs))))

(provide 'mew-indays)
;; fin.