elisp的MSN通信程序

终于做了第一个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)
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值