;;; my-navi2ch-article-message-filters.el
;;; --- Message filter functions for Navi2ch article mode

;; Author: extra <ekisutora@users.sourceforge.net>
;; Keywords: network, 2ch, Navi2ch

;; This file 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 2, or (at your option)
;; any later version.

;; This file 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(provide 'my-navi2ch-article-message-filters)

(eval-when-compile (require 'cl))

(require 'navi2ch-vars)
(require 'navi2ch-util)
(require 'navi2ch-article)

(defvar my-navi2ch-article-message-filters
  '(my-navi2ch-article-message-hide-ditto
    my-navi2ch-article-message-hide-number-get
    my-navi2ch-article-message-hide-blank
    my-navi2ch-article-message-hide-aborn))

(defvar my-navi2ch-article-message-filters-work-buffer-name
  " *My Navi2ch article message filters work*")

(dolist (func (reverse my-navi2ch-article-message-filters))
  (unless (memq func navi2ch-article-message-filter-list)
    (setq navi2ch-article-message-filter-list
	  (cons func navi2ch-article-message-filter-list))))

(defsubst my-navi2ch-different-members (list1 list2)
  (let ((diff1 (mapcar #'identity list1))
	(diff2 (mapcar #'identity list2)))
    (let ((list list2)
	  rest)
      (while (and list
		  (or (car rest)
		      (car (setq rest diff1))))
	(if (equal (car list) (car rest))
	    (progn
	      (setcar rest (cadr rest))
	      (setcdr rest (cddr rest))
	      (setq list (cdr list)))
	  (setq rest (cdr rest))
	  (unless (car rest)
	    (setq list (cdr list)))))
      (setq diff1 (delq nil diff1)))
    (let ((list list1)
	  rest)
      (while (and list
		  (or (car rest)
		      (car (setq rest diff2))))
	(if (equal (car list) (car rest))
	    (progn
	      (setcar rest (cadr rest))
	      (setcdr rest (cddr rest))
	      (setq list (cdr list)))
	  (setq rest (cdr rest))
	  (unless (car rest)
	    (setq list (cdr list)))))
      (setq diff2 (delq nil diff2)))
    (list diff1 diff2)))

(defun my-navi2ch-article-message-hide-ditto (alist)
  "二重カキコや連続コピペされたレスを隠す。"
  (let ((prev-alist (navi2ch-article-get-message
		     (1- (cdr (assq 'number alist))))))
    (when (stringp prev-alist)
      (setq prev-alist (navi2ch-article-parse-message prev-alist)))
    (when (and prev-alist
	       (string= (cdr (assq 'name alist))
			(cdr (assq 'name prev-alist)))
	       (string= (cdr (assq 'mail alist))
			(cdr (assq 'mail prev-alist))))
      (let* ((words (delete "" (split-string (cdr (assq 'data alist))
					     "\\(\\W\\|　\\)+\\|\\b")))
	     (prev-words (delete "" (split-string (cdr (assq 'data prev-alist))
						  "\\(\\W\\|　\\)+\\|\\b")))
	     (diff (my-navi2ch-different-members words prev-words)))
	;; レス本文の相違率
	(when (< (/ (+ (if words
			   (/ (float (length (car diff)))
			      (float (length words)))
			 1.0)
		       (if prev-words
			   (/ (float (length (cadr diff)))
			      (float (length prev-words)))
			 1.0))
		    2.0)
		 0.1)		       ; 1割未満しか違わないレスが対象
	  'hide)))))

(defvar my-navi2ch-article-message-hide-number-get-list
  '(2 3 4 5 6 7 8 9 10 100 200 300 400 500 600 700 777 800 900)
  "*ゲットを監視するレス番号のリスト。")

(defun my-navi2ch-int-to-regexp (int)
  (let* ((digits (truncate (abs int)))
	 (regexp (string ?[ (+ (% digits 10) ?0) (+ (% digits 10) ?０) ?])))
    (while (plusp (setq digits (/ digits 10)))
      (setq regexp
	    (concat (string ?[ (+ (% digits 10) ?0) (+ (% digits 10) ?０) ?])
		    regexp)))
    (when (minusp int)
      (setq regexp (concat "[-−]" regexp)))
    regexp))

(defun my-navi2ch-article-message-hide-number-get (alist)
  "レス番号をゲットされたレスを隠す。
ゲットを監視する対象となるレスは、
`my-navi2ch-article-message-hide-number-get-list'で指定する。"
  (let ((num (cdr (assq 'number alist))))
    (when (memq num my-navi2ch-article-message-hide-number-get-list)
      (let ((body (cdr (assq 'data alist))))
	(when (and (string-match (concat "\\([^0-9０-９]\\|^\\)"
					 (my-navi2ch-int-to-regexp num)
					 "\\([^0-9０-９]\\|$\\)")
				 body)
		   ;; レス本文の行数
		   (<= (length (delete "" (split-string body "^")))
		       1))		; 1行以下のレスが対象
	  'hide)))))

(defun my-navi2ch-article-message-hide-blank (alist)
  "空レスを隠す。"
  (with-current-buffer
      (get-buffer-create my-navi2ch-article-message-filters-work-buffer-name)
    (catch 'break
      ;; 本文が空か
      (erase-buffer)
      (insert (cdr (assq 'data alist)))
      (goto-char (point-min))
      (while (looking-at "\\(\\W\\|　\\)+")
	(goto-char (match-end 0)))
      (unless (eobp)
	(throw 'break nil))
      ;; メール欄が空か(sageのみ含む)
      (erase-buffer)
      (insert (cdr (assq 'mail alist)))
      (goto-char (point-min))
      (while (looking-at "\\(\\W\\|　\\)+\\|sage")
	(goto-char (match-end 0)))
      (unless (eobp)
	(throw 'break nil))
      ;; 上記すべて空なら隠す
      'hide)))

(defun my-navi2ch-article-message-hide-aborn (alist)
  "「あぼーん」されたレスを隠す。"
  (when (string= "あぼーん" (cdr (assq 'date alist)))
    'hide))

;;; my-navi2ch-article-message-filters.el ends here