tm-evs.el

   1 ;;;
   2 ;;; $Id: tm-evs.el,v 2.0 1995/06/10 19:33:26 morioka Exp $
   3 ;;;
   4 ;;; a tm-view internal method
   5 ;;;     for JAIST-Course-Evaluation questionnaire
   6 ;;;
   7
   8 (require 'tm-view)
   9
  10 (defvar questionnaire-result-alist nil)
  11
  12 (defun mime-viewer/filter-questionnaire (ctype params &optional encoding)
  13   (goto-char (point-min))
  14   (while (re-search-forward "^(" nil t)
  15     (replace-match "  (")
  16     ))
  17
  18 (set-alist 'mime-viewer/content-filter-alist
  19            "application/x-selection"
  20            (function mime-viewer/filter-questionnaire))
  21
  22 (defun mime-preview/reset-mark (cnum)
  23   (let* ((cinfo (mime::preview-content-info/content-info
  24                  (car mime::preview/content-list)))
  25          (ccinfo (mime-article/cnum-to-cinfo cnum cinfo))
  26          (pcinfo (mime-preview/cinfo-to-pcinfo ccinfo))
  27          (p (mime::preview-content-info/point-min pcinfo))
  28          )
  29     (save-excursion
  30       (let (buffer-read-only)
  31         (goto-char p)
  32         (delete-char 1)
  33         (insert " ")
  34         ))))
  35
  36 (defun mime-preview/set-mark (cnum)
  37   (let* ((cinfo (mime::preview-content-info/content-info
  38                  (car mime::preview/content-list)))
  39          (ccinfo (mime-article/cnum-to-cinfo cnum cinfo))
  40          (pcinfo (mime-preview/cinfo-to-pcinfo ccinfo))
  41          (p (mime::preview-content-info/point-min pcinfo))
  42          )
  43     (save-excursion
  44       (let (buffer-read-only)
  45         (goto-char p)
  46         (delete-char 1)
  47         (insert "*")
  48         ))))
  49
  50 (defun mime-viewer/questionnaire-select (beg end cal)
  51   (let* ((cnum (mime::get-point-content-number beg))
  52          (rcinfo mime::article/content-info)
  53          (mother-cnum (butlast cnum))
  54          (mother-cinfo (mime-article/cnum-to-cinfo mother-cnum))
  55          (mother-params (mime::content-info/parameters mother-cinfo))
  56          (number (assoc-value "x-part-number" mother-params))
  57          )
  58     (if number
  59         (setq number (string-to-int number))
  60       )
  61     (save-window-excursion
  62       (switch-to-buffer mime::article/preview-buffer)
  63       (let ((pa (assoc number questionnaire-result-alist)))
  64         (if pa
  65             (progn
  66               (setq pa (nth 1 pa))
  67               (mime-preview/reset-mark (list (car cnum) pa))
  68               )))
  69       (mime-preview/set-mark cnum)
  70       )
  71     (set-alist 'questionnaire-result-alist
  72                number
  73                (list (nth 1 cnum)
  74                      (save-restriction
  75                        (narrow-to-region
  76                         (mime::content-info/point-min mother-cinfo)
  77                         (mime::content-info/point-max mother-cinfo))
  78                        (message/get-field-body "Content-Description")
  79                        )))
  80     (let ((nc (append (butlast mother-cnum)
  81                       (list (1+ (last-element mother-cnum)) 0)))
  82           (the-buf (current-buffer))
  83           next-cinfo)
  84       (setq next-cinfo (mime-article/cnum-to-cinfo nc))
  85       (setq mime-preview/after-decoded-position
  86             (save-window-excursion
  87               (if next-cinfo
  88                   (progn
  89                     (switch-to-buffer mime::article/preview-buffer)
  90                     (mime::preview-content-info/point-min
  91                      (mime-preview/cinfo-to-pcinfo next-cinfo))
  92                     )
  93                 (point-max)
  94                 )))
  95       )))
  96
  97 (set-atype 'mime/content-decoding-condition
  98            '((type . "application/x-selection")
  99              (method . mime-viewer/questionnaire-select)
 100              ))
 101
 102 (defvar evs-course-id nil)
 103 (defvar evs-teachers-name nil)
 104 (defvar evs-message-buffer nil)
 105
 106 (defun jaist-evs-send-message ()
 107   (interactive)
 108   (if (not (equal (sort (mapcar (function car) questionnaire-result-alist)
 109                         (function <))
 110                   '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
 111                       21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38)))
 112       (message "\e$BA4$F$NA*Br;h$KEz$($F2<$5$$\e(B")
 113     (mail nil "evs-answer@jaist.ac.jp")
 114     (goto-char (point-max))
 115     (let ((rest (sort questionnaire-result-alist
 116                       (function
 117                        (lambda (a b)
 118                          (< (car a)(car b))
 119                          ))))
 120           ret)
 121       (insert (format "%s %s \n" evs-course-id evs-teachers-name))
 122       (while rest
 123         (setq ret (car rest))
 124         (insert (format "[%d]    %s\n    %d\n"
 125                         (car ret)
 126                         (or (nth 2 ret) "")
 127                         (or (nth 1 ret) 0)
 128                         ))
 129         (setq rest (cdr rest))
 130         )
 131       (insert "[39]  \e$B$3$N<x6H$NNI$$E@!"7g$1$?E@$r5s$2$F2<$5$$!#\e(B\n\n\n")
 132       (insert "[40]  \e$B$3$N<x6H$NC4Ev6541$N65$(J}$NNI$$E@!"7g$1$?E@$r;XE&$7$F2<$5$$!#\e(B\n\n\n")
 133       (insert "[41]  \e$B7/$O$3$N<x6H$r<u$1$F!"%W%i%9$H$J$C$?$b$N$O2?$G$7$g$&$+!)\e(B\n")
 134       (if evs-message-buffer
 135           (progn
 136             (switch-to-buffer evs-message-buffer)
 137             (if mime::article/preview-buffer
 138                 (kill-buffer mime::article/preview-buffer)
 139               )
 140             (kill-buffer evs-message-buffer)
 141             ))
 142       )))
 143
 144 (define-key mime/viewer-mode-map "\C-c\C-c" (function jaist-evs-send-message))
 145
 146 (defun jaist-evs ()
 147   (interactive)
 148   (setq questionnaire-result-alist nil)
 149   (setq evs-course-id
 150         (read-string "Please input course id > "))
 151   (setq evs-teachers-name
 152         (read-string "Please input teacher's name > "))
 153   (setq evs-message-buffer
 154         (get-buffer "questionnaire.mime"))
 155   (if (null evs-message-buffer)
 156       (progn
 157         (setq evs-message-buffer
 158               (get-buffer-create "questionnaire.mime"))
 159         (switch-to-buffer evs-message-buffer)
 160         )
 161     (progn
 162       (switch-to-buffer evs-message-buffer)
 163       (erase-buffer)
 164       ))
 165   (insert-file "/usr/local/lecture/EVS/questionnaire.mime")
 166   (goto-char (point-min))
 167   (re-search-forward "^=+\n")
 168   (insert (format "%s %s\n" evs-course-id evs-teachers-name))
 169   (mime/viewer-mode)
 170   )
 171
 172 (provide 'tm-evs)