;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;*****************************************************************************
;;;;FILE: pjb-vm-kill-file.el
;;;;LANGUAGE: emacs lisp
;;;;SYSTEM: emacs
;;;;USER-INTERFACE: emacs
;;;;DESCRIPTION
;;;;
;;;; A kill file feature for vm.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;; 2002-11-10 <PJB> Converted from pjb-rmail-kill-file.
;;;;
;;;;BUGS
;;;;LEGAL
;;;; LGPL
;;;;
;;;; Copyright Pascal J. Bourguignon 2002 - 2011
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;;;
;;;;*****************************************************************************
(require 'cl)
(require 'pjb-cl)
(require 'pjb-strings)
(when (require 'vm nil t)
(defvar pjb-vm-killed-ip-list nil
"List of IP to kill from Received:.")
(defvar pjb-vm-killed-ip-regexp nil
"deduced form pjb-vm-killed-ip-list.
String regexp matching IPs to be killed from Received:.")
(defvar pjb-vm-kill-file "~/.emacs-kill-file"
"The path to the kill file.")
(defun pjb-vm-kill-address (ip)
"
DO: Add ip to the `pjb-vm-killed-ip-list'.
"
(unless pjb-vm-killed-ip-list
(load pjb-vm-kill-file t t))
(unless (member ip pjb-vm-killed-ip-list)
(setq pjb-vm-killed-ip-regexp nil)
(push ip pjb-vm-killed-ip-list)
(find-file pjb-vm-kill-file)
(erase-buffer)
(insert (format "(setq pjb-vm-killed-ip-list \n'%S)\n"
pjb-vm-killed-ip-list))
(save-buffer 0)
(kill-buffer (current-buffer))))
(defun pjb-vm-kill-add-this-address (beg end)
"
DO: Add the selected IP address to the `pjb-vm-killed-ip-list'.
"
(interactive "r")
(let ((selection (buffer-substring-no-properties beg end)))
(unless (or (string-match "\\[\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)\\]"
selection)
(string-match "(\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\))"
selection)
(string-match "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)"
selection))
(error "Please select an IP address first."))
(pjb-vm-kill-address (match-string 1 selection))))
(defun pjb-vm-kill-ip-regexp ()
"
DO: Build a regexp with all the IP from pjb-vm-killed-ip-list.
RETURN: A regexp string.
"
(if pjb-vm-killed-ip-regexp
pjb-vm-killed-ip-regexp
(setq pjb-vm-killed-ip-regexp
(concat
"[[(]\\("
(unsplit-string (mapcar (lambda (ip)
(regexp-quote (format "%s" ip)))
pjb-vm-killed-ip-list)
"\\|")
"\\)\\."))))
(defmacro message-cond (condition)
`(let ((result ,condition))
(if result
(message "%S is TRUE." (quote ,condition)))
result))
(defun pjb-vm-kill-file ()
"
PRE: The current buffer is narrowed to one new message.
POST: If the message match our \"kill-file\", then it is marked deleted.
"
;; (message "pjb-vm-kill-file message %S" message)
(save-restriction
(let ((msg-min (point-min))
(msg-max (point-max))
)
(goto-char msg-min)
(narrow-to-region msg-min (search-forward "\n\n"))
(when
(or
(let ((value (mail-fetch-field "From")))
(message "*** from=%S match ark=%S" value (string-match "<arkresearch@hotmail.com>" value))
(when value
(or
(message-cond (string-match "<onthecuttingedge2005@yahoo.com>" value))
(message-cond (string-match "<arkresearch@hotmail.com>" value))
(message-cond (string-match "evaluemail.com" value))
(message-cond (string-match "e-valuemail.com" value))
(message-cond (string-match "\\.kr>" value))
)))
(let ((value (mail-fetch-field "Message-Id")))
(message "*** message-id=%S" value)
(when value
(message-cond (string-match "\\.kr>" value)) ))
(let ((value (mail-fetch-field "Subject")))
(message "*** subject=%S" value)
(when value
(or
(message-cond (string-match "Credit Repair\\|$$$" value))
(message-cond (string-match "=?big5?" value))
(message-cond (string-match "=?euc-kr?" value))
(message-cond (string-match "(±¤°í)" value))
)))
(let ((value (mail-fetch-field "Received" nil t)))
(message "*** received=%S" value)
(when value
(message-cond (string-match " hanmail.net \\|localhost.com" value))
(message-cond (string-match (pjb-vm-kill-ip-regexp) value)) ))
(let ((value (mail-fetch-field "Content-Type")))
(message "*** content-type=%S" value)
(when value
(or (message-cond (string-match "charset=\"?ks_c_5601-1987" value))
(message-cond (string-match "charset=\"?euc-kr" value))
(message-cond (string-match "charset=\"?ISO-2022-KR" value))
)
) ;;when
) ;;let
(progn
(goto-char (point-min))
(if (search-forward "informatimago.com" nil t)
(progn
(goto-char (point-min))
(not (re-search-forward "\\<pjb@informatimago.com\\>" nil t)))
nil)) ;;progn
) ;;or
;;(message "*** kf-4 killing %S" message)
(vm-delete-message 1)
;; (run-hooks 'rmail-delete-message-hook)
))))
(defun pjb-vm-kill-subject-regexp (regexp)
"Delete all messages whose subject matches regexp
"
(interactive "sRegexp: ")
(vm-follow-summary-cursor)
(vm-select-folder-buffer)
(vm-check-for-killed-summary)
(vm-error-if-folder-read-only)
(vm-error-if-folder-empty)
(let ((mp vm-message-list)
(n 0)
(case-fold-search t))
(while mp
(if (and (not (vm-deleted-flag (car mp)))
(string-match regexp (vm-so-sortable-subject (car mp))))
(progn
(vm-set-deleted-flag (car mp) t)
(vm-increment n)))
(setq mp (cdr mp)))
(and (interactive-p)
(if (zerop n)
(message "No messages deleted.")
(message "%d message%s deleted" n (if (= n 1) "" "s")))))
(vm-display nil nil '(vm-kill-subject) '(vm-kill-subject))
(vm-update-summary-and-mode-line))
;;(add-hook 'vm-arrived-message-hook 'pjb-vm-kill-file)
;;(add-hook 'vm-arrived-message-hook
;; (lambda () (pjb-vm-kill-subject-regexp "\\[SPAM\\]")))
);; when require
(provide 'pjb-vm-kill-file)
;;;; THE END ;;;;