;;; -*- Emacs-Lisp -*- ;;; $Id: irex-list.el,v 3.8 1999/02/02 15:07:11 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-list) (require 'irex-tougou) (require 'irex-input) (require 'irex-auto) ;;; 変数 / 定数の宣言 (defvar irex-list-window-height 10 "*記事リストを表示するウインドウの高さ") (defvar irex-list-docno-alist nil "行番号と記事番号の関係を保持している変数") (defvar irex-list-mode-map nil) ; byte compile 時の warning を回避するために追加 (defvar irex-list-last-judged-docno nil "最後に人手で判定された記事の記事番号") (defconst irex-list-buffer-name "*IR-JUDGE-LIST*" "記事リストを表示するバッファ名") ;;;---------------------------------------------------------------------- ;;; 時間測定関数 ;;;---------------------------------------------------------------------- (defsubst irex-list-start-counter (&optional time clear) "\ irex-list-stop-counter 関数に経過時間測定の開始を通知する関数" (put 'irex-list-stop-counter 'start-time (if clear nil (or time (current-time))))) (defun irex-list-stop-counter () "\ irex-list-start-counter 関数が呼び出された時点からの経過時間を返す関数" (let ((now (current-time)) (start (get 'irex-list-stop-counter 'start-time))) (if start (prog1 (+ (* (- (car now) (car start)) 65536) (nth 1 now) (- (nth 1 start))) (irex-list-start-counter nil t) )))) ;;;---------------------------------------------------------------------- ;;; 記事リストバッファを生成する関数 ;;;---------------------------------------------------------------------- (defsubst irex-list-count-lines () "現在行の行番号を返す関数" (save-excursion (beginning-of-line) (1+ (count-lines (point-min) (point))))) (defun irex-list-make-buffer (&optional e-mode) "\ 記事リストバッファを生成する関数 記事リストバッファとその内容を生成する。 また、各記事の DOCNO と行番号との対応関係を irex-list-docno-alist に記録し、 irex-list-get-docno / irex-list-get-line 関数から参照できるようにする。 " (set-buffer (get-buffer-create irex-list-buffer-name)) (let ((judge-list (if e-mode (if (stringp irex-judge-current-pid) (delete irex-judge-current-pid (irex-tougou-get-all-judge-list)) (irex-tougou-get-all-judge-list)))) (buffer-read-only nil)) (erase-buffer) (setq irex-list-docno-alist nil) ;; バッファの内容を生成する (mapcar '(lambda (docno) (let ((l (irex-list-count-lines))) (setq irex-list-docno-alist (cons (cons docno l) (cons (cons l docno) irex-list-docno-alist))) (insert (format "%4d " l) (if judge-list (concat (mapconcat '(lambda (j) (format "%-2s" (or (irex-tougou-get-judge_info-score docno j) "-"))) judge-list " ") (if (stringp irex-judge-current-pid) " " " ")) " ")) (cond ((stringp irex-judge-current-pid) (overlay-put (make-overlay (point) (progn (insert (format "%-2s" (or (irex-tougou-get-judge_info-score docno irex-judge-current-pid) "-"))) (point))) 'face 'default) (insert " ")) ((stringp irex-judge-current-sid) (overlay-put (make-overlay (+ 3 (point)) (progn (insert (format "%04s %04s" (or (irex-tougou-get-system-rank docno) "-") (or (irex-tougou-get-system-score docno) "-"))) (point))) 'face 'default) (insert " ")) (t (insert " ") (save-excursion (beginning-of-line) (overlay-put (make-overlay (+ 4 (point)) (+ 5 (point))) 'face 'default)))) (insert (format "%s %s\n" (irex-article-get-date docno) (irex-article-get-headline docno))) )) (irex-tougou-get-all-docno-list)) (delete-backward-char 1) ; 最後の改行文字を取り除く (irex-list-goto-last-doc)) (irex-list-mode e-mode)) (defun irex-list-mode (&optional e-mode) "\ irex-judge を操作するための major-mode 簡易ヘルプを参照したい場合は、? を押してください。 \\{irex-list-mode-map} " (interactive "P") (setq major-mode 'irex-list-mode mode-name (if (stringp irex-judge-current-pid) "IR-JUDGE" "IR-BROWSE") mode-line-process (if (stringp irex-judge-current-pid) (format "[%s] PID=%s TOPIC-ID=%s" (if e-mode "E-MODE" "S-MODE") irex-judge-current-pid irex-judge-current-topic_id) (if (stringp irex-judge-current-sid) (format " SID=%s TOPIC-ID=%s" irex-judge-current-sid irex-judge-current-topic_id) (format " TOPIC-ID=%s" irex-judge-current-topic_id))) truncate-lines t ; 右端にはみ出した行は切捨て表示にする irex-list-mode-map (make-keymap)) (suppress-keymap irex-list-mode-map) (define-key irex-list-mode-map "p" 'irex-list-previous-doc) (substitute-key-definition 'previous-line 'irex-list-previous-doc irex-list-mode-map (current-global-map)) (substitute-key-definition 'backward-char 'irex-list-previous-doc irex-list-mode-map (current-global-map)) (define-key irex-list-mode-map "n" 'irex-list-forward-doc) (substitute-key-definition 'next-line 'irex-list-forward-doc irex-list-mode-map (current-global-map)) (substitute-key-definition 'forward-char 'irex-list-forward-doc irex-list-mode-map (current-global-map)) (define-key irex-list-mode-map "g" 'irex-list-goto-specified-doc) (define-key irex-list-mode-map "<" 'irex-list-goto-top-doc) (define-key irex-list-mode-map ">" 'irex-list-goto-bottom-doc) (define-key irex-list-mode-map "." 'irex-list-redisplay) (define-key irex-list-mode-map " " 'irex-list-scroll-up-other-window) (define-key irex-list-mode-map [return] 'irex-list-scroll-up-other-window) (define-key irex-list-mode-map "\C-m" 'irex-list-scroll-up-other-window) (define-key irex-list-mode-map "b" 'irex-list-scroll-down-other-window) (define-key irex-list-mode-map [backspace] 'irex-list-scroll-down-other-window) (define-key irex-list-mode-map [delete] 'irex-list-scroll-down-other-window) (define-key irex-list-mode-map "\C-?" 'irex-list-scroll-down-other-window) (define-key irex-list-mode-map "k" 'irex-input-keyword) (define-key irex-list-mode-map "z" 'irex-list-suspend) (cond ((stringp irex-judge-current-pid) (define-key irex-list-mode-map "P" '(lambda () (interactive) (irex-list-previous-doc t))) (define-key irex-list-mode-map [S-up] '(lambda () (interactive) (irex-list-previous-doc t))) (define-key irex-list-mode-map "N" '(lambda () (interactive) (irex-list-forward-doc t))) (define-key irex-list-mode-map [S-down] '(lambda () (interactive) (irex-list-forward-doc t))) (define-key irex-list-mode-map "l" 'irex-list-goto-last-doc) (define-key irex-list-mode-map "s" 'irex-list-swap-position) (define-key irex-list-mode-map [right] 'irex-list-swap-position) (define-key irex-list-mode-map [left] 'irex-list-swap-position) (define-key irex-list-mode-map "c" 'irex-input-comment) (define-key irex-list-mode-map "S" 'irex-list-save-buffer) (define-key irex-list-mode-map "\C-x\C-s" 'irex-list-save-buffer) (define-key irex-list-mode-map "q" 'irex-judge-exit) (cond (e-mode (define-key irex-list-mode-map "?" 'irex-list-help-for-e-mode) (define-key irex-list-mode-map "a" 'irex-auto-judge-input) (define-key irex-list-mode-map "1" '(lambda () (interactive) (irex-list-score-with-skip "A"))) (define-key irex-list-mode-map "2" '(lambda () (interactive) (irex-list-score-with-skip "B"))) (define-key irex-list-mode-map "3" '(lambda () (interactive) (irex-list-score-with-skip "C"))) (define-key irex-list-mode-map "7" '(lambda () (interactive) (irex-list-score-without-skip "A"))) (define-key irex-list-mode-map "8" '(lambda () (interactive) (irex-list-score-without-skip "B"))) (define-key irex-list-mode-map "9" '(lambda () (interactive) (irex-list-score-without-skip "C")))) (t ;; s-mode (define-key irex-list-mode-map "?" 'irex-list-help-for-s-mode) (define-key irex-list-mode-map "1" '(lambda () (interactive) (irex-list-score-with-auto-skip "A"))) (define-key irex-list-mode-map "2" '(lambda () (interactive) (irex-list-score-with-auto-skip "B"))) (define-key irex-list-mode-map "3" '(lambda () (interactive) (irex-list-score-with-auto-skip "C"))) (define-key irex-list-mode-map "4" '(lambda () (interactive) (irex-list-score-with-auto-skip "A?"))) (define-key irex-list-mode-map "5" '(lambda () (interactive) (irex-list-score-with-auto-skip "B?"))) (define-key irex-list-mode-map "6" '(lambda () (interactive) (irex-list-score-with-auto-skip "C?")))))) (t (define-key irex-list-mode-map "?" 'irex-list-help-for-browse) (define-key irex-list-mode-map "q" 'irex-browse-exit))) (use-local-map irex-list-mode-map) (run-hooks 'irex-list-mode-hook) (setq buffer-read-only t) (set-buffer-modified-p nil)) (defun irex-list-exit () (and (get-buffer irex-list-buffer-name) (kill-buffer irex-list-buffer-name)) (setq irex-list-docno-alist nil irex-list-last-judged-docno nil) (irex-input-exit) (irex-auto-exit)) (defun irex-list-suspend () "判定作業を中断するコマンド" (interactive) (let ((sec (irex-list-stop-counter))) (save-excursion (save-window-excursion (save-restriction (delete-other-windows) (narrow-to-region (point) (point)) (message "再開する時は適当なキーを押して下さい") (read-event) (irex-list-start-counter (let* ((now (current-time)) (low (- (nth 1 now) (or sec 0)))) (if (< low 0) (list (1- (car now)) ; 繰り下がりがある場合の処理 (+ low 65536) (nth 2 now)) (list (car now) low (nth 2 now))))) ))))) ;;;---------------------------------------------------------------------- ;;; ヘルプを表示するコマンド ;;;---------------------------------------------------------------------- (defsubst irex-list-show-help (title body) "\ 指定された文字列を *Help* バッファに挿入して表示する関数" (with-output-to-temp-buffer "*Help*" (princ (concat title "\n\n\nこれは " (if (stringp irex-judge-current-pid) "irex-judge" "irex-browse") " を実行中に利用できるコマンドについてのヘルプです。 以下に列挙したキーを利用して閲覧して下さい。 key binding --- ------- SPC ヘルプ画面をスクロールアップする b ヘルプ画面をスクロールダウンする . (ピリオド) ヘルプ画面を閉じ、irex-judge に戻る " body)) (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode) (help-mode)))) (message "ヘルプを見終ったら . (ピリオド)を押して下さい。")) (defun irex-list-help-for-s-mode () (interactive) (irex-list-show-help "IREX JUDGE HELP (S-MODE)" "\ irex-judge 実行中は以下に列挙したキーが利用できます。 (これらのキーはヘルプ画面を表示中も利用できます。) key binding --- ------- 1 記事の関連性を A と判定する (判定済みの記事は飛ばして移動) 2 B と判定する 3 C と判定する 4 A? と判定する 5 B? と判定する 6 C? と判定する n 次の記事に進む (閲覧中の記事の関連性の程度は変更しない) N 次の未判定の記事に進む p 前の記事に戻る P 前の未判定の記事に戻る l まだ判定していない記事に移動 g 指定された行に移動 s 最後に判定された記事に移動 > 最後の記事に移動 < 最初の記事に移動 ? ヘルプを表示 c コメントを入力 k 強調表示したい単語を入力 SPC 記事表示画面をスクロールアップする b 記事表示画面をスクロールダウンする . (ピリオド) 強制的に画面を再描画する z 判定作業を中断する q 判定作業を終了する ")) (defun irex-list-help-for-e-mode () (interactive) (irex-list-show-help "IREX JUDGE HELP (E-MODE)" (concat "\ irex-judge 実行中は以下に列挙したキーが利用できます。 (これらのキーはヘルプ画面を表示中も利用できます。) key binding --- ------- 1 記事の関連性を A と判定する (判定済みの記事は飛ばして移動) 2 B と判定する 3 C と判定する 7 A と判定する (必ず次の記事に移動) 8 B と判定する 9 C と判定する n 次の記事に進む (閲覧中の記事の関連性の程度は変更しない) N 次の未判定の記事に進む p 前の記事に戻る P 前の未判定の記事に戻る l まだ判定していない記事に移動 g 指定された行に移動 s 最後に判定された記事に移動 > 最後の記事に移動 < 最初の記事に移動 ? ヘルプを表示 a 自動判定用 S 式を入力 c コメントを入力 k 強調表示したい単語を入力 SPC 記事表示画面をスクロールアップする b 記事表示画面をスクロールダウンする . (ピリオド) 強制的に画面を再描画する z 判定作業を中断する q 判定作業を終了する " (let ((l (delete irex-judge-current-pid (irex-tougou-get-all-judge-list))) (i 0)) (if l (concat "同時に表示されている他の判定者の資格は左から順に次のようになっています。\n\n" (mapconcat '(lambda (pid) (format " J%-2d : %s" (setq i (1+ i)) (cond ((string-match "^1" pid) "Student judge") ((string-match "^2" pid) "Executive judge") ((string-match "^9" pid) "God's judge") (t "Undefined")) )) l "\n") "\n\n") "このファイルは他の判定者によって判定されていません。\n\n"))))) (defun irex-list-help-for-browse () (interactive) (irex-list-show-help "IREX BROWSE HELP" (concat "\ irex-browse 実行中は以下に列挙したキーが利用できます。 (これらのキーはヘルプ画面を表示中も利用できます。) key binding --- ------- n 次の記事に進む (閲覧中の記事の関連性の程度は変更しない) p 前の記事に戻る g 指定された行に移動 > 最後の記事に移動 < 最初の記事に移動 ? ヘルプを表示 k 強調表示したい単語を入力 SPC 記事表示画面をスクロールアップする b 記事表示画面をスクロールダウンする . (ピリオド) 強制的に画面を再描画する z 閲覧を中断する q 閲覧を終了する " (let ((l (irex-tougou-get-all-judge-list)) (i 0)) (if l (concat "同時に表示されている判定者の資格は左から順に次のようになっています。\n\n" (mapconcat '(lambda (pid) (format " J%-2d : %s" (setq i (1+ i)) (cond ((string-match "^1" pid) "Student judge") ((string-match "^2" pid) "Executive judge") ((string-match "^9" pid) "God's judge") (t "Undefined")) )) l "\n") "\n\n") "このファイルは判定者によって判定されていません。\n\n"))))) ;;;---------------------------------------------------------------------- ;;; 他のウインドウを scroll up/down するコマンド ;;;---------------------------------------------------------------------- (defun irex-list-scroll-up-other-window () "他のウインドウを scroll-up するコマンド" (interactive) (let ((w (selected-window))) (set-buffer (window-buffer (select-window (if (one-window-p t 1) (irex-judge-split-window) (next-window nil 1 1))))) (goto-char (window-start)) (forward-line (min (- (window-height) 2) (count-lines (window-end) (point-max)))) (set-window-start (selected-window) (point)) (select-window w) )) (defun irex-list-scroll-down-other-window () "他のウインドウを scroll-down するコマンド" (interactive) (let ((w (selected-window))) (set-buffer (window-buffer (select-window (if (one-window-p t 1) (irex-judge-split-window) (next-window nil 1 1))))) (goto-char (window-start)) (forward-line (- 2 (window-height))) (set-window-start (selected-window) (point)) (select-window w) )) ;;;---------------------------------------------------------------------- ;;; 記事リストバッファ内を移動するコマンド ;;;---------------------------------------------------------------------- (defsubst irex-list-move-cursor () "記事リストバッファのカーソルを適切な位置に移動する関数" (beginning-of-line) (goto-char (next-overlay-change (point)))) (defsubst irex-list-redisplay () "画面を再描画するコマンド" (interactive) (irex-list-move-cursor) (irex-article-show-text (irex-list-get-docno))) (defun irex-list-forward-doc (&optional skip) "\ 次の記事に進むコマンド SKIP に nil 以外が指定されていた場合は、既に判定済みの記事を飛ばして、 判定されていない記事まで移動する。 " (interactive "P") (forward-line 1) (if skip (while (and (irex-tougou-get-judge_info-score (irex-list-get-docno) irex-judge-current-pid) (= 0 (forward-line 1))))) (irex-list-redisplay) (irex-list-start-counter)) (defun irex-list-previous-doc (&optional skip) "\ 前の記事に戻るコマンド SKIP に nil 以外が指定されていた場合は、既に判定済みの記事を飛ばして、 判定されていない記事まで移動する。 " (interactive "P") (forward-line -1) (if skip (while (and (irex-tougou-get-judge_info-score (irex-list-get-docno) irex-judge-current-pid) (= 0 (forward-line -1))))) (irex-list-redisplay) (irex-list-start-counter)) (defun irex-list-goto-specified-doc (line) "指定された記事に移動するコマンド" (interactive "n行番号を入力して下さい: ") (goto-line line) (irex-list-redisplay) (irex-list-start-counter)) (defun irex-list-goto-top-doc () "最初の記事に移動するコマンド" (interactive) (goto-char (point-min)) (irex-list-redisplay) (irex-list-start-counter)) (defun irex-list-goto-bottom-doc () "最後の記事に移動するコマンド" (interactive) (goto-char (point-max)) (irex-list-redisplay) (irex-list-start-counter)) (defun irex-list-goto-last-doc () "判定されていない最初の記事に行くコマンド" (interactive) (goto-char (point-min)) (while (and (irex-tougou-get-judge_info-score (irex-list-get-docno) irex-judge-current-pid) (= 0 (forward-line 1)))) (irex-list-redisplay) (irex-list-start-counter)) (defun irex-list-swap-position () "irex-list-last-judged-docno に記録されている記事に移動するコマンド" (interactive) (let ((docno (irex-list-get-docno))) (irex-list-goto-specified-doc (irex-list-get-line irex-list-last-judged-docno)) (setq irex-list-last-judged-docno docno) )) ;;;---------------------------------------------------------------------- ;;; 記事の関連性を判定する関数 ;;;---------------------------------------------------------------------- (defsubst irex-list-get-docno (&optional line) "指定された行の記事番号を得る関数" (or line (setq line (irex-list-count-lines))) (and (integerp line) (or (cdr (assoc line irex-list-docno-alist)) (error "%s" "指定された行に対応する記事番号が取得できません")))) (defsubst irex-list-get-line (docno) "記事番号に対応する行を得る関数" (or (and (stringp docno) (cdr (assoc docno irex-list-docno-alist))) (error "%s" "指定された記事に対応する行番号が取得できません"))) (defun irex-list-change-score (docno score) "\ 指定された記事の SCORE を変更する関数 DOCNO に nil を指定した場合は、current の記事を対象とする。該当記事が判 定された回数を返す。最初の判定の場合 1 を返す。自動判定の場合( DOCNO が 指定されている場合 )は、0 を返す。ただし、該当記事が既に current の審判 によって判定済みの場合は何もせずに nil を返す。 審判に関する情報が A などのように、TIME==0 and REPEAT==0 の状態となっていることが、その記事が 自動判定によって判定されたことを表す。ただし、TIME==0 は人手による判定の 場合にもあり得る( 1秒以内に判定した場合 )。よって、REPEAT==0 がその記事 の判定が自動判定によって行なわれたか調べる論理式となる。人手による判定の 場合は、必ず REPEAT>0 となる。 " (save-excursion (set-buffer (get-buffer irex-list-buffer-name)) (let ((buffer-read-only nil) (automatic-mode docno)) (if docno (goto-line (irex-list-get-line docno)) (setq docno (irex-list-get-docno))) (if (and automatic-mode (/= 0 (irex-tougou-get-judge_info-repeat docno))) nil (prog1 (irex-tougou-write-judge_info docno score (if automatic-mode nil (irex-list-stop-counter))) (irex-list-move-cursor) (insert (format "%-2s" score)) (delete-region (point) (next-overlay-change (point))) (or automatic-mode (setq irex-list-last-judged-docno docno)) ))))) (defsubst irex-list-score-with-auto-skip (score) (irex-list-forward-doc (= 1 (irex-list-change-score nil score)))) (defsubst irex-list-score-with-skip (score) (irex-list-change-score nil score) (irex-list-forward-doc t)) (defsubst irex-list-score-without-skip (score) (irex-list-change-score nil score) (irex-list-forward-doc)) (defun irex-list-save-buffer () "判定中の IREX 結果統合ファイルをセーブする" (interactive) (save-excursion (set-buffer irex-judge-buffer) (save-buffer)))