;;
;; soho.el version 1.24  1998/01/07 17:05:00 JST
;;   by Applause <t50942@hongo.ecc.u-tokyo.ac.jp>

;;for .emacs
;(autoload 'soho-disconnect "soho" "MN128-SOHO Controller (soho.el)" t)
;(autoload 'soho-connect "soho" "MN128-SOHO Controller (soho.el)" t)
;(autoload 'soho-status "soho" "MN128-SOHO Controller (soho.el)" t)
;

; history of 1.2 -> 1.21
;  SOHOのメッセージを表示。
;
; history of 1.21 -> 1.22
;  soho-host-name の追加。
;
; history of 1.22 -> 1.23
;  (set-process-coding-system soho *euc-japan*unix *euc-japan*unix)
;  の追加。これにより、Mule for Win32で動作可。
;
; history of 1.23 -> 1.24
;  soho-connect-command 及び soho-disconnect-command を soho-post-command に
;  統合。soho-get-command を追加。
;  soho-status の追加。
;  soho-connect で接続していないときに、soho-disconnect するとチャンネル選択
;  のプロンプトを出すように変更。
;  Emacs20 及び Meadow を判定して、
;  (set-process-coding-system soho 'euc-japan-unix 'euc-japan-unix)
;  とするよう変更。これにより、Emacs20 及び Meadow で動作可。

(defvar soho-connect-id nil)
(defvar soho-connect-password nil)
(defvar soho-connect-telephone-number nil)
(defvar soho-connect-dns nil)

(defvar soho-host-name "setup.mn128-soho")
(defvar soho-network-open-status '(open run))

(defvar soho-connected-channel nil)

(defun soho-get-command (file) 
  (concat
   "GET " file " HTTP/1.0\n"
   "Connection: Keep-Alive\n"
   "User-Agent: soho.el (Mule/Emacs)\n"
   "Host: " (getenv "HOSTNAME") "\n"
   "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*\n"
   "\n"
))

(defun soho-post-command (file content) 
  (concat
   "POST " file " HTTP/1.0\n"
   "Connection: Keep-Alive\n"
   "User-Agent: soho.el (Mule/Emacs)\n"
   "Host: " (getenv "HOSTNAME") "\n"
   "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*\n"
   "Content-type: application/x-www-form-urlencoded\n"
   "Content-length: " (prin1-to-string (length content)) "\n"
   "\n"
   content
))

(defun soho-disconnect-content () (concat
"disconnect=" soho-connected-channel
))

(defun soho-connect-content () 
  (concat
   "remote+0+function=connect"
   "&remote+0+number=" soho-connect-telephone-number
   "&remote+0+call+auth=either"
   "&remote+0+send+id=" soho-connect-id 
   "&remote+0+send+password=" (or soho-connect-password 
				  (soho-read-password "password:"))
   "&remote+0+name="
   "&remote+0+dnsserver=" soho-connect-dns
   "&remote+0+channel=1bppp"
   "&remote+0+mode=terminal"
   "&remote+0+disconnect+idle=0"
   "&remote+0+call+callback+request=off"
   "&remote+0+call+callback+number="
   "&remote+0+answer+permit=off"
   "&remote+0+receive+id="
   "&remote+0+receive+password="
   "&option="
   ))

;;Quated from ange-ftp.el .
(defun soho-read-password (prompt &optional default)
  "Read a password, echoing `.' for each character typed.
End with RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.
Optional DEFAULT is password to start with."
  (let ((pass (if default default ""))
	(c 0)
	(echo-keystrokes 0)
	(cursor-in-echo-area t))
    (while (progn (message "%s%s"
			   prompt
			   (make-string (length pass) ?.))
		  (setq c (read-char))
		  (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
      (if (= c ?\C-u)
	  (setq pass "")
	(if (and (/= c ?\b) (/= c ?\177))
	    (setq pass (concat pass (char-to-string c)))
	  (if (> (length pass) 0)
	      (setq pass (substring pass 0 -1))))))
    (message "")
    (soho-repaint-minibuffer)
    pass))

(defun soho-repaint-minibuffer ()
  "Clear any existing minibuffer message; let the minibuffer contents show."
  (message nil))


(defun soho-post (command)
  (let (s1 s2)
  (set-buffer (get-buffer-create "*soho*"))
  (erase-buffer)
  (setq soho (open-network-stream "soho" "*soho*" soho-host-name "http"))
  (if (= (string-to-int emacs-version) 20)
      (set-process-coding-system soho 'euc-japan-unix 'euc-japan-unix)
    (set-process-coding-system soho *euc-japan*unix *euc-japan*unix)
    )
  (process-send-string soho command)
  (while (memq (process-status soho) soho-network-open-status)
	    (accept-process-output soho))
  (string-match  "<FONT[^>]*>\\([^<]*\\)<" (buffer-string) 0)
  (setq s1 (substring (buffer-string) (match-beginning 1)(match-end 1)))
  (setq s2 (if 
    (string-match  "<FONT[^>]*>\\([^<]*\\)<" (buffer-string) (match-end 0))
    (substring (buffer-string) (match-beginning 1)(match-end 1))
    nil))
  (setq soho-status-message (concat s1 " " s2))
))

  
(defun soho-status ()(interactive)
  (soho-post (soho-get-command "/disconnect.cgi"))
  (message soho-status-message)
  )

(defun soho-disconnect ()(interactive)
  (soho-status)
  (let* ((b1 (string-match "B1" soho-status-message))
	 (b2 (string-match "B2" soho-status-message))
	 (channel (cond ((and b1 b2) (or soho-connected-channel ""))
			(b1 (if (string= "b1" soho-connected-channel) "b1" ""))
			(b2 (if (string= "b2" soho-connected-channel) "b2" ""))))
	 (table (cond ((and b1 b2) '(("all") ("b1") ("b2")))
		      (b1 '(("b1")))
		      (b2 '(("b2")))))) 
    (if channel
	(progn
	  (setq soho-connected-channel 
		(completing-read 
		 (concat "Status: " soho-status-message "Channel: ") 
		 table
		 nil t channel))
	  (soho-post (soho-post-command "/disconnect.cgi" 
					(soho-disconnect-content)))
	  )
      )
    (message soho-status-message)
    )
  )

(defun soho-connect ()(interactive)
  (let ((command (soho-post-command "/connect0.cgi" (soho-connect-content))))
    (message "接続中...")
    (soho-post command)
    (setq soho-connected-channel 
	  (cond ((string-match "B1.*接続しました" soho-status-message) "b1")
		((string-match "B2.*接続しました" soho-status-message) "b2")))
    (message soho-status-message)
    ))