终于做了第一个emacs lisp程序,恭喜自己,你辛苦了。
该文件只支持msnp9协议,只能在utf-8环境下使用,功能不全,只能聊天
把文件保存
;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File : mymsn.el
;; Program/Library : emacs lisp
;; Description :
;; Created: Wed Apr 23 14:04:27 2008
;; Author: Zhu W.P.
;; Mail : zwpsky@gmail.com
;; Last Modified On : Wed Apr 30 21:03:19 2008 (28800 CST)
;;
;; Copyright 2008 Zhu W.P.
;; addr:
;; tel :
;; fax :
;;
;;
(require 'cl)
(defvar *msn-experimental* t "experimental function (has problem)")
(defvar *msn-user-account* '((mail . nil)
(pass . nil)
(name . nil)
(stat . "FLN")))
(defvar *msn-version* "MSN Messenger on Emacs version 0.0.1")
(defvar *msn-product* '((key . "Q1P7W2E4J9R8U3S5")
(code . "msmsgs@msnmsgr.com")))
(defvar *msn-contact-group* '((GP . ())))
(defvar *msn-contact-list* '((FL . ())
(RL . ())
(AL . ())
(BL . ())))
(defvar *msn-mail-alias* '(() . ()))
(defvar *msn-group* '((name . nil)
(group-id . nil)))
(defvar *msn-mode-map* (make-keymap))
(defvar *msn-buffer* "MSN Messenger")
(defvar *msn-id* nil)
(defvar *msn-dispatch* nil)
(defvar *msn-dispatch-buffer* " Dispatch")
(defvar *msn-output-log* nil)
(defvar *msn-notification* nil)
(defvar *msn-notification-buffer* " Notification")
(defvar *msn-switchboard-id* nil)
(defvar *msn-id-and-address* nil)
(defvar *msn-sync-fragment* nil)
(defvar *msn-http* nil)
(defvar *msn-http-buffer* " Http")
(defvar *msn-idle-timer* nil)
(defvar *msn-ticks* nil)
(defvar *msn-prompt* "MSN> ")
(defvar *msn-current-send-user* nil)
(defvar *msn-current-recv-user* nil)
(defun msn-mode-init ()
(define-key *msn-mode-map* (kbd "RET") 'msn-send-message)
(msn-initialize-screen)
(msn-connect)
(msn-version)
(use-local-map *msn-mode-map*))
(defun msn-connect()
(interactive)
(setq *msn-id* -1)
(setq *msn-switchboard-id* 0)
(let ((mail (assoc 'mail *msn-user-account*))
(pass (assoc 'pass *msn-user-account*)))
(when (null (cdr mail)) (setcdr mail (read-string "Hostmail Account: ")))
(when (null (cdr pass))
(setcdr pass (let ((inhibit-input-event-recording t))
(condition-case nil (read-passwd "Password: "))))))
(setq *msn-dispatch* (open-network-stream "Dispatch Server"
*msn-dispatch-buffer*
"messenger.hotmail.com"
1863))
(set-process-coding-system *msn-dispatch* 'utf-8-dos 'utf-8-dos)
(set-process-filter *msn-dispatch* 'msn-dispatch-filter)
(msn-login *msn-dispatch*))
(defun msn-dispatch-filter (proc string)
(let ((old-buffer (current-buffer)))
(save-excursion
(let ((*msn-output-log* "Dispatch") ;;*msn-dispatch-buffer*)
(finalize nil))
(set-buffer (process-buffer proc))
(cond
((string-match "^VER" string)
(when (string-match "MSNP" string)
(setq finalize (lambda()
(msn-proc-send *msn-dispatch*
(concat (make-command "CVR %d")
" 0x0409 mac 10.2.0 ppc macmsgs 3.5.1 macmsgs "
(cdr (assoc 'mail *msn-user-account*)) "/n")
)))))
((string-match "^CVR" string)
(setq finalize (lambda()
(msn-proc-send *msn-dispatch*
(concat (make-command "USR %d")
" TWN I "(cdr (assoc 'mail *msn-user-account*)) "/n")))))
((string-match "^XFR" string)
(msn-xfr string))
(t nil))
(when finalize (funcall finalize))))))
(defun msn-notification-filter (proc string)
(let ((old-buffer (current-buffer)))
(save-excursion
(let ((*msn-output-log* *msn-notification-buffer*) (finalize nil))
(set-buffer (process-buffer proc))
(dolist (string (msn-message-parse string))
(cond
((string-match "^VER" string)
(when (string-match "MSNP" string)
(setq finalize (lambda ()
(msn-proc-send proc (concat (make-command "CVR %d")
" 0x0409 mac 10.2.0 ppc macmsgs 3.5.1 macmsgs "
(cdr (assoc 'mail *msn-user-account*))
"/n"))))))
((string-match "^CVR" string)
(setq finalize (lambda ()
(msn-proc-send proc (concat (make-command "USR %d TWN I ")
(cdr (assoc 'mail *msn-user-account*))
"/n")))))
((string-match "^USR" string)
(msn-notification-usr-cmd proc string))
((string-match "^CHG" string)
(msn-notification-chg-cmd proc string))
((string-match "^CHL" string)
(msn-notification-chl-cmd proc string))
((string-match "^ILN" string)
(msn-notification-iln-cmd string))
((string-match "^NLN" string)
(msn-notification-nln-cmd string))
((string-match "^LSG" string)
(msn-add-group string))
((string-match "^LST" string)
(msn-notification-lst-cmd proc string))
((string-match "^RNG" string)
(msn-notification-rng-cmd proc string))
((string-match "^XFR" string)
(msn-xfr string))
((string-match "^FLN" string)
(msn-notification-fln-cmd string))
(t (msn-print-msg string))))
(when finalize (funcall finalize))))))
(defun msn-print-msg (string)
(let* ((lst (split-string string "[ /n]")))
(message (nth 0 lst))))
(defun msn-notification-fln-cmd (string)
(let* ((lst (split-string string "[ /n]"))
(stat "FLN")
(mail (nth 1 lst)))
(msn-set-contact-status mail "FLN")))
(defun msn-set-contact-status (mail status)
(let* ((FL (assoc 'FL *msn-contact-list*))
(m (assoc mail (cdr FL))))
(setcdr (assoc 'stat (cdr m)) stat)))
(defun msn-notification-nln-cmd (string)
(let* ((lst (split-string string "[ /n]"))
(stat (nth 1 lst))
(mail (nth 2 lst)))
(msn-set-contact-status mail stat)))
(defun msn-notification-iln-cmd (string)
(let* ((lst (split-string string "[ /n]"))
(stat (nth 2 lst))
(mail (nth 3 lst)))
(msn-set-contact-status mail stat)))
(defun msn-add-group (string)
(let* ((lst (split-string string "[ /n]"))
(group-id (nth 1 lst))
(group-name (nth 2 lst))
(GP (assoc 'GP *msn-contact-group*))
(id (assoc group-id (cdr GP))))
(message (concat "LSG " group-name " " group-id))
(if (null id)
(setcdr GP (cons (cons group-id (list (cons 'group-name group-name))) (cdr GP)))
(setcdr (assoc 'group-name (cdr id)) group-name))))
(defun msn-notification-lst-cmd (server string)
(let* ((lst (split-string string "[ /n]"))
(mail (nth 1 lst))
(name (decode-coding-string (nth 2 lst) 'utf-8-dos))
(group-id (nth 4 lst))
(stat "FLN")
(count 0)
(FL (assoc 'FL *msn-contact-list*))
(m (assoc mail (cdr FL))))
(if (null m)
(setcdr FL (cons (cons mail (list (cons 'stat stat) (cons 'name (nth 2 lst)) (cons 'group-id group-id) (cons 'session nil))) (cdr FL)))
(setcdr (assoc 'name (cdr m)) (nth 2 lst))
(setcdr (assoc 'stat (cdr m)) stat)
(setcdr (assoc 'group-id (cdr m)) group-id))))
(defun msn-xfr (string)
(let* ((lst (split-string string "[ /n]"))
(type (nth 2 lst))
(address (split-string (nth 3 lst) ":"))
(addr (nth 0 address))
(port (nth 1 address)))
(cond ((string-equal type "NS")
(setq *msn-notification*
(open-network-stream "Notification Server"
*msn-notification-buffer*
addr (string-to-int port)))
(set-process-coding-system *msn-notification* 'utf-8-dos 'utf-8-dos)
(set-process-filter *msn-notification* 'msn-notification-filter)
(msn-login *msn-notification*))
((string-equal type "SB")
(let ((session-id (nth 1 lst))
(security-string (nth 5 lst)))
(setq switchboard (open-network-stream "SwitchBoard"
nil
addr
(string-to-int port)))
(set-process-coding-system switchboard 'utf-8-dos 'utf-8-dos)
(set-process-filter switchboard 'msn-switchboard-filter)
(let* ((FL (assoc 'FL *msn-contact-list*))
(m (assoc *msn-current-send-user* (cdr FL))))
(setcdr (assoc 'session (cdr m)) switchboard)
(msn-proc-send switchboard (concat (make-switchboard-command "USR %d ")
(cdr (assoc 'mail *msn-user-account*))
" "
security-string
"/n"))))))))
(defun msn-notification-chg-cmd (server string)
(when (string-match "^CHG //([0-9]+//) //([A-Za-z]//{3//}//) //([0-9]+//)" string)
(let ((tr-id (string-to-number (match-string 1 string)))
(stat (intern (match-string 2 string)))
(client-id (match-string 3 string)))
(when (and *msn-experimental* (string-equal stat "NLN") (null *msn-idle-timer*))
;; (setq *msn-idle-timer*
;;; (run-with-idle-timer (* 60 5) nil
;;; (lambda (server)
;;; (message "ffffffffffffffffffffffffffffffff")
;;; (when (and server (eq (process-status server) 'open))
;;(msn-proc-send server (concat "CHG %d IDL/n"))
;; ;;; )
;;; (setq *msn-idle-timer* nil)))))
)
;; (setcdr (assoc 'stat *msn-user-account*) stat)
)))
(defun msn-notification-rng-cmd (server string)
(let* ((lst (split-string string "[ /n]"))
(sessid (nth 1 lst))
(address (nth 2 lst))
(authtype (nth 3 lst))
(ticket (nth 4 lst))
(invitepassport (nth 5 lst))
(invitename (nth 6 lst))
(FL (assoc 'FL *msn-contact-list*))
(m (assoc invitepassport (cdr FL))))
(setq switchboard (open-network-stream "SwitchBoard"
nil
(nth 0 (split-string address ":"))
(string-to-int (nth 1 (split-string address ":")))))
(set-process-coding-system switchboard 'utf-8-dos 'utf-8-dos)
(set-process-filter switchboard 'msn-switchboard-filter)
(setcdr (assoc 'session (cdr m)) switchboard)
(msn-proc-send switchboard (concat (make-switchboard-command "ANS %d ")
(cdr (assoc 'mail *msn-user-account*))
" "
ticket
" "
sessid
"/n"))))
(defun msn-switchboard-filter (proc string)
(cond
((string-match "^MSG" string)
(msn-show-message string))
((string-match "^USR" string)
(msn-switchboard-usr-cmd proc string))
((string-match "^JOI" string)
(msn-send-message))
(t nil)))
(defun msn-switchboard-usr-cmd (server string)
(let* ((lst (split-string string "[ /n]")))
(if (string-equal (nth 2 lst) "OK")
(msn-proc-send server (concat (make-command "CAL %d")
" "
*msn-current-send-user*
"/n")))))
(defun msn-show-message (string)
(when (string-match (concat "^Content-Type:"
" "
"//([a-zA-Z/]+//)"
" *")
string)
(let* ((content-type (match-string 1 string)))
(if (string-equal content-type "text/plain")
(let* ((pos (string-match "/n/n" string))
(lst (split-string string "[ /n]"))
(mail (nth 1 lst))
(name (nth 2 lst))
(len (nth 3 lst))
(msg (substring string (+ pos 2) nil)))
(set-buffer *msn-buffer*)
(goto-char (point-max))
(let ((inhibit-read-only t))
(let* ((string (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(string (substring string (length *msn-prompt*))))
(delete-region (point-at-bol) (point-at-eol))
(msn-chat-insert-readonly (concat
(msn-propertize (concat (format-time-string "[%H:%M]")
" "
name
":/n")
'face 'msn-msg-recv-face)
msg
"/n"))
(msn-chat-show-prompt)
(setq *msn-current-recv-user* (msn-propertize (concat "[" mail "]") 'face 'msn-msg-recv-face))
(insert string))))))))
(defun msn-command-shell-contact-list (string)
(let ((inhibit-read-only t))
(let* ((lst (split-string string "[ /n]"))
(cmd (nth 0 lst)))
(delete-region (point-at-bol) (point-at-eol))
(msn-chat-insert-readonly (concat
(msn-propertize
(concat (format-time-string "[%H:%M] ")
cmd
"> ") 'face 'msn-msg-send-face)
"/n"))
(when (null (cdr (assoc 'FL *msn-contact-list*)))
(msn-chat-insert-readonly "no one online.../n"))
(dolist (g (cdr (assoc 'GP *msn-contact-group*)))
(msn-chat-insert-readonly (concat
"/n"
(msn-propertize (cdr (assoc 'group-name (cdr g))) 'face 'msn-group-name-face)
"/n"))
(setq group-id (car g))
(dolist (e (cdr (assoc 'FL *msn-contact-list*)))
(setq id (cdr (assoc 'group-id (cdr e))))
(if (and id (eq (string-to-int group-id) (string-to-int id)))
(msn-status-show (concat
"/t"
"<" (car e) ">"
"/t"
(cdr (assoc 'name (cdr e)))
"/t"
(msn-status-expand (cdr (assoc 'stat (cdr e))))
"/n")
(cdr (assoc 'stat (cdr e))))))))
(msn-chat-show-prompt)))
(defun msn-command-shell (string)
(cond ((string-match "^list" string)
(msn-command-shell-contact-list string))
(t nil)))
(defun msn-send-message ()
(interactive)
(set-buffer *msn-buffer*)
(setq *msn-current-recv-user* nil) ;去掉消息提示
(let ((inhibit-read-only t))
(let* ((string (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(string (substring string (length *msn-prompt*)))
(pos (string-match ":" string))
(name (substring string 0 pos)))
(if (not pos)
(msn-command-shell string)
(let* ((FL (assoc 'FL *msn-contact-list*))
(NM (assoc name (cdr FL)))
(session (cdr (assoc 'session (cdr NM)))))
(setq *msn-current-send-user* name)
(if (and session (eq (process-status session) 'open))
(let* ((body (substring string (+ pos 1) nil))
(head "MIME-Version: 1.0/nContent-Type: text/plain; charset=UTF-8/nX-MMS-IM-Format: FN=MS%20UI%20Gothic; EF=; CO=0; CS=80; PF=0/n/n")
(msg (concat head body))
(size (int-to-string (length (encode-coding-string msg 'utf-8-dos))))
(msg (concat (make-command "MSG %d U ") size "/n" msg)))
(process-send-string session msg)
(delete-region (point-at-bol) (point-at-eol))
(let* ((str (substring string (length *msn-prompt*))))
(msn-chat-insert-readonly (concat (msn-propertize (concat (format-time-string "[%H:%M]")
" "
(cdr (assoc 'name (cdr NM)))
":/n")
'face 'msn-msg-send-face)
body
"/n")))
(msn-chat-show-prompt))
(progn
(msn-proc-send *msn-notification* (make-command "XFR %d SB/n")))))))))
(defun msn-notification-usr-cmd (server string)
(let* ((lst (split-string string "[ /n]")))
(cond ((string-equal (nth 3 lst) "S")
(setq msn-ticks (nth 4 lst))
(msn-http-connect "/login2.srf" "login.passport.com" 443 msn-ticks))
((string-equal (nth 2 lst) "OK")
(let* ((lst (split-string string " ")))
(msn-proc-send server (make-command "SYN %d 0 0/n"))
(msn-proc-send server (make-command "CHG %d NLN 1073741868/n"))
;;; (setcdr (assoc 'mail *msn-user-account*) (nth 3 lst))
;;; (setcdr (assoc 'name *msn-user-account*)
;;; (msn-url-decode-string (nth 4 lst)))
;; (msn-show-command nil "LOGIN OK")
(message "LOGIN OK"))))))
(defun msn-notification-chl-cmd (server string)
(when (string-match "//`CHL //([0-9]+//) //([0-9]+//)" string)
(let* ((chanllenge-string (match-string 2 string))
(client-id-string ""))
(msn-proc-send server (concat (make-command "QRY %d")
" "
(cdr (assoc 'code *msn-product*))
" "
"32/n"
(md5 (concat chanllenge-string
(cdr (assoc 'key *msn-product*)))))))))
(defun msn-message-parse (string)
(cond ((or *msn-sync-fragment* (string-match "^GTC" string))
(if (not (eq (aref string (- (length string) 1)) ?/n))
(progn
(setq *msn-sync-fragment* (concat *msn-sync-fragment* string))
nil)
(let* ((lst (split-string (if *msn-sync-fragment* (concat *msn-sync-fragment* string) string)
"/n")))
(setq *msn-sync-fragment* nil)
lst)))
((string-match "^MSG" string)
(list string))
((string-match "^USR" string)
(let* ((pos (string-match "/n" string))
(usr (substring string 0 pos))
(other (substring string (+ pos 1) (length string))))
(if (> (length other) 5)
(list usr other)
(list usr))))
(t (split-string string "/n"))))
(defun msn-login (server)
(msn-proc-send server (make-command "VER %d MSNP9 CVR0/n")))
(defun make-command (string)
(setq *msn-id* (+ *msn-id* 1))
(format string *msn-id*))
(defun make-switchboard-command (string)
(setq *msn-switchboard-id* (+ *msn-switchboard-id* 1))
(format string *msn-switchboard-id*))
(defun msn-proc-send (server cmd)
(save-selected-window
(when *msn-output-log*
(insert "--------------/n")
(insert cmd)
(insert "--------------/n"))
(process-send-string server cmd)))
(defun msn-version()
(message *msn-version*))
(defun msn-mode()
"MSN Messenger MODE"
(interactive)
(msn-mode-init)
(setq major-mode 'msn-mode)
(setq mode-name "MSN Messenger Mode"))
(defun msn-http-connect (file address port string)
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)))
(setq *msn-http* (open-tls-stream "Http"
nil
address port))
(set-process-coding-system *msn-http* 'binary 'binary)
(set-process-filter *msn-http* 'msn-http-filter)
(msn-http-auth *msn-http* file address port string))
(defun msn-http-auth (server file address port string)
(process-send-string server (concat
"GET "
file
" HTTP/1.0/r/n"
"Accept: */*/r/n"
"Host: "
address
":"
(int-to-string port)
"/r/n"
"User-Agent: Zhu Weiping/r/n"
"Authorization: Passport1.4 "
"OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,"
"sign-in="
(cdr (assoc 'mail *msn-user-account*))
",pwd="
(cdr (assoc 'pass *msn-user-account*))
","
string
"/r/n"
"/r/n")))
(defvar msg "")
(defun msn-http-filter (proc string)
(save-excursion
(if (not (string-match "/r/n/r/n" string))
(progn
(setq msg (concat msg string))
nil)
(progn
(setq msg (concat msg string))
(setq string msg)
(setq msg "")))
(let* ((lst (split-string string "/r/n")))
(when (string-match "^HTTP/1.[01] //([0-9]//{3//}//)" (nth 0 lst))
(setq return-code (string-to-int (nth 1 (split-string (nth 0 lst) " "))))
(if (= return-code 302)
(dolist (str lst)
(if (string-match "Location: " str)
(progn
(setq url (substring str (+ (string-match "://" str) 3)))
(setq server (substring url 0 (string-match "/" url)))
(setq file (substring url (string-match "/" url) nil))
(msn-http-connect file server 443 msn-ticks)
))))
(if (= return-code 200)
(dolist (str lst)
(if (string-match "Authentication-Info" str)
(progn
(setq info (substring str (+ (string-match "from-PP='" str) 9) nil))
(setq msn-ticks (substring info 0 (string-match "'" info)))
(msn-proc-send *msn-notification* (concat (make-command "USR %d TWN S ")
msn-ticks
"/n"))))))))))
(defun msn-chat-show-prompt ()
(msn-chat-insert-readonly
(msn-propertize *msn-prompt* 'face 'msn-prompt-face)))
(defun msn-initialize-screen ()
(interactive)
;;; (switch-to-buffer *msn-buffer*)
(erase-buffer)
(msn-chat-show-prompt))
;; NLN|FLN|BSY|IDL|BRB|AWY|PHN|LUN
(defun msn-status-expand (status)
(interactive)
(cdr (assoc status '(("NLN" . "ONLINE") ("FLN" . "OFFLINE") ("BSY" . "busy")
("IDL" . "idle") ("BRB" . "be right back") ("AWY" . "away")
("PHN" . "on the phone") ("LUN" . "gone to lunch")))))
(defun msn-status-show (string status)
(interactive)
(cond ((string-equal status "NLN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-online)))
((string-equal status "AWY")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-away)))
((string-equal status "FLN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-offline)))
((string-equal status "IDL")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-idle)))
((string-equal status "BSY")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-busy)))
((string-equal status "PHN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-phone)))
((string-equal status "LUN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-lunch)))
((string-equal status "BRB")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-back)))
(t nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; user interface ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defface msn-prompt-face
'((t (:foreground "green" :weight bold :slant normal)))
"face for displaying prompt face")
(defface msn-msg-send-face
'((t (:foreground "blue" :weight bold :slant normal)))
"face for displaying send message time")
(defface msn-msg-recv-face
'((t (:foreground "red" :weight bold :slant normal)))
"face for displaying recv message time")
(defface msn-status-face-online
'((t (:foreground "blue" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-busy
'((t (:foreground "red" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-phone
'((t (:foreground "green" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-lunch
'((t (:foreground "green2" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-back
'((t (:foreground "green3" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-offline
'((t (:foreground "dark grey" :weight light :slant italic)))
"face for displaying offline users")
(defface msn-status-face-idle
'((t (:foreground "yellow" :weight light :slant italic)))
"face for displaying offline users")
(defface msn-status-face-away
'((t (:foreground "blue4" :weight bold :slant italic)))
"face for displaying away users")
(defface msn-group-name-face
'((t (:weight bold :width ultra-expanded :height 1.5 :background "gray" :inherit variable-pitch)))
"face for large group name")
(defun msn-propertize (string &rest properties)
"Return a copy of STRING with text properties added. "
"[Note: this docstring has been copied from the Emacs 21 version]"
"First argument is the string to copy."
"Remaining arguments form a sequence of PROPERTY VALUE pairs for text"
"properties to add to the result."
(let ((str (copy-sequence string)))
(add-text-properties 0 (length str)
properties
str)
str))
(defun msn-chat-insert-readonly (str)
"Insert STR as read-only."
(let ((start (point)))
(insert str)
(add-text-properties start (point) '(read-only t front-sticky t rear-nonsticky t))))
(provide 'mymsn)
该文件只支持msnp9协议,只能在utf-8环境下使用,功能不全,只能聊天
把文件保存
;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File : mymsn.el
;; Program/Library : emacs lisp
;; Description :
;; Created: Wed Apr 23 14:04:27 2008
;; Author: Zhu W.P.
;; Mail : zwpsky@gmail.com
;; Last Modified On : Wed Apr 30 21:03:19 2008 (28800 CST)
;;
;; Copyright 2008 Zhu W.P.
;; addr:
;; tel :
;; fax :
;;
;;
(require 'cl)
(defvar *msn-experimental* t "experimental function (has problem)")
(defvar *msn-user-account* '((mail . nil)
(pass . nil)
(name . nil)
(stat . "FLN")))
(defvar *msn-version* "MSN Messenger on Emacs version 0.0.1")
(defvar *msn-product* '((key . "Q1P7W2E4J9R8U3S5")
(code . "msmsgs@msnmsgr.com")))
(defvar *msn-contact-group* '((GP . ())))
(defvar *msn-contact-list* '((FL . ())
(RL . ())
(AL . ())
(BL . ())))
(defvar *msn-mail-alias* '(() . ()))
(defvar *msn-group* '((name . nil)
(group-id . nil)))
(defvar *msn-mode-map* (make-keymap))
(defvar *msn-buffer* "MSN Messenger")
(defvar *msn-id* nil)
(defvar *msn-dispatch* nil)
(defvar *msn-dispatch-buffer* " Dispatch")
(defvar *msn-output-log* nil)
(defvar *msn-notification* nil)
(defvar *msn-notification-buffer* " Notification")
(defvar *msn-switchboard-id* nil)
(defvar *msn-id-and-address* nil)
(defvar *msn-sync-fragment* nil)
(defvar *msn-http* nil)
(defvar *msn-http-buffer* " Http")
(defvar *msn-idle-timer* nil)
(defvar *msn-ticks* nil)
(defvar *msn-prompt* "MSN> ")
(defvar *msn-current-send-user* nil)
(defvar *msn-current-recv-user* nil)
(defun msn-mode-init ()
(define-key *msn-mode-map* (kbd "RET") 'msn-send-message)
(msn-initialize-screen)
(msn-connect)
(msn-version)
(use-local-map *msn-mode-map*))
(defun msn-connect()
(interactive)
(setq *msn-id* -1)
(setq *msn-switchboard-id* 0)
(let ((mail (assoc 'mail *msn-user-account*))
(pass (assoc 'pass *msn-user-account*)))
(when (null (cdr mail)) (setcdr mail (read-string "Hostmail Account: ")))
(when (null (cdr pass))
(setcdr pass (let ((inhibit-input-event-recording t))
(condition-case nil (read-passwd "Password: "))))))
(setq *msn-dispatch* (open-network-stream "Dispatch Server"
*msn-dispatch-buffer*
"messenger.hotmail.com"
1863))
(set-process-coding-system *msn-dispatch* 'utf-8-dos 'utf-8-dos)
(set-process-filter *msn-dispatch* 'msn-dispatch-filter)
(msn-login *msn-dispatch*))
(defun msn-dispatch-filter (proc string)
(let ((old-buffer (current-buffer)))
(save-excursion
(let ((*msn-output-log* "Dispatch") ;;*msn-dispatch-buffer*)
(finalize nil))
(set-buffer (process-buffer proc))
(cond
((string-match "^VER" string)
(when (string-match "MSNP" string)
(setq finalize (lambda()
(msn-proc-send *msn-dispatch*
(concat (make-command "CVR %d")
" 0x0409 mac 10.2.0 ppc macmsgs 3.5.1 macmsgs "
(cdr (assoc 'mail *msn-user-account*)) "/n")
)))))
((string-match "^CVR" string)
(setq finalize (lambda()
(msn-proc-send *msn-dispatch*
(concat (make-command "USR %d")
" TWN I "(cdr (assoc 'mail *msn-user-account*)) "/n")))))
((string-match "^XFR" string)
(msn-xfr string))
(t nil))
(when finalize (funcall finalize))))))
(defun msn-notification-filter (proc string)
(let ((old-buffer (current-buffer)))
(save-excursion
(let ((*msn-output-log* *msn-notification-buffer*) (finalize nil))
(set-buffer (process-buffer proc))
(dolist (string (msn-message-parse string))
(cond
((string-match "^VER" string)
(when (string-match "MSNP" string)
(setq finalize (lambda ()
(msn-proc-send proc (concat (make-command "CVR %d")
" 0x0409 mac 10.2.0 ppc macmsgs 3.5.1 macmsgs "
(cdr (assoc 'mail *msn-user-account*))
"/n"))))))
((string-match "^CVR" string)
(setq finalize (lambda ()
(msn-proc-send proc (concat (make-command "USR %d TWN I ")
(cdr (assoc 'mail *msn-user-account*))
"/n")))))
((string-match "^USR" string)
(msn-notification-usr-cmd proc string))
((string-match "^CHG" string)
(msn-notification-chg-cmd proc string))
((string-match "^CHL" string)
(msn-notification-chl-cmd proc string))
((string-match "^ILN" string)
(msn-notification-iln-cmd string))
((string-match "^NLN" string)
(msn-notification-nln-cmd string))
((string-match "^LSG" string)
(msn-add-group string))
((string-match "^LST" string)
(msn-notification-lst-cmd proc string))
((string-match "^RNG" string)
(msn-notification-rng-cmd proc string))
((string-match "^XFR" string)
(msn-xfr string))
((string-match "^FLN" string)
(msn-notification-fln-cmd string))
(t (msn-print-msg string))))
(when finalize (funcall finalize))))))
(defun msn-print-msg (string)
(let* ((lst (split-string string "[ /n]")))
(message (nth 0 lst))))
(defun msn-notification-fln-cmd (string)
(let* ((lst (split-string string "[ /n]"))
(stat "FLN")
(mail (nth 1 lst)))
(msn-set-contact-status mail "FLN")))
(defun msn-set-contact-status (mail status)
(let* ((FL (assoc 'FL *msn-contact-list*))
(m (assoc mail (cdr FL))))
(setcdr (assoc 'stat (cdr m)) stat)))
(defun msn-notification-nln-cmd (string)
(let* ((lst (split-string string "[ /n]"))
(stat (nth 1 lst))
(mail (nth 2 lst)))
(msn-set-contact-status mail stat)))
(defun msn-notification-iln-cmd (string)
(let* ((lst (split-string string "[ /n]"))
(stat (nth 2 lst))
(mail (nth 3 lst)))
(msn-set-contact-status mail stat)))
(defun msn-add-group (string)
(let* ((lst (split-string string "[ /n]"))
(group-id (nth 1 lst))
(group-name (nth 2 lst))
(GP (assoc 'GP *msn-contact-group*))
(id (assoc group-id (cdr GP))))
(message (concat "LSG " group-name " " group-id))
(if (null id)
(setcdr GP (cons (cons group-id (list (cons 'group-name group-name))) (cdr GP)))
(setcdr (assoc 'group-name (cdr id)) group-name))))
(defun msn-notification-lst-cmd (server string)
(let* ((lst (split-string string "[ /n]"))
(mail (nth 1 lst))
(name (decode-coding-string (nth 2 lst) 'utf-8-dos))
(group-id (nth 4 lst))
(stat "FLN")
(count 0)
(FL (assoc 'FL *msn-contact-list*))
(m (assoc mail (cdr FL))))
(if (null m)
(setcdr FL (cons (cons mail (list (cons 'stat stat) (cons 'name (nth 2 lst)) (cons 'group-id group-id) (cons 'session nil))) (cdr FL)))
(setcdr (assoc 'name (cdr m)) (nth 2 lst))
(setcdr (assoc 'stat (cdr m)) stat)
(setcdr (assoc 'group-id (cdr m)) group-id))))
(defun msn-xfr (string)
(let* ((lst (split-string string "[ /n]"))
(type (nth 2 lst))
(address (split-string (nth 3 lst) ":"))
(addr (nth 0 address))
(port (nth 1 address)))
(cond ((string-equal type "NS")
(setq *msn-notification*
(open-network-stream "Notification Server"
*msn-notification-buffer*
addr (string-to-int port)))
(set-process-coding-system *msn-notification* 'utf-8-dos 'utf-8-dos)
(set-process-filter *msn-notification* 'msn-notification-filter)
(msn-login *msn-notification*))
((string-equal type "SB")
(let ((session-id (nth 1 lst))
(security-string (nth 5 lst)))
(setq switchboard (open-network-stream "SwitchBoard"
nil
addr
(string-to-int port)))
(set-process-coding-system switchboard 'utf-8-dos 'utf-8-dos)
(set-process-filter switchboard 'msn-switchboard-filter)
(let* ((FL (assoc 'FL *msn-contact-list*))
(m (assoc *msn-current-send-user* (cdr FL))))
(setcdr (assoc 'session (cdr m)) switchboard)
(msn-proc-send switchboard (concat (make-switchboard-command "USR %d ")
(cdr (assoc 'mail *msn-user-account*))
" "
security-string
"/n"))))))))
(defun msn-notification-chg-cmd (server string)
(when (string-match "^CHG //([0-9]+//) //([A-Za-z]//{3//}//) //([0-9]+//)" string)
(let ((tr-id (string-to-number (match-string 1 string)))
(stat (intern (match-string 2 string)))
(client-id (match-string 3 string)))
(when (and *msn-experimental* (string-equal stat "NLN") (null *msn-idle-timer*))
;; (setq *msn-idle-timer*
;;; (run-with-idle-timer (* 60 5) nil
;;; (lambda (server)
;;; (message "ffffffffffffffffffffffffffffffff")
;;; (when (and server (eq (process-status server) 'open))
;;(msn-proc-send server (concat "CHG %d IDL/n"))
;; ;;; )
;;; (setq *msn-idle-timer* nil)))))
)
;; (setcdr (assoc 'stat *msn-user-account*) stat)
)))
(defun msn-notification-rng-cmd (server string)
(let* ((lst (split-string string "[ /n]"))
(sessid (nth 1 lst))
(address (nth 2 lst))
(authtype (nth 3 lst))
(ticket (nth 4 lst))
(invitepassport (nth 5 lst))
(invitename (nth 6 lst))
(FL (assoc 'FL *msn-contact-list*))
(m (assoc invitepassport (cdr FL))))
(setq switchboard (open-network-stream "SwitchBoard"
nil
(nth 0 (split-string address ":"))
(string-to-int (nth 1 (split-string address ":")))))
(set-process-coding-system switchboard 'utf-8-dos 'utf-8-dos)
(set-process-filter switchboard 'msn-switchboard-filter)
(setcdr (assoc 'session (cdr m)) switchboard)
(msn-proc-send switchboard (concat (make-switchboard-command "ANS %d ")
(cdr (assoc 'mail *msn-user-account*))
" "
ticket
" "
sessid
"/n"))))
(defun msn-switchboard-filter (proc string)
(cond
((string-match "^MSG" string)
(msn-show-message string))
((string-match "^USR" string)
(msn-switchboard-usr-cmd proc string))
((string-match "^JOI" string)
(msn-send-message))
(t nil)))
(defun msn-switchboard-usr-cmd (server string)
(let* ((lst (split-string string "[ /n]")))
(if (string-equal (nth 2 lst) "OK")
(msn-proc-send server (concat (make-command "CAL %d")
" "
*msn-current-send-user*
"/n")))))
(defun msn-show-message (string)
(when (string-match (concat "^Content-Type:"
" "
"//([a-zA-Z/]+//)"
" *")
string)
(let* ((content-type (match-string 1 string)))
(if (string-equal content-type "text/plain")
(let* ((pos (string-match "/n/n" string))
(lst (split-string string "[ /n]"))
(mail (nth 1 lst))
(name (nth 2 lst))
(len (nth 3 lst))
(msg (substring string (+ pos 2) nil)))
(set-buffer *msn-buffer*)
(goto-char (point-max))
(let ((inhibit-read-only t))
(let* ((string (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(string (substring string (length *msn-prompt*))))
(delete-region (point-at-bol) (point-at-eol))
(msn-chat-insert-readonly (concat
(msn-propertize (concat (format-time-string "[%H:%M]")
" "
name
":/n")
'face 'msn-msg-recv-face)
msg
"/n"))
(msn-chat-show-prompt)
(setq *msn-current-recv-user* (msn-propertize (concat "[" mail "]") 'face 'msn-msg-recv-face))
(insert string))))))))
(defun msn-command-shell-contact-list (string)
(let ((inhibit-read-only t))
(let* ((lst (split-string string "[ /n]"))
(cmd (nth 0 lst)))
(delete-region (point-at-bol) (point-at-eol))
(msn-chat-insert-readonly (concat
(msn-propertize
(concat (format-time-string "[%H:%M] ")
cmd
"> ") 'face 'msn-msg-send-face)
"/n"))
(when (null (cdr (assoc 'FL *msn-contact-list*)))
(msn-chat-insert-readonly "no one online.../n"))
(dolist (g (cdr (assoc 'GP *msn-contact-group*)))
(msn-chat-insert-readonly (concat
"/n"
(msn-propertize (cdr (assoc 'group-name (cdr g))) 'face 'msn-group-name-face)
"/n"))
(setq group-id (car g))
(dolist (e (cdr (assoc 'FL *msn-contact-list*)))
(setq id (cdr (assoc 'group-id (cdr e))))
(if (and id (eq (string-to-int group-id) (string-to-int id)))
(msn-status-show (concat
"/t"
"<" (car e) ">"
"/t"
(cdr (assoc 'name (cdr e)))
"/t"
(msn-status-expand (cdr (assoc 'stat (cdr e))))
"/n")
(cdr (assoc 'stat (cdr e))))))))
(msn-chat-show-prompt)))
(defun msn-command-shell (string)
(cond ((string-match "^list" string)
(msn-command-shell-contact-list string))
(t nil)))
(defun msn-send-message ()
(interactive)
(set-buffer *msn-buffer*)
(setq *msn-current-recv-user* nil) ;去掉消息提示
(let ((inhibit-read-only t))
(let* ((string (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(string (substring string (length *msn-prompt*)))
(pos (string-match ":" string))
(name (substring string 0 pos)))
(if (not pos)
(msn-command-shell string)
(let* ((FL (assoc 'FL *msn-contact-list*))
(NM (assoc name (cdr FL)))
(session (cdr (assoc 'session (cdr NM)))))
(setq *msn-current-send-user* name)
(if (and session (eq (process-status session) 'open))
(let* ((body (substring string (+ pos 1) nil))
(head "MIME-Version: 1.0/nContent-Type: text/plain; charset=UTF-8/nX-MMS-IM-Format: FN=MS%20UI%20Gothic; EF=; CO=0; CS=80; PF=0/n/n")
(msg (concat head body))
(size (int-to-string (length (encode-coding-string msg 'utf-8-dos))))
(msg (concat (make-command "MSG %d U ") size "/n" msg)))
(process-send-string session msg)
(delete-region (point-at-bol) (point-at-eol))
(let* ((str (substring string (length *msn-prompt*))))
(msn-chat-insert-readonly (concat (msn-propertize (concat (format-time-string "[%H:%M]")
" "
(cdr (assoc 'name (cdr NM)))
":/n")
'face 'msn-msg-send-face)
body
"/n")))
(msn-chat-show-prompt))
(progn
(msn-proc-send *msn-notification* (make-command "XFR %d SB/n")))))))))
(defun msn-notification-usr-cmd (server string)
(let* ((lst (split-string string "[ /n]")))
(cond ((string-equal (nth 3 lst) "S")
(setq msn-ticks (nth 4 lst))
(msn-http-connect "/login2.srf" "login.passport.com" 443 msn-ticks))
((string-equal (nth 2 lst) "OK")
(let* ((lst (split-string string " ")))
(msn-proc-send server (make-command "SYN %d 0 0/n"))
(msn-proc-send server (make-command "CHG %d NLN 1073741868/n"))
;;; (setcdr (assoc 'mail *msn-user-account*) (nth 3 lst))
;;; (setcdr (assoc 'name *msn-user-account*)
;;; (msn-url-decode-string (nth 4 lst)))
;; (msn-show-command nil "LOGIN OK")
(message "LOGIN OK"))))))
(defun msn-notification-chl-cmd (server string)
(when (string-match "//`CHL //([0-9]+//) //([0-9]+//)" string)
(let* ((chanllenge-string (match-string 2 string))
(client-id-string ""))
(msn-proc-send server (concat (make-command "QRY %d")
" "
(cdr (assoc 'code *msn-product*))
" "
"32/n"
(md5 (concat chanllenge-string
(cdr (assoc 'key *msn-product*)))))))))
(defun msn-message-parse (string)
(cond ((or *msn-sync-fragment* (string-match "^GTC" string))
(if (not (eq (aref string (- (length string) 1)) ?/n))
(progn
(setq *msn-sync-fragment* (concat *msn-sync-fragment* string))
nil)
(let* ((lst (split-string (if *msn-sync-fragment* (concat *msn-sync-fragment* string) string)
"/n")))
(setq *msn-sync-fragment* nil)
lst)))
((string-match "^MSG" string)
(list string))
((string-match "^USR" string)
(let* ((pos (string-match "/n" string))
(usr (substring string 0 pos))
(other (substring string (+ pos 1) (length string))))
(if (> (length other) 5)
(list usr other)
(list usr))))
(t (split-string string "/n"))))
(defun msn-login (server)
(msn-proc-send server (make-command "VER %d MSNP9 CVR0/n")))
(defun make-command (string)
(setq *msn-id* (+ *msn-id* 1))
(format string *msn-id*))
(defun make-switchboard-command (string)
(setq *msn-switchboard-id* (+ *msn-switchboard-id* 1))
(format string *msn-switchboard-id*))
(defun msn-proc-send (server cmd)
(save-selected-window
(when *msn-output-log*
(insert "--------------/n")
(insert cmd)
(insert "--------------/n"))
(process-send-string server cmd)))
(defun msn-version()
(message *msn-version*))
(defun msn-mode()
"MSN Messenger MODE"
(interactive)
(msn-mode-init)
(setq major-mode 'msn-mode)
(setq mode-name "MSN Messenger Mode"))
(defun msn-http-connect (file address port string)
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)))
(setq *msn-http* (open-tls-stream "Http"
nil
address port))
(set-process-coding-system *msn-http* 'binary 'binary)
(set-process-filter *msn-http* 'msn-http-filter)
(msn-http-auth *msn-http* file address port string))
(defun msn-http-auth (server file address port string)
(process-send-string server (concat
"GET "
file
" HTTP/1.0/r/n"
"Accept: */*/r/n"
"Host: "
address
":"
(int-to-string port)
"/r/n"
"User-Agent: Zhu Weiping/r/n"
"Authorization: Passport1.4 "
"OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,"
"sign-in="
(cdr (assoc 'mail *msn-user-account*))
",pwd="
(cdr (assoc 'pass *msn-user-account*))
","
string
"/r/n"
"/r/n")))
(defvar msg "")
(defun msn-http-filter (proc string)
(save-excursion
(if (not (string-match "/r/n/r/n" string))
(progn
(setq msg (concat msg string))
nil)
(progn
(setq msg (concat msg string))
(setq string msg)
(setq msg "")))
(let* ((lst (split-string string "/r/n")))
(when (string-match "^HTTP/1.[01] //([0-9]//{3//}//)" (nth 0 lst))
(setq return-code (string-to-int (nth 1 (split-string (nth 0 lst) " "))))
(if (= return-code 302)
(dolist (str lst)
(if (string-match "Location: " str)
(progn
(setq url (substring str (+ (string-match "://" str) 3)))
(setq server (substring url 0 (string-match "/" url)))
(setq file (substring url (string-match "/" url) nil))
(msn-http-connect file server 443 msn-ticks)
))))
(if (= return-code 200)
(dolist (str lst)
(if (string-match "Authentication-Info" str)
(progn
(setq info (substring str (+ (string-match "from-PP='" str) 9) nil))
(setq msn-ticks (substring info 0 (string-match "'" info)))
(msn-proc-send *msn-notification* (concat (make-command "USR %d TWN S ")
msn-ticks
"/n"))))))))))
(defun msn-chat-show-prompt ()
(msn-chat-insert-readonly
(msn-propertize *msn-prompt* 'face 'msn-prompt-face)))
(defun msn-initialize-screen ()
(interactive)
;;; (switch-to-buffer *msn-buffer*)
(erase-buffer)
(msn-chat-show-prompt))
;; NLN|FLN|BSY|IDL|BRB|AWY|PHN|LUN
(defun msn-status-expand (status)
(interactive)
(cdr (assoc status '(("NLN" . "ONLINE") ("FLN" . "OFFLINE") ("BSY" . "busy")
("IDL" . "idle") ("BRB" . "be right back") ("AWY" . "away")
("PHN" . "on the phone") ("LUN" . "gone to lunch")))))
(defun msn-status-show (string status)
(interactive)
(cond ((string-equal status "NLN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-online)))
((string-equal status "AWY")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-away)))
((string-equal status "FLN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-offline)))
((string-equal status "IDL")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-idle)))
((string-equal status "BSY")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-busy)))
((string-equal status "PHN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-phone)))
((string-equal status "LUN")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-lunch)))
((string-equal status "BRB")
(msn-chat-insert-readonly (msn-propertize string 'face 'msn-status-face-back)))
(t nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; user interface ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defface msn-prompt-face
'((t (:foreground "green" :weight bold :slant normal)))
"face for displaying prompt face")
(defface msn-msg-send-face
'((t (:foreground "blue" :weight bold :slant normal)))
"face for displaying send message time")
(defface msn-msg-recv-face
'((t (:foreground "red" :weight bold :slant normal)))
"face for displaying recv message time")
(defface msn-status-face-online
'((t (:foreground "blue" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-busy
'((t (:foreground "red" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-phone
'((t (:foreground "green" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-lunch
'((t (:foreground "green2" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-back
'((t (:foreground "green3" :weight bold :slant normal)))
"face for displaying online users")
(defface msn-status-face-offline
'((t (:foreground "dark grey" :weight light :slant italic)))
"face for displaying offline users")
(defface msn-status-face-idle
'((t (:foreground "yellow" :weight light :slant italic)))
"face for displaying offline users")
(defface msn-status-face-away
'((t (:foreground "blue4" :weight bold :slant italic)))
"face for displaying away users")
(defface msn-group-name-face
'((t (:weight bold :width ultra-expanded :height 1.5 :background "gray" :inherit variable-pitch)))
"face for large group name")
(defun msn-propertize (string &rest properties)
"Return a copy of STRING with text properties added. "
"[Note: this docstring has been copied from the Emacs 21 version]"
"First argument is the string to copy."
"Remaining arguments form a sequence of PROPERTY VALUE pairs for text"
"properties to add to the result."
(let ((str (copy-sequence string)))
(add-text-properties 0 (length str)
properties
str)
str))
(defun msn-chat-insert-readonly (str)
"Insert STR as read-only."
(let ((start (point)))
(insert str)
(add-text-properties start (point) '(read-only t front-sticky t rear-nonsticky t))))
(provide 'mymsn)