├── README ├── pidgin.el ├── pidgin-chatactivity.el ├── pidgin-dbus.el └── pidgin-chatbuffer.el /README: -------------------------------------------------------------------------------- 1 | Wrapper for pidgin instant messager 2 | ~~~~~~~~~~~~~~~~~~~~ 3 | run pidgin or finch 4 | I prefer run finch in screen: 5 | $ screen -dmS "finch" finch 6 | ~~~~~~~~~~~~~~~~~~~~ 7 | create directory for store history (default name "~/.messenger"): 8 | $ mkdir ~/.pigin_log_directory 9 | ~~~~~~~~~~~~~~~~~~~~ 10 | add to your .emacs file: 11 | 12 | (require 'pidgin) 13 | 14 | ;;default input method 15 | (setq pidgin-default-input-method "russian-computer") 16 | 17 | ;;set name of existing directory for store history 18 | (setq pidgin-messenger-directory "~/.pigin_log_directory") 19 | 20 | (pidgin-connect) 21 | 22 | ~~~~~~~~~~~~~~~~~~~~ 23 | run for chat with jabber protocol: 24 | M-x pidgin-chat-with 25 | 26 | run for chat with icq protocol: 27 | M-1 M-x pidgin-chat-with 28 | -------------------------------------------------------------------------------- /pidgin.el: -------------------------------------------------------------------------------- 1 | (require 'cl) 2 | (require 'pidgin-chatbuffer) 3 | (require 'pidgin-dbus) 4 | (require 'pidgin-chatactivity) 5 | 6 | (defconst pidgin-protocol-delimeter "-") 7 | 8 | (defvar pidgin-default-input-method default-input-method) 9 | 10 | (defvar pidgin-completing-read 'completing-read) 11 | 12 | (defvar pidgin-messenger-directory "~/.messenger") 13 | 14 | (defun pidgin-connect () 15 | (when (and (fboundp 'ido-completing-read) 16 | ido-mode) 17 | (setq pidgin-completing-read 'ido-completing-read))) 18 | (pidgin-init) 19 | 20 | (defun pidgin-replace-regexp (regexp to-string) 21 | (while (re-search-forward regexp nil t) 22 | (replace-match to-string nil nil))) 23 | 24 | (defun pidgin-string-befor-p (prefix str) 25 | (string-match (concat "^" prefix ".*") str)) 26 | 27 | (defun pidgin-string-after-p (postfix str) 28 | (string-match (concat postfix "$") str)) 29 | 30 | (defun pidgin-delete-if (fn list) 31 | (let (res) 32 | (mapc (lambda (elem) 33 | (unless (funcall fn elem) 34 | (setq res (cons elem res)))) 35 | list) 36 | (nreverse res))) 37 | 38 | (provide 'pidgin) 39 | -------------------------------------------------------------------------------- /pidgin-chatactivity.el: -------------------------------------------------------------------------------- 1 | (defface pidgin-chat-activity-face 2 | '((t (:foreground "firebrick" :weight bold))) 3 | "face for activity message" 4 | :group 'pidgin-chat) 5 | 6 | (defvar pidgin-activity-mode-string "") 7 | 8 | (defvar pidgin-activity-list nil) 9 | 10 | (put 'pidgin-activity-mode-string 'risky-local-variable t) 11 | 12 | (defun pidgin-activity-show-p (from) 13 | (let ((buffer (get-buffer (pidgin-chat-get-buffer from)))) 14 | (get-buffer-window buffer 'visible))) 15 | 16 | (defun pidgin-activity-add (from) 17 | (unless (pidgin-activity-show-p from) 18 | (add-to-list 'pidgin-activity-list from) 19 | (pidgin-activity-mode-line-update))) 20 | 21 | (defun pidgin-activity-clean () 22 | (when pidgin-activity-list 23 | (setq pidgin-activity-list 24 | (pidgin-delete-if 'pidgin-activity-show-p pidgin-activity-list)) 25 | (pidgin-activity-mode-line-update))) 26 | 27 | 28 | (defun pidgin-activity-switch-to (user) 29 | (interactive) 30 | (switch-to-buffer (pidgin-chat-get-buffer user)) 31 | (pidgin-activity-clean)) 32 | 33 | 34 | (defun pidgin-activity-mode-line-update () 35 | (setq pidgin-activity-mode-string 36 | (if pidgin-activity-list 37 | (concat "----" 38 | (mapconcat 39 | (lambda (x) 40 | (propertize 41 | x 42 | 'face 'pidgin-chat-activity-face 43 | 'local-map (make-mode-line-mouse-map 44 | 'mouse-1 `(lambda () 45 | (interactive) 46 | (pidgin-activity-switch-to ,x))) 47 | 'help-echo (concat "Jump to " x "'s buffer"))) 48 | pidgin-activity-list ",")) 49 | "")) 50 | (force-mode-line-update 'all)) 51 | 52 | 53 | ;;;###autoload 54 | (define-minor-mode pidgin-activity-mode 55 | :global t 56 | :init-value t 57 | (if pidgin-activity-mode 58 | (progn 59 | (add-hook 'window-configuration-change-hook 60 | 'pidgin-activity-clean) 61 | (setq global-mode-string (append global-mode-string 62 | (list '(t pidgin-activity-mode-string))))) 63 | (progn 64 | (remove-hook 'window-configuration-change-hook 65 | 'pidgin-activity-clean) 66 | (setq global-mode-string (delete '(t pidgin-activity-mode-string) 67 | global-mode-string))))) 68 | 69 | 70 | (if pidgin-activity-mode (pidgin-activity-mode 1)) 71 | 72 | 73 | (provide 'pidgin-chatactivity) -------------------------------------------------------------------------------- /pidgin-dbus.el: -------------------------------------------------------------------------------- 1 | (require 'dbus) 2 | (require 'xml) 3 | 4 | ;;http://habahaba.jrudevels.org/ 5 | 6 | (defconst pidgin-icq-protocol "icq") 7 | 8 | (defconst pidgin-jabber-protocol "xmpp") 9 | 10 | (defvar pidgin-accounts nil) 11 | 12 | (defvar pidgin-all-user-list nil) 13 | 14 | (defvar pidgin-regexp-filter 15 | '(("
\\|
" "\n") 16 | ("\\(.*\\)" "\\1"))) 17 | 18 | (defun pidgin-recieve-signal (account sender text conversation flags) 19 | (let* ((protocol (car (rassoc account pidgin-accounts))) 20 | (message (pidgin-parse-message text)) 21 | (sender-name (car (rassoc (list (car (split-string sender "/"))) 22 | (pidgin-user-list protocol))))) 23 | (pidgin-chat-recieve 24 | (pidgin-protocol-user-name sender-name) 25 | (pidgin-protocol-user-name sender-name protocol) 26 | message))) 27 | 28 | 29 | (defun pidgin-parse-message (message) 30 | (message "%s" (format "from jabber: '%s'" message)) 31 | (with-temp-buffer 32 | (insert message) 33 | (mapc (lambda (regexp-info) 34 | (goto-char (point-min)) 35 | (apply 'pidgin-replace-regexp regexp-info)) 36 | pidgin-regexp-filter) 37 | (sgml-mode) 38 | (sgml-tags-invisible 0) 39 | (buffer-string))) 40 | 41 | (defun pidgin-init () 42 | (ignore-errors 43 | (dbus-register-signal :session "im.pidgin.purple.PurpleService" 44 | "/im/pidgin/purple/PurpleObject" 45 | "im.pidgin.purple.PurpleInterface" 46 | "ReceivedImMsg" 47 | 'pidgin-recieve-signal)) 48 | (setq pidgin-accounts (pidgin-account-list)) 49 | (setq pidgin-all-user-list 50 | (mapcar (lambda (account-info) 51 | (list (car account-info) 52 | (pidgin-buddy-list (cdr account-info)))) 53 | pidgin-accounts))) 54 | 55 | 56 | 57 | (defun pidgin-send-message (to message) 58 | (let* ((sender (split-string to pidgin-protocol-delimeter)) 59 | (name (car sender)) 60 | (protocol (second sender))) 61 | (pidgin-dbus-send-message 62 | (cdr (assoc protocol pidgin-accounts)) 63 | (second (assoc name (pidgin-user-list protocol))) 64 | message))) 65 | 66 | (defmacro pidgin-dbus-purple-call-method (method &rest args) 67 | `(dbus-call-method :session "im.pidgin.purple.PurpleService" 68 | "/im/pidgin/purple/PurpleObject" 69 | "im.pidgin.purple.PurpleInterface" 70 | ,method ,@args)) 71 | 72 | (defun pidgin-account-list () 73 | (mapcar (lambda (account) 74 | (cons (downcase 75 | (pidgin-dbus-purple-call-method 76 | "PurpleAccountGetProtocolName" 77 | :int32 account)) 78 | account)) 79 | (pidgin-dbus-purple-call-method "PurpleAccountsGetAllActive"))) 80 | 81 | 82 | 83 | (defun pidgin-dbus-send-message (account recipient message) 84 | (let* ((conversation (pidgin-dbus-purple-call-method 85 | "PurpleConversationNew" 86 | :int32 1 :int32 account recipient)) 87 | (im (pidgin-dbus-purple-call-method 88 | "PurpleConvIm" 89 | :int32 conversation))) 90 | (pidgin-dbus-purple-call-method 91 | "PurpleConvImSend" 92 | :int32 im (string-as-unibyte message)))) 93 | 94 | 95 | (defun pidgin-user-list (protocol) 96 | (second (assoc protocol pidgin-all-user-list))) 97 | 98 | (defun pidgin-buddy-list (account) 99 | (mapcar (lambda (buddy) 100 | (list (pidgin-dbus-purple-call-method "PurpleBuddyGetAlias" :int32 buddy) 101 | (pidgin-dbus-purple-call-method "PurpleBuddyGetName" :int32 buddy))) 102 | (pidgin-dbus-purple-call-method "PurpleFindBuddies" :int32 account ""))) 103 | 104 | (provide 'pidgin-dbus) 105 | 106 | -------------------------------------------------------------------------------- /pidgin-chatbuffer.el: -------------------------------------------------------------------------------- 1 | (defgroup pidgin-chat nil "Wrapper for pidgin instant messager" 2 | :group 'applications) 3 | 4 | 5 | (defface pidgin-chat-my-message-face 6 | '((t (:foreground "salmon" :weight bold))) 7 | "face for own message" 8 | :group 'pidgin-chat) 9 | 10 | (defface pidgin-chat-foriegn-message-face 11 | '((t (:foreground "SteelBlue1" :weight bold))) 12 | "face for foriegn message" 13 | :group 'pidgin-chat) 14 | 15 | (defvar pidgin-chat-point-insert nil 16 | "Position where the message being composed starts") 17 | 18 | (defvar pidgin-chat-send-function nil 19 | "Function for sending a message from a chat buffer.") 20 | 21 | (defvar pidgin-chating-with nil) 22 | 23 | 24 | (defconst pidgin-chat-line-dilimeter "----\n") 25 | 26 | (defun pidgin-chat-mode () 27 | (kill-all-local-variables) 28 | ;; Make sure to set this variable somewhere 29 | (make-local-variable 'pidgin-chat-send-function) 30 | 31 | (make-local-variable 'scroll-conservatively) 32 | (setq scroll-conservatively 5) 33 | 34 | (make-local-variable 'pidgin-chat-point-insert) 35 | (setq pidgin-chat-point-insert (point-min)) 36 | 37 | (setq major-mode 'pidgin-chat-mode 38 | mode-name "chat") 39 | (use-local-map pidgin-chat-mode-map) 40 | 41 | (put 'pidgin-chat-mode 'mode-class 'special)) 42 | 43 | (defvar pidgin-chat-mode-map 44 | (let ((map (make-sparse-keymap))) 45 | (set-keymap-parent map nil) 46 | (define-key map "\r" 'pidgin-chat-buffer-send) 47 | map)) 48 | 49 | (defun pidgin-chat-buffer-send () 50 | (interactive) 51 | (let ((body (delete-and-extract-region 52 | (+ (length pidgin-chat-line-dilimeter) pidgin-chat-point-insert) (point-max)))) 53 | (unless (zerop (length body)) 54 | (funcall pidgin-chat-send-function body)))) 55 | 56 | (defun pidgin-chat-buffer-display (prompt-function prompt-data output-functions output-data tail) 57 | ; (if (not pidgin-chat-point-insert) 58 | ; (setq pidgin-chat-point-insert (point-max))) 59 | (let ((at-insert-point (eq (point) pidgin-chat-point-insert)) 60 | outputp) 61 | (save-excursion 62 | (goto-char pidgin-chat-point-insert) 63 | (setq outputp 64 | (pidgin-chat-buffer-display-at-point prompt-function prompt-data output-functions output-data tail)) 65 | (setq pidgin-chat-point-insert (point)) 66 | (set-text-properties pidgin-chat-point-insert (point-max) nil)) 67 | 68 | (when at-insert-point 69 | (goto-char pidgin-chat-point-insert)) 70 | outputp)) 71 | 72 | (defun pidgin-chat-buffer-display-at-point (prompt-function prompt-data output-functions output-data tail) 73 | (let ((inhibit-read-only t) 74 | (beg (point)) 75 | (point-insert (set-marker (make-marker) pidgin-chat-point-insert))) 76 | (set-marker-insertion-type point-insert t) 77 | 78 | (dolist (printer output-functions) 79 | (funcall printer output-data) 80 | (unless (bolp) 81 | (insert "\n"))) 82 | 83 | (unless (eq (point) beg) 84 | (let ((end (point-marker))) 85 | (unless tail 86 | (goto-char beg) 87 | (funcall prompt-function prompt-data) 88 | (goto-char end)) 89 | (put-text-property beg end 'read-only t) 90 | (put-text-property beg end 'front-sticky t) 91 | (put-text-property beg end 'rear-nonsticky t) 92 | 93 | ;;add message to history 94 | (write-region beg end (concat pidgin-messenger-directory pidgin-chating-with ".txt") t 'no-echo) 95 | 96 | ;; this is always non-nil, so we return that 97 | (setq pidgin-chat-point-insert (marker-position point-insert)))))) 98 | 99 | 100 | (defun pidgin-chat-send (body) 101 | (pidgin-send-message pidgin-chating-with body) 102 | (pidgin-chat-buffer-display 'pidgin-chat-self-prompt 103 | nil 104 | '(insert) 105 | (propertize 106 | body 107 | 'face 'default) 108 | nil)) 109 | 110 | (defun pidgin-chat-recieve(name from body &optional tail) 111 | ;;(with-current-buffer (get-buffer-create "*chat-debug*") 112 | ;; (insert body)) 113 | 114 | (let* ((buf-name (pidgin-chat-get-buffer from)) 115 | (curr-buf (or (get-buffer buf-name) (pidgin-chat-create-buffer from)))) 116 | (with-current-buffer curr-buf 117 | (pidgin-chat-buffer-display 'pidgin-chat-foriegn-prompt 118 | name 119 | '(insert) 120 | (propertize 121 | body 122 | 'face 'default) 123 | tail))) 124 | (pidgin-activity-add from)) 125 | 126 | (defun pidgin-chat-self-prompt (timestamp) 127 | (insert (propertize 128 | (concat "["(format-time-string "%H:%M") "] " (system-name) "> ") 129 | 'face 'pidgin-chat-my-message-face))) 130 | 131 | (defun pidgin-chat-foriegn-prompt (name) 132 | (insert (propertize 133 | (concat "["(format-time-string "%H:%M") "] " name "> ") 134 | 'face 'pidgin-chat-foriegn-message-face))) 135 | 136 | (defun pidgin-chat-get-buffer (chat-with) 137 | (concat "*chat:" chat-with "*")) 138 | 139 | (defun pidgin-chat-create-buffer (chat-with) 140 | (with-current-buffer (get-buffer-create (pidgin-chat-get-buffer chat-with)) 141 | (insert pidgin-chat-line-dilimeter) 142 | (if (not (eq major-mode 'pidgin-chat-mode)) (pidgin-chat-mode)) 143 | (make-local-variable 'pidgin-chating-with) 144 | (setq pidgin-chating-with chat-with) 145 | (setq pidgin-chat-send-function 'pidgin-chat-send) 146 | (make-local-variable 'pidgin-chat-earliest-backlog) 147 | (set-input-method pidgin-default-input-method) 148 | (current-buffer))) 149 | 150 | 151 | 152 | (defun pidgin-protocol-user-name (user &optional protocol) 153 | (concat (if user user "unknown") (if protocol (concat pidgin-protocol-delimeter protocol ) ""))) 154 | 155 | (defun pidgin-user-list (&optional protocol) 156 | (pidgin-buddy-list protocol)) 157 | 158 | (defun pidgin-chat-with (&optional protocol-id) 159 | (interactive (list current-prefix-arg)) 160 | (let* ((user (let ((protocol (if (and current-prefix-arg 161 | (numberp current-prefix-arg) 162 | (eq current-prefix-arg 1)) 163 | pidgin-icq-protocol 164 | pidgin-jabber-protocol))) 165 | (pidgin-protocol-user-name 166 | (funcall pidgin-completing-read "chat with: " (pidgin-user-list protocol)) 167 | protocol))) 168 | (curr-buf (or (get-buffer (pidgin-chat-get-buffer user)) (pidgin-chat-create-buffer user)))) 169 | (switch-to-buffer curr-buf))) 170 | 171 | (provide 'pidgin-chatbuffer) 172 | 173 | 174 | 175 | --------------------------------------------------------------------------------