;;;
;;; $Id: tm-evs.el,v 2.0 1995/06/10 19:33:26 morioka Exp $
;;;
;;; a tm-view internal method
;;;	for JAIST-Course-Evaluation questionnaire
;;;

(require 'tm-view)

(defvar questionnaire-result-alist nil)

(defun mime-viewer/filter-questionnaire (ctype params &optional encoding)
  (goto-char (point-min))
  (while (re-search-forward "^(" nil t)
    (replace-match "  (")
    ))

(set-alist 'mime-viewer/content-filter-alist
	   "application/x-selection"
	   (function mime-viewer/filter-questionnaire))

(defun mime-preview/reset-mark (cnum)
  (let* ((cinfo (mime::preview-content-info/content-info
		 (car mime::preview/content-list)))
	 (ccinfo (mime-article/cnum-to-cinfo cnum cinfo))
	 (pcinfo (mime-preview/cinfo-to-pcinfo ccinfo))
	 (p (mime::preview-content-info/point-min pcinfo))
	 )
    (save-excursion
      (let (buffer-read-only)
	(goto-char p)
	(delete-char 1)
	(insert " ")
	))))

(defun mime-preview/set-mark (cnum)
  (let* ((cinfo (mime::preview-content-info/content-info
		 (car mime::preview/content-list)))
	 (ccinfo (mime-article/cnum-to-cinfo cnum cinfo))
	 (pcinfo (mime-preview/cinfo-to-pcinfo ccinfo))
	 (p (mime::preview-content-info/point-min pcinfo))
	 )
    (save-excursion
      (let (buffer-read-only)
	(goto-char p)
	(delete-char 1)
	(insert "*")
	))))

(defun mime-viewer/questionnaire-select (beg end cal)
  (let* ((cnum (mime::get-point-content-number beg))
	 (rcinfo mime::article/content-info)
	 (mother-cnum (butlast cnum))
	 (mother-cinfo (mime-article/cnum-to-cinfo mother-cnum))
	 (mother-params (mime::content-info/parameters mother-cinfo))
	 (number (assoc-value "x-part-number" mother-params))
	 )
    (if number
	(setq number (string-to-int number))
      )
    (save-window-excursion
      (switch-to-buffer mime::article/preview-buffer)
      (let ((pa (assoc number questionnaire-result-alist)))
	(if pa
	    (progn
	      (setq pa (nth 1 pa))
	      (mime-preview/reset-mark (list (car cnum) pa))
	      )))
      (mime-preview/set-mark cnum)
      )
    (set-alist 'questionnaire-result-alist
	       number
	       (list (nth 1 cnum)
		     (save-restriction
		       (narrow-to-region
			(mime::content-info/point-min mother-cinfo)
			(mime::content-info/point-max mother-cinfo))
		       (message/get-field-body "Content-Description")
		       )))
    (let ((nc (append (butlast mother-cnum)
		      (list (1+ (last-element mother-cnum)) 0)))
	  (the-buf (current-buffer))
	  next-cinfo)
      (setq next-cinfo (mime-article/cnum-to-cinfo nc))
      (setq mime-preview/after-decoded-position
	    (save-window-excursion
	      (if next-cinfo
		  (progn
		    (switch-to-buffer mime::article/preview-buffer)
		    (mime::preview-content-info/point-min
		     (mime-preview/cinfo-to-pcinfo next-cinfo))
		    )
		(point-max)
		)))
      )))

(set-atype 'mime/content-decoding-condition
	   '((type . "application/x-selection")
	     (method . mime-viewer/questionnaire-select)
	     ))

(defvar evs-course-id nil)
(defvar evs-teachers-name nil)
(defvar evs-message-buffer nil)

(defun jaist-evs-send-message ()
  (interactive)
  (if (not (equal (sort (mapcar (function car) questionnaire-result-alist)
			(function <))
		  '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
		      21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38)))
      (message "全ての選択肢に答えて下さい")
    (mail nil "evs-answer@jaist.ac.jp")
    (goto-char (point-max))
    (let ((rest (sort questionnaire-result-alist
		      (function
		       (lambda (a b)
			 (< (car a)(car b))
			 ))))
	  ret)
      (insert (format "%s %s \n" evs-course-id evs-teachers-name))
      (while rest
	(setq ret (car rest))
	(insert (format "[%d]    %s\n    %d\n"
			(car ret)
			(or (nth 2 ret) "")
			(or (nth 1 ret) 0)
			))
	(setq rest (cdr rest))
	)
      (insert "[39]  この授業の良い点、欠けた点を挙げて下さい。\n\n\n")
      (insert "[40]  この授業の担当教官の教え方の良い点、欠けた点を指摘して下さい。\n\n\n")
      (insert "[41]  君はこの授業を受けて、プラスとなったものは何でしょうか？\n")
      (if evs-message-buffer
	  (progn
	    (switch-to-buffer evs-message-buffer)
	    (if mime::article/preview-buffer
		(kill-buffer mime::article/preview-buffer)
	      )
	    (kill-buffer evs-message-buffer)
	    ))
      )))

(define-key mime/viewer-mode-map "\C-c\C-c" (function jaist-evs-send-message))

(defun jaist-evs ()
  (interactive)
  (setq questionnaire-result-alist nil)
  (setq evs-course-id
	(read-string "Please input course id > "))
  (setq evs-teachers-name
	(read-string "Please input teacher's name > "))
  (setq evs-message-buffer
	(get-buffer "questionnaire.mime"))
  (if (null evs-message-buffer)
      (progn
	(setq evs-message-buffer
	      (get-buffer-create "questionnaire.mime"))
	(switch-to-buffer evs-message-buffer)
	)
    (progn
      (switch-to-buffer evs-message-buffer)
      (erase-buffer)
      ))
  (insert-file "/usr/local/lecture/EVS/questionnaire.mime")
  (goto-char (point-min))
  (re-search-forward "^=+\n")
  (insert (format "%s %s\n" evs-course-id evs-teachers-name))
  (mime/viewer-mode)
  )

(provide 'tm-evs)