;;; -*- Emacs-Lisp -*-
;;; $Id: irex-article.el,v 3.1 1999/01/29 19:12:38 tsuchiya Exp $

;; This file is part of IREX tools.

;; Please refer "Copyright file" at the root directory.
;; (C) IREX committee IREX実行委員会. All rights reserved.  


;;; 依存関係の宣言
(provide 'irex-article)
(require 'irex-judge)
(require 'irex-mainichi)
(require 'irex-tougou)


;;; 定数 / 変数の宣言
(defconst irex-article-buffer-name "*IR-JUDGE-ARTICLE*"
  "記事内容を表示するバッファ名")

(defvar irex-article-fill-column (min 80 (- (frame-width) 4)) "*記事本文を整形する幅")

(defvar irex-article-formated-docno-list nil "*整形済みの記事番号のリスト")

(defvar irex-article-highlight-style 'hilight "*強調表示する単語の face の style")

(defvar irex-article-highlight-color "Blue" "*強調表示する単語の face の color")

(defvar irex-article-kinsoku-bol-list
  (funcall (if (fboundp 'string-to-char-list)
	       'string-to-char-list
	     'string-to-list)
	   "!)-_~}]:;',.?、。，．・：；？！゛゜´｀¨＾￣＿ヽヾゝゞ〃仝々〆〇ー―‐／＼〜‖｜…‥’”）〕］｝〉》」』】°′″℃ぁぃぅぇぉっゃゅょゎァィゥェォッャュョヮヵヶ")
  "行頭禁則文字のリスト")

(defvar irex-article-kinsoku-eol-list
  (funcall (if (fboundp 'string-to-char-list)
	       'string-to-char-list
	     'string-to-list)
	   "({[`‘“（〔［｛〈《「『【°′″§")
  "行末禁則文字のリスト")




;;;----------------------------------------------------------------------
;;;	記事内容を表示するバッファを生成する関数
;;;----------------------------------------------------------------------

(defun irex-article-make-buffer ()
  "記事内容バッファを生成する関数"
  (save-excursion
    (set-buffer (get-buffer-create irex-article-buffer-name))
    (setq buffer-read-only nil)
    (irex-mainichi-retrieval-articles (irex-tougou-get-all-docno-list))
    ;; 各記事の本文の先頭に DOCNO と表題を追加
    (message "各記事の本文を準備しています...")
    (mapcar
     '(lambda (docno)
	(let ((start (car (irex-mainichi-get-text-region docno))))
	  (if start
	      (progn
		(goto-char start)
		(insert (format "DOCNO : %s\n表題  : %s\n\n" docno (irex-mainichi-get-headline docno)))
		))))
     (irex-tougou-get-all-docno-list))
    (message "")
    (irex-article-mode)))


(define-derived-mode irex-article-mode fundamental-mode "IR-JUDGE ARTICLE"
  (setq buffer-read-only t)
  (set-buffer-modified-p nil))


(defun irex-article-exit ()
  (and (get-buffer irex-article-buffer-name)
       (kill-buffer irex-article-buffer-name))
  (setq irex-article-formated-docno-list nil)
  (irex-mainichi-exit))




;;;----------------------------------------------------------------------
;;;	記事の諸元を得るための関数
;;;----------------------------------------------------------------------

(defalias 'irex-article-get-date 'irex-mainichi-get-date)

(defalias 'irex-article-get-headline 'irex-mainichi-get-headline)




;;;----------------------------------------------------------------------
;;;	記事を表示する関数
;;;----------------------------------------------------------------------

(defun irex-article-fill-line ()
  "現在行を整形する関数"
  (beginning-of-line)
  (let ((top (point)) chr)
    (while (if (>= (move-to-column fill-column) fill-column)
	       (not (progn
		      (if (memq (preceding-char) irex-article-kinsoku-eol-list)
			  (progn
			    (backward-char)
			    (while (memq (preceding-char) irex-article-kinsoku-eol-list)
			      (backward-char))
			    (insert "\n"))
			(while (memq (setq chr (following-char)) irex-article-kinsoku-bol-list)
			  (forward-char))
			(if (looking-at "\\s-+")
			    (or (eolp) (delete-region (point) (match-end 0)))
			  (or (> (char-width chr) 1)
			      (re-search-backward "\\<" top t)
			      (end-of-line)))
			(or (eolp) (insert "\n"))))))
      (setq top (point))))
  (forward-char)
  (not (eobp)))


(defsubst irex-article-format-text (docno) "\
記事本文を読み易いように整形する関数"
  (or (member docno irex-article-formated-docno-list)
      (let* ((fill-column irex-article-fill-column)
	     (buffer-read-only nil))
	(message "本文を整形中です...")
	(goto-char (point-min))
	(forward-line 4)
	(while (irex-article-fill-line)
	  (insert "\n"))
	(insert "\n")
	(set-buffer-modified-p nil)
	(setq irex-article-formated-docno-list
	      (cons docno irex-article-formated-docno-list))
	(message "")
	)))


(defun irex-article-show-text (docno)
  "指定された記事の本文を表示する関数"
  (save-excursion
    (let ((c (irex-mainichi-get-text-region docno)))
      (cond
       (c
	(set-buffer (marker-buffer (car c)))
	(widen)
	(narrow-to-region (car c) (cdr c))
	(irex-article-format-text docno)
	(set-window-start (or (get-buffer-window (current-buffer))
			      (irex-judge-split-window))
			  (car c))
	)))))




;;;----------------------------------------------------------------------
;;;	指定された単語を強調表示する関数
;;;----------------------------------------------------------------------

;; face の設定
(make-face 'irex-article-highlight-face)
(and (facep irex-article-highlight-style)
     (copy-face irex-article-highlight-style 'irex-article-highlight-face))
(and window-system
     irex-article-highlight-color
     (set-face-foreground 'irex-article-highlight-face irex-article-highlight-color))


(defun irex-article-highlight-word (word-list) "\
指定されたリストの単語を全て強調表示する関数
実際に強調表示された単語の数を返す"
  (save-excursion
    (set-buffer (get-buffer irex-article-buffer-name))
    (let ((i 0))
      (save-restriction
	(widen)
	;; 現時点の強調表示を全て解除する
	(message "必要なくなった強調表示を解除しています ...")
	(let ((p (point-min))
	      (point-max (point-max)))
	  (while (progn
		   (setq p (next-overlay-change p))
		   (not (= p point-max)))
	    (mapcar
	     '(lambda (o) (delete-overlay o))
	     (overlays-at p))
	    ))
	;; 全ての単語を強調表示する
	(message "強調表示する単語を検索しています ...")
	(mapcar
	 '(lambda (w)
	    (goto-char (point-min))
	    (while (search-forward w nil t)
	      (setq i (1+ i))
	      (overlay-put (make-overlay (match-beginning 0) (match-end 0))
			   'face 'irex-article-highlight-face)
	      ))
	 word-list))
      i)))