;;
;; STK (super待機くん) Version 0.6g of October 14 1993
;;
;;    Authers: uehara@yh.ntts.co.jp
;;             koyama@tmit.ac.jp
;;             yoko@ecsse.tmit.ac.jp
;;
;; 注意
;;
;; これはまだテスト版ですので，十分注意して使うように御願いします :-)
;;

(provide 'kermit)

(defvar myname "牧瀬里穂")  
(defvar myid "AAA00000")
(defvar sysinfo "")
(defvar kermit-logging t)  
(defvar logdir "~/stk-")
(defvar kermit-command-escape "\034")

(defvar kermit-dialtone "P")
(defvar kermit-ap-tel "0425297717")
(defvar kermit-at-command "AT")
(defvar kermit-login-script 
  (` (("OK" (, (concat "ATD" kermit-dialtone kermit-ap-tel)))
      ("CONNECT" " P")
      ("\\*" "C NIF")
      (" Enter Connection-ID  --->" "SVC")
      (" Enter User-ID  --->" (, myid))
      (" Enter Password --->"
       (, (function (kermit-send-string (read-string "password: ")))))
      ("." (message "Connected to nifty."))
      )))

;; 内部変数 
(defconst stk-version 
  "STK 0.6g of October 14 1993"
  "STKのバージョン")
(defvar kermit-debug nil "for debug")

(defvar kermit-mode-map nil)
(defvar kermit-process nil)
(defvar kermit-buffer)
(defvar tmp-buffer)
;; (defvar kermit-prompt-regexp "C-Kermit>")
(defvar kermit-prompt-regexp "\\(C-Kermit>\\|.*＞\\)")
(defvar kermit-output-tail)
(defvar kermit-filter-hook nil)
(defvar kermit-filter-string nil)

(defvar kermit-script-list nil)
(defvar kermit-login-script nil)


(defun kermit-mode()
  "Kermit mode"
  (interactive)

  (setq kermit-mode-map (make-sparse-keymap))
  (define-key kermit-mode-map "\C-m" 'kermit-send-input)
  (define-key kermit-mode-map "\C-cc" 'kermit-send-break)
  (define-key kermit-mode-map "\C-c\C-c" 'kermit-send-command)
  (define-key kermit-mode-map "\C-c\C-g" 'kermit-stop-script)

  (kill-all-local-variables)
  (fundamental-mode)
  (setq mode-name "kermit")
  (setq mode-line-process '(": %s"))
  (setq output-buffer "")
  (use-local-map kermit-mode-map))

(defun dust-remover (s) 
  (stk-replace-string s '(("\007" . "") ("\021" . "") ("\015" . "") ("\0" . ""))))

(defun replacer(s) 
  (stk-replace-string s '(("\n" . "\015"))))

(defun stk-filter(s) 
  (stk-replace-string s '(("＞" . ">") ("　" . "  "))))

(defun stk-replace-string (s replace-list)
  (let (result current-buffer-name)
    (setq current-buffer-name (current-buffer))	
    (set-buffer tmp-buffer)
    (erase-buffer)
    (insert s)
    (mapcar 
     (function (lambda (x) 
		 (goto-char (point-min))
		 (while (re-search-forward (car x) (point-max) t)
		   (replace-match (cdr x)))))
     replace-list)
    (setq result (buffer-string))
    (set-buffer current-buffer-name)
    result))

(defvar output-buffer "")
(defvar rest-string "")

(defvar stk-decorate t)

(defun kermit-decorate-attribute ()
  (interactive)
  (setq stk-decorate (not stk-decorate))
  (if stk-decorate
      (progn 
	(attribute-off-region 'inverse kermit-output-tail kermit-output-tail)
	(attribute-off-region 'bold kermit-output-tail kermit-output-tail))))

(defun kermit-line-filter (str)

  ;; ふふふ !!!!
  (setq str (stk-filter str))
  (setq kermit-filter-string str)

  (auto-reply-body 
   (list 
    (list "\\$\\$\\$ *> *\\(.*\\)$" 
	  '(lambda (s) (if (isme s 1) 
			   (concat stk-version "  " sysinfo) "")))))

  (if (boundp 'MULE)
      (if stk-decorate
	  (stk-cover klp kermit-output-tail)))
;	(attribute-off-region 'inverse beg end)
;	(attribute-off-region 'bold beg end)))

;  (if (boundp 'MULE)
;     (stk-cover klp kermit-output-tail))


  (setq klp kermit-output-tail)

  (if kermit-script-list
      ;; pattern-action列の解釈
      (let ((pattern (car (car kermit-script-list)))
	    (action (car (cdr (car kermit-script-list)))))
	(if (string-match pattern str)
	    (progn
	      (cond ((stringp action) (kermit-send-string action))
		    (t (eval action)))
	      (setq kermit-script-list (cdr kermit-script-list)))))
    (run-hooks 'kermit-filter-hook)))


(defun kermit-insert-output ()
  (goto-char kermit-output-tail)
   (let ((start kermit-output-tail) (ro buffer-read-only))
    (setq buffer-read-only nil)
    (insert output-buffer)
    (setq kermit-output-tail (point))
    (setq buffer-read-only ro)))

(defvar stk:cbn) ;; 局所変数
(defvar stk:cwn) ;; 局所変数

(defun stk:select (buf)
  (setq stk:cbn (current-buffer))	
  (setq stk:cwn (selected-window))
  (set-buffer buf)
  (let ((gbw (get-buffer-window buf)))
    (if gbw 
	(select-window gbw))))

(defun stk:select-back ()
  (select-window stk:cwn)
  (set-buffer stk:cbn))
 
(defun stk-cover (beg end)
  (stk:select kermit-buffer)

  (let ((ro buffer-read-only))
    (setq buffer-read-only nil)
    (if (pos-visible-in-window-p kermit-output-tail)
	(decorate-attribute beg end)
      (save-excursion
	(decorate-attribute beg end)))
    (setq buffer-read-only ro))
  (stk:select-back))


(defun decorate-attribute (beg end)
  (attribute-off-region 'inverse beg end)
  (attribute-off-region 'bold beg end)
  (mapcar 
   '(lambda (x) 
      (goto-char beg)
      (while (re-search-forward x end t)
	(attribute-on-region 'inverse 
			     (match-beginning 0) (match-end 0))))
   (list myname myid))
  (mapcar 
   '(lambda (x) 
      (goto-char beg)
      (while (re-search-forward x end t)
	(progn 
	  (attribute-off-region 'inverse
			       (match-beginning 0) (match-end 0))
	  (attribute-on-region 'bold 
			       (match-beginning 0) (match-end 0)))))
   (list (concat "([0-9]+," myname ").*\n")))
  (goto-char end))


(defvar klp nil)

(defun kermit-filter(process str)
  "Watch output of kermit process."
  (setq output-buffer (concat output-buffer str)) 
  (if (waiting-for-user-input-p)
      (progn
	;; "^@"と"^M"を取り除いて出力
	(setq output-buffer (dust-remover output-buffer))
	(stk:select kermit-buffer)

	(if (pos-visible-in-window-p kermit-output-tail)
	    (kermit-insert-output)
	  (save-excursion
	    (kermit-insert-output)))
	(setq str (concat rest-string output-buffer))
	(setq output-buffer "")

	(stk:select-back)

	;; kermit出力の各行にkermit-line-filterをapplyする
	(while (string-match ".*\n" str)
	  (let ((beg (match-beginning 0))
		(end (match-end 0)))
	    (kermit-line-filter (substring str beg end))
	    (setq str (substring str end))))
	(setq rest-string str)

	(if (and kermit-script-list
		 (string-match "[*>]$" rest-string))
	    (kermit-line-filter rest-string))
	)))

(defun kermit-logging-filename ()
  "Make logfilename"
  (let ((time-string (current-time-string)))
    (string-match "... \\(...\\) \\(..\\) ..:..:.. ..\\(..\\)" time-string)
    (concat logdir
	    (substring time-string (match-beginning 3)(match-end 3))
	    (substring time-string (match-beginning 1)(match-end 1))
	    (substring time-string (match-beginning 2)(match-end 2))
	    )))

(defun kermit()
  "Kermit sesion"
  (interactive)

  (if kermit-logging 
      (setq kermit-buffer
	    (find-file-noselect (kermit-logging-filename)))
    (setq kermit-buffer (get-buffer-create "*kermit*")))
  (setq tmp-buffer (get-buffer-create " *tmp*"))
  (setq kermit-process (get-buffer-process kermit-buffer))
  (switch-to-buffer kermit-buffer)
  (setq kermit-output-tail (point-max))
  (setq klp (point-max))
  (goto-char kermit-output-tail)

  (if (not (and (processp kermit-process)
		(eq (process-status kermit-process) 'run)))
      (progn 
	(setq
	 kermit-process
	 (if kermit-debug
	     (start-process "kermit" kermit-buffer
			    (concat exec-directory
				    (if (boundp 'MULE) "wakeup" "loadst")) "3")
	   (start-process "kermit" kermit-buffer
			  "kermit")
	   ))
	(set-process-filter kermit-process 'kermit-filter)

	(if (boundp 'MULE)
	    (set-process-coding-system kermit-process *sjis* *sjis*)
	  (set-process-kanji-code kermit-process 1))
	(kermit-mode))))

(defun kermit-send-string(str)   ;; &optional .... 
  "Send a string to kermit process as input."
   (interactive "sSend String: ")
   (let ((ro buffer-read-only))
     (setq buffer-read-only nil)
     (process-send-string kermit-process (replacer (concat str "\015")))
     (setq buffer-read-only ro)))

; (defun kermit-send-region(str)
;   "Send a region to kermit process as input."
;   (let ((ro buffer-read-only))
;     (setq buffer-read-only nil)
;     (process-send-string kermit-process (replacer str))
;     (setq buffer-read-only ro)))

(defun kermit-send-region(str)
  "Send a region to kermit process as input."
  (let ((ro buffer-read-only) (j 0))
    (setq buffer-read-only nil)
    (while (string-match "[^\n]*\n" str)
      (let ((beg (match-beginning 0))
	    (end (match-end 0)))
;	(insert (concat "(" (substring str beg end) ")"))
	(process-send-string kermit-process 
			     (replacer (substring str beg end)))
	(if (< j 10)
	    (setq j (1+ j))
	  (setq j 0)
	  (sleep-for 5))
	(setq str (substring str end)))
;      (insert (concat "[" str "]"))
      )
    (process-send-string kermit-process (replacer str))))


(defun kermit-send-command(c)
  "send a string to the kermit process as a command" 
  (interactive "cCommand(?/0/B/L/I/A/H/Q/S/Z):")
  (kermit-send-string (concat kermit-command-escape
			      (char-to-string c))))

(defun kermit-send-break()
  "send a break signal to the kermit" 
  (interactive)
  (kermit-send-command ?B))

(defun kermit-send-input()
  "Send contents of current line of kermit buffer to kermit process."
  (interactive)
  (save-excursion
    (if (< (point) kermit-output-tail)
	(beginning-of-line)
      (goto-char kermit-output-tail))
    (let ((end (save-excursion (end-of-line) (point)))
	  (beg (point)))

      ;; Skip kermit prompt pattern.
      (if (re-search-forward kermit-prompt-regexp end t)
	  (setq beg (point)))
      (kermit-send-string (buffer-substring beg end))

      ;; Expecting echoing of entered string from host,
      ;; dispose entered string.
      (delete-region beg end)
      )))

;;;
;;; chat (rtc or cb at nifty) mode
;;; 

(defvar handle-regexp-list nil) ;; see pickup-handle
(defvar reply-regexp-list nil) ;; see auto-reply
(defvar handle-list nil) ; see clear-handle-list
(defvar user-list nil) ; see clear-handle-list
(defvar char-list nil) ; see clear-handle-list
(defvar handle-index-list nil)
(defvar user-index-list nil)

(defvar chat-mode-map nil)
(defvar chat-saving-config nil)

(defvar handle-calling-prefix ">")
(defvar handle-calling-postfix "")
(defvar chat-window-height 4)
(defvar handle-window-width 16)

(defvar kermit-reply-list 
  (list 
   '("[ 　]*さ[ 　]*〜[ 　]*て[ 　]*$" "来週のサザエさんは〜")
   '("[ 　]*ひ[ 　]*ゅ[ 　]*う[ 　]*$" "ひゅうひゅう〜")
   '("makise[〜]+$" "ひゅうひゅう〜")
   '("[ 　]*ひ[ 　]*ま[ 　]*[〜あ]*[ 　]*$" "ひまでうね")
   '("[ 　]*A[ 　]*R[ 　]*M[ 　]*[〜]+*[ 　]*$" "買ってね〜")
   '("[ 　]*流[ 　]*石[ 　]*[あ〜]*[ 　]*$" "へへへ")
   '("[ 　]*こ[ 　]*$" "こ")
   '("[ 　]*で[ 　]*う[ 　]*$" "でう")
   (list "[ 　]*ひ[ 　]*ゅ[ 　]*う[ 　]*>[ 　]*\\(.*\\)$" 
	 '(lambda (s) (if (isme s 1) "ひゅう" "")))
   (list "[ 　]*で[ 　]*う[ 　]*>[ 　]*\\(.*\\)$" 
	 '(lambda (s) (if (isme s 1) "でう" "")))
   (list "[ 　]*こ[ 　]*>[ 　]*\\(.*\\)$" 
	 '(lambda (s) (if (isme s 1) "こ" "")))
   (list "[ 　]*ね[ 　]*え[ 　]*>[ 　]*\\(.*\\)$" 
	 '(lambda (s) (if (isme s 1) "へい" "")))))

(defun ismember (x l)
  (cond ((null l) nil)
	((equal x (car (cdr (car l))))l)
	(t (ismember x (cdr l)))))

(defun search-handle (x l)
  (cond ((null l) nil)
	((string= x (car (car l))) (car (cdr (car l))))
	(t (search-handle x (cdr l)))))

(defun sort-handle-list (h1 h2)
  (string-lessp (car h1) (car h2)))

(defvar handle-counter 0)
(defvar user-counter 0)

(defun update-handle (l x c)
  "ハンドルxの頻度を更新する"
  (cond ((null l) nil)
	((equal x (car (cdr (car l))))
;	 (setq c (1+ c))
;	 (setcar l (list (car (car l)) x c))l)
	 (if (> c (car (cdr (cdr (car l)))))
	     (setcar l (list (car (car l)) x c)))
	 l)
	(t (cons (car l) (update-handle (cdr l) x c)))))

(defun sort-handle-list-counter (h1 h2)
  (< (car (cdr (cdr h1))) (car (cdr (cdr h2)))))

(defun search-handle-pattern(reglist)
  "ハンドルを抽出し，登録する"
  (cond ((null reglist) nil)
        ((string-match (car reglist) kermit-filter-string)
	 ;; ハンドルがあったら登録する
;	 (ding)
         (let ((user (substring kermit-filter-string
                                  (match-beginning 1)
                                  (match-end 1)))
	       (handle (substring kermit-filter-string
                                  (match-beginning 2)
                                  (match-end 2))))
	   (if (not (equal handle ""))
	       (progn 
		 (setq handle-counter (1+ handle-counter))
		 (if (not (ismember handle handle-list))
		     (progn ; ハンドルリストが一杯であれば古いものを削除する
		       (if (null handle-index-list) 
			   (progn 
			     (setq handle-list 
				   (sort handle-list 'sort-handle-list-counter))
			     (setq handle-index-list 
				   (cons (car (car handle-list)) handle-index-list))
			     (setq handle-list (cdr handle-list))))
		       (setq handle-list 
			     (cons 
			      (list (car handle-index-list) 
				    handle 
				    handle-counter)
			      handle-list))
		       (setq handle-index-list (cdr handle-index-list))
		       (update-handle-buffer))
		   (progn
					; 頻度の記録
		     (update-handle handle-list handle handle-counter)
					; for debug 
		     (update-handle-buffer)))))
	   (if (not (equal user ""))
	       (progn 
		 (if (string= handle "") (ding))
		 (setq user-counter (1+ user-counter))
		 (if (not (ismember user user-list))
		     (progn ; ハンドルリストが一杯であれば古いものを削除する
		       (if (null user-index-list) 
			   (progn 
			     (setq user-list 
				   (sort user-list 'sort-handle-list-counter))
			     (setq user-index-list 
				   (cons (car (car user-list)) user-index-list))
			     (setq user-list (cdr user-list))))
		       (setq user-list 
			     (cons 
			      (list (car user-index-list) user user-counter)
			      user-list))
		       (setq user-index-list (cdr user-index-list))
		       (update-other-buffer))
		   (progn
					; 頻度の記録
		     (update-handle user-list user user-counter)
					; for debug 
		     (update-handle-buffer)))))))
	(t (search-handle-pattern (cdr reglist)))))

(defun pickup-handle()
  "ハンドルの抽出"
  (setq handle-regexp-list 
	(list "^\\(\\)([0-9]+,\\([^)]*\\))"
	       (concat "−\\([A-Z][A-Z][A-Z][0-9][0-9][0-9][0-9][0-9]\\)"
		       "　のユーザーからのメッセージです−\\(\\)")
	       (concat
		"^ [0-9 ][0-9 ][0-9] [T ][A ][L12 ][K0-9][S ] "
		"\\([A-Z][A-Z][A-Z][0-9][0-9][0-9][0-9][0-9]\\) \\(.*\\)$"
		)))
  (search-handle-pattern handle-regexp-list))

(defun auto-reply-body (krl)
  (mapcar 
   (function (lambda (arg)
	      (if (string-match (concat "^([0-9]+,[^)]*)" (car arg)) 
				kermit-filter-string)
		  (let ((x (car (cdr arg))) (s))
		    (setq s (if (stringp x)
				x
			      (funcall x kermit-filter-string)))
		    (if (not (string= s "")) 
			(kermit-send-string
			 (concat "[" s "]")))))))
   krl))

(defun pickup-grouping (s number) 
  (substring s (match-beginning number) (match-end number)))

(defun isme (s g)
  (let ((x (pickup-grouping s g)))
    (or (string= x myname) (string= (upcase x) myid) (string= (upcase x) "ALL"))))

(defun auto-reply()
  "自動応答"
  (auto-reply-body kermit-reply-list))

(defvar is-window-handle nil)
(defvar handle-window-visible t)

(defun stk-switch-handle ()
  (interactive)
  (setq handle-window-visible (not handle-window-visible))
  (setup-screen)
  handle-window-visible)

(defun setup-screen()
  "Setup and redraw screen all."
  (interactive)
  (let ((kbuf kermit-buffer)
	(cbuf (get-buffer "*chat*"))
	hbuf
	(window-min-height 1)
	(window-min-width 1))
    (if (null kbuf)
	(error "kermit buffer is not exist"))
    (if (null cbuf)
	(error "chat buffer is not exist"))

    (setq hbuf (if is-window-handle 
		   (get-buffer "*other*") 
		 (get-buffer "*handle*")))

    (switch-to-buffer "*chat*")
    (delete-other-windows (get-buffer-window "*chat*"))
    (split-window-vertically (- (screen-height) chat-window-height))
    (switch-to-buffer kermit-buffer)
    (if handle-window-visible 
	(progn 
	  (split-window-horizontally (- (screen-width) handle-window-width))
	  (other-window 1)
	  (switch-to-buffer (if is-window-handle "*other*" "*handle*"))))
    (other-window 1))
  (if is-window-handle (update-other-buffer) (update-handle-buffer))
  (setq is-window-handle (not is-window-handle)))


(defun clear-handle-list ()
  (interactive)
  (setq handle-counter 0)
  (setq user-counter 0)
  (setq handle-list '(("H" "ひ" 10000) ("M" "み" 10000) ("B" "び" 10000)
		      ("J" "January" 10000) ("D" "デロリアン" 10000) 
		      ("N" "NULL〜" 100000) ("A" "ALL" 100000)))
  (setq user-list '(("H" "HGE03375" 10000) ("M" "JAD00325" 10000) 
		    ("B" "GHE00361" 10000)))
  (setq char-list '(("1" ":-)") ("2" ":)") ("3" "(T_T)") 
		    ("4" "(-_-;") ("5" "_oへ_")))
  (setq handle-index-list (mapcar (function char-to-string)
				  "CEFGIKL"))
  (setq user-index-list (mapcar (function char-to-string)
				  "ACDEFGIJKL"))
  (if is-window-handle (update-handle-buffer) (update-other-buffer)))

(defun update-handle-buffer()
  "Refresh handle buffer and handle window."
  (interactive)
  (save-excursion
    (let (current-buffer-name)
      (setq current-buffer-name (current-buffer))	
      (set-buffer (get-buffer "*handle*"))
      (setq buffer-read-only nil)
      (delete-region (point-min) (point-max))
      (insert "ハンドル名\n----------\n")
      (setq handle-list (sort handle-list 'sort-handle-list))
      (mapcar
       '(lambda (s)
	  (insert (format " %s  %s(%d)\n" (car s) (car (cdr s)) (car (cdr (cdr s))) )))
       handle-list)
      (setq buffer-reqd-only t)
      (set-buffer current-buffer-name))))

(defun update-other-buffer()
  "Refresh other buffer and other window."
  (interactive)
  (save-excursion
    (let (current-buffer-name)
      (setq current-buffer-name (current-buffer))	
      (set-buffer (get-buffer "*other*"))
      (setq buffer-read-only nil)
      (delete-region (point-min) (point-max))
      (insert "利用者ID\n----------\n")
      (setq user-list (sort user-list 'sort-handle-list))
      (mapcar
       '(lambda (s)
	  (insert (format " %s  %s\n" (car s) (car (cdr s)))))
       user-list)
      (insert "==========\n")
      (mapcar
       '(lambda (s)
	  (insert (format " %s  %s\n" (car s) (car (cdr s)))))
       char-list)
      (setq buffer-read-only t)
      (set-buffer current-buffer-name))))

(defun chat-mode ()
  "Chat mode"
  (use-local-map chat-mode-map)
  (setq mode-name "chat"))

(defun chat()
  "Chat session"
  (interactive)

  (setq chat-mode-map (make-sparse-keymap))
  (define-key chat-mode-map "\C-m" 'chat-send-input)
  (define-key chat-mode-map "\C-cl" 'setup-screen)
  (define-key chat-mode-map "\C-co" 'stk-switch-handle)
  (define-key chat-mode-map "\C-cw" 'stk-send-region)
  (define-key chat-mode-map "\C-ch" 'get-handle)
  (define-key chat-mode-map "\C-cs" 'get-user)
  (define-key chat-mode-map "\C-cu" 'kermit-scroll-up)
  (define-key chat-mode-map "\C-cd" 'kermit-scroll-down)
  (define-key chat-mode-map "\C-cf" 'get-char)
  (define-key chat-mode-map "\C-c\C-c" 'kermit-send-command)
  (define-key chat-mode-map "\C-c\C-q" 'chat-quit)

  (setq chat-saving-config (current-window-configuration))
  (setq kermit-filter-hook nil)  ;; うううう
  (setq kermit-filter-hook (cons 'pickup-handle kermit-filter-hook))
  (setq kermit-filter-hook (cons 'auto-reply kermit-filter-hook))

  (switch-to-buffer kermit-buffer)
  (setq buffer-read-only t)

  (get-buffer-create "*handle*")
  (get-buffer-create "*other*")
  (set-buffer (get-buffer-create "*chat*"))
  (kill-all-local-variables)
  (clear-handle-list)
  (chat-mode)
  (setup-screen))

(defun chat-quit()
  "Quit chat mode."
  (interactive)
  (setq kermit-filter-hook nil)  ;; うううう
  (kill-buffer (get-buffer "*chat*"))
  (kill-buffer (get-buffer "*other*"))
  (kill-buffer (get-buffer "*handle*"))
  (set-window-configuration chat-saving-config)
  (switch-to-buffer kermit-buffer)
  (setq buffer-read-only nil)
  (end-of-buffer))

(defun chat-send-input()
  "Send contents of current line of chat buffer to kermit process."
  (interactive)
  (let ((beg (progn (beginning-of-line)(point)))
	(end (progn (end-of-line)(point))))
    (kermit-send-string (buffer-substring beg end)))
  (end-of-line)
  (newline))

(defun stk-send-region(beg end)
  (interactive "r")
  (kermit-send-region ;; ** NOT kermit-send-string **
   (buffer-substring beg end)))

(defvar default-handle-index "")
(defvar default-user-index "")
(defvar default-char-index "")

(defun get-handle()
  (interactive)
  (let (current-buffer-name index handle (chs t))
    (if handle-window-visible
	(if (not is-window-handle) (setup-screen))
      (progn 
	(setq chs nil)
	(setq handle-window-visible t)
	(if is-window-handle (setup-screen))
	(setup-screen)))
    (setq index (upcase (prompt-for-handle "だれ" default-handle-index)))
    (setq handle (search-handle index handle-list))
    (if (not (equal handle nil))
	(progn
	  (setq current-buffer-name (current-buffer))	
	  (set-buffer (get-buffer "*chat*"))
	  (insert (concat handle-calling-prefix
			  handle
			  handle-calling-postfix))
	  (set-buffer current-buffer-name)
	  (setq default-handle-index index)))
    (if (not chs)
	(progn 
	  (setq handle-window-visible nil)
	  (setup-screen)))))

(defun get-user()
  (interactive)
  (let (current-buffer-name index user (chs t))
    (if handle-window-visible
	(if is-window-handle (setup-screen))
      (progn 
	(setq chs nil)
	(setq handle-window-visible t)
	(if (not is-window-handle) (setup-screen))
	(setup-screen)))
    (setq index (upcase (prompt-for-handle "だれ" default-user-index)))
    (setq user (search-handle index user-list))
    (if (not (equal user nil))
	(progn
	  (setq current-buffer-name (current-buffer))	
	  (set-buffer (get-buffer "*chat*"))
	  (end-of-line)
	  (newline)
	  (insert (format "/send %s " user))
	  (set-buffer current-buffer-name)
	  (setq default-user-index index)))
    (if (not chs)
	(progn 
	  (setq handle-window-visible nil)
	  (setup-screen)))))

(defun get-char ()
  (interactive)
  (let (current-buffer-name index char (chs t))
    (if handle-window-visible
	(if is-window-handle (setup-screen))
      (progn 
	(setq chs nil)
	(setq handle-window-visible t)
	(if (not is-window-handle) (setup-screen))
	(setup-screen)))
    (setq index (upcase (prompt-for-handle "何番" default-char-index)))
    (setq char (search-handle index char-list))
    (if (not (equal char nil))
	(progn
	  (setq current-buffer-name (current-buffer))	
	  (set-buffer (get-buffer "*chat*"))
	  (insert char)
	  (set-buffer current-buffer-name)
	  (setq default-char-index index)))
    (if (not chs)
	(progn 
	  (setq handle-window-visible nil)
	  (setup-screen)))))

(defun prompt-for-handle (prompt default)
  (let* ((prompt (format "%s%s " prompt 
			   (if (equal "" default) ":"
			       (format "(DEFAULT:%s)" default))))
	 name)
    (setq name (read-from-minibuffer prompt ""))
    (if (equal name "")
	(setq name default))
    name))


(defun kermit-scroll-up ()
  (interactive)
  (stk:select kermit-buffer)
  (if (not (pos-visible-in-window-p (point-max)))
      (scroll-up)
    (ding))
;      (scroll-up (/ (window-height) 2)))
  (stk:select-back))

(defun kermit-scroll-down ()
  (interactive)
  (stk:select kermit-buffer)
  (if (not (pos-visible-in-window-p (point-min)))
      (scroll-down)
    (ding))
;      (scroll-down (/ (window-height) 2)))
  (stk:select-back))


(defvar stk-time 5)
(defvar stk-string "ああ... ただ今待機中...")

(defun stk ()
  (interactive)
  (setq stk-iter t)
  (let ((hour 0) (minute 0) (second 0))
    (kermit-send-string "/echo off")
    (while t 
      (if (input-pending-p)
	  (signal 'quit (list "待機終了!!"))
	(progn 
	  (kermit-send-string 
	   (format "%s[%02d:%02d:%02d]" 
		   stk-string hour minute second))
	  (kermit-send-string "/ust2")
	  (kermit-send-string "/u")
	  (sit-for stk-time)
	  (setq second (+ second stk-time))
	  (if (>= second 60)
	      (progn (setq second (- second 60))
		     (setq minute (1+ minute))
		     (if (>= minute 60)
			 (progn (setq minute (- minute 60))
				(setq hour (1+ hour)))))))))))

;;
;;  オートログイン
;;
(defun connect-to-nifty()
  (interactive)
  (kermit-send-string "CONNECT")
  (sleep-for 1)
  (kermit-send-string kermit-at-command)
  (setq kermit-script-list kermit-login-script))
;  (setq kermit-script-list (cons kermit-login-script kermit-script-list)))
