Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
324 lines (284 sloc) 11.9 KB
;;; yammer.el -- Simple tool for accessing
;; Copyright (C) 2009 Peter Sanford
;; Author: Peter Sanford <peter AT>
;; Version: 1.01
;; Keywords: comm
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Simple mode for browsing and posting to
;; This mode requires oauth.el:
;; git clone git://
;; and json.el:
;; You will need to register for an oauth key/secret at
;; Once you have a key and secrect, set yammer-consumer-key
;; and yammer-consumer-secret with those values.
;; Add the following to your emacs init file
;; (require 'yammer)
;; (yammer-authenticate unix-user-name)
;; Useful functions:
;; yammer-list-messages
;; yammer-post-message
;; yammer-post-buffer-contents
;; set yammer-show-icons to enable mugshots
;;; Code:
(require 'json)
(require 'oauth)
(require 'image-file)
(defvar yammer-consumer-key nil)
(defvar yammer-consumer-secret nil)
(defvar yammer-request-url "")
(defvar yammer-access-url "")
(defvar yammer-user-authorize "")
(defvar yammer-list-url "")
(defvar yammer-create-message-url "")
(defvar yammer-delete-url-base "")
(defvar yammer-access-token nil)
(defun yammer-authenticate (username)
"Get authentication token"
(if (file-exists-p (format "/home/%s/.yammer-token" username))
(find-file (format "/home/%s/.yammer-token" username))
(let ((str (buffer-substring (point-min) (point-max))))
(if (string-match "\\([^:]*\\):\\(.*\\)"
(buffer-substring (point-min) (point-max)))
(setq yammer-access-token
:consumer-key yammer-consumer-key
:consumer-secret yammer-consumer-secret
:auth-t (make-oauth-t
:token (match-string 1 str)
:token-secret (match-string 2 str))))))
(unless yammer-access-token
(let ((callback
(lambda ()
(let ((callback-token (read-string
"Please enter the provided code: ")))
(setq access-url
(concat access-url "?callback_token=" callback-token))))))
(setq yammer-access-token
(oauth-authorize-app yammer-consumer-key yammer-consumer-secret
yammer-request-url yammer-access-url
(find-file (format "/home/%s/.yammer-token" username))
(let ((token (oauth-access-token-auth-t yammer-access-token)))
(insert (format "%s:%s\n"
(oauth-t-token token)
(oauth-t-token-secret token))))
(defun yammer-internal-post-message (message &optional reply-to-id)
"Post message to yammer"
(let ((args `(("body" . ,message))))
(if reply-to-id
(push `("replied_to_id" . ,(number-to-string reply-to-id)) args))
(set-buffer (oauth-post-url yammer-access-token
yammer-create-message-url args))
(let ((beg (point)) (line))
(setq line (buffer-substring beg (point)))
(if (string-match "201 Created" line) (message "Message Created!")
(error "Problem creating message: %s" line)))))
(defun yammer-post-buffer-contents ()
"Posts the contents of the current buffer to yammer.
Useful when using a sperate buffer for composition, possibly with flyspell."
(yammer-internal-post-message (buffer-string)))
(defun yammer-post-message (message)
"Posts to yammer"
(interactive "sMessage: ")
(yammer-internal-post-message message))
(defun yammer-reply-to-message (message)
"Reply to message at point"
(interactive "sReply to message: ")
(yammer-internal-post-message message (yammer-current-id)))
(defun yammer-delete-message ()
"Delete message at point"
(let ((beg) (line)
(url-request-method "DELETE")
(delete-url (format "%s%s" yammer-delete-url-base (yammer-current-id))))
(set-buffer (oauth-url-retrieve yammer-access-token delete-url))
(setq beg (point))
(setq line (buffer-substring beg (point)))
(if (string-match "200 OK" line) (message "Message Deleted!")
(error "Problem deleting message: %s" line))))
(defun hash-val (key alist)
(cdr (assq key alist)))
(defvar yammer-id-positions nil
"Ordered list of (position . id) pairs")
(defvar yammer-show-icons nil)
(defvar yammer-user-list nil)
(defvar yammer-tmp-dir
(expand-file-name (concat "yammer-images") temporary-file-directory))
(defun yammer-fetch-images ()
(let ((images (remove-if
(lambda (url)
(file-exists-p (concat yammer-tmp-dir "/" (yammer-image-name-url))))
(lambda (user) (hash-val 'mugshot_url user))
(if (not (file-directory-p yammer-tmp-dir))
(make-directory yammer-tmp-dir))
(apply 'call-process "wget" nil nil nil
(format "--directory-prefix=%s" yammer-tmp-dir)
(defun yammer-image-name (url)
(string-match ".*/\\(.*\\)$" url)
(match-string 1 url))
(defun yammer-list-messages ()
"List recent posts"
(set-buffer (oauth-fetch-url yammer-access-token yammer-list-url))
(goto-char (point-min))
(replace-string "\r" "")
(goto-char (point-min))
(delete-region (point-min) (search-forward "\n\n"))
(let ((references) (messages)
(find-user (lambda (id)
(find-if (lambda (user) (eq (hash-val 'id user) id))
(get-username (lambda (id)
(hash-val 'full_name (funcall find-user id))))
(raw (json-read-from-string
(buffer-substring (point-min) (point-max)))))
(setq references (assq 'references raw))
(setq yammer-user-list
(remove-if-not (lambda (ref)
(equal (hash-val 'type ref) "user"))
(cdr references)))
(if yammer-show-icons (yammer-fetch-images))
(setq messages (assq 'messages raw))
(switch-to-buffer (get-buffer-create "*yammer-messages*"))
(setq buffer-read-only nil)
(setq yammer-id-positions nil)
(let ((message-alist-by-thread))
(loop for yamm across (cdr messages) do
(push `(,(hash-val 'id yamm) ,yamm)
(loop for yamm across (cdr messages) do
(push `(,(point), (hash-val 'id yamm)) yammer-id-positions)
(when yammer-show-icons
(let ((filename (yammer-image-name
(funcall find-user
(hash-val 'sender_id yamm))))))
(insert-image-file (concat yammer-tmp-dir "/" filename))
(insert "\n")))
(insert (format
"%s%s: %s\n\n\tAbout %s from %s\n------------\n"
(funcall get-username (hash-val 'sender_id yamm))
(let ((reply-id (hash-val 'replied_to_id yamm))
(when reply-id
(setq post
(car (hash-val reply-id
(when post
" in reply to "
(funcall get-username
(hash-val 'sender_id post))))) ""))
(hash-val 'plain (hash-val 'body yamm)))
(hash-val 'created_at yamm)))
(hash-val 'client_type yamm))))))
(defun yammer-display-current-id ()
(message "id: %s" (yammer-current-id)))
(defun yammer-current-id ()
(lambda (item) (<= (car item) (point))) yammer-id-positions))))
(defun yammer-parse-date (date-string)
"Returns a emacs date for the given time string like what `encode-time' returns"
(apply 'encode-time
(mapcar (lambda (val)
(if (null val) 1 val))
(replace-regexp-in-string "/" "-" date-string)))))
(defun yammer-pretty-date (date)
"Pretty relative time"
(let* ((now (float-time (current-time)))
(post-time (float-time date))
(time-diff (ftruncate (/ (- now post-time) 60))))
((< time-diff 1) "1 minute ago")
((< time-diff 60) (format "%d minutes ago" time-diff))
((< time-diff 120) "1 hour ago")
((< time-diff (* 24 60)) (format "%d hours ago" (/ time-diff 60)))
((< time-diff (* 48 60)) "1 day ago")
((< time-diff (* 7 24 60)) (format "%d days ago" (/ time-diff 60 24)))
(t (format-time-string "%D %I:%M" date)))))
(define-derived-mode yammer-messages-mode fundamental-mode
"Viewing Yammer messages."
(setq buffer-read-only t)
(define-key yammer-messages-mode-map "i" 'yammer-display-current-id)
(define-key yammer-messages-mode-map "p" 'yammer-post-message)
(define-key yammer-messages-mode-map "r" 'yammer-reply-to-message)
(define-key yammer-messages-mode-map "d" 'yammer-delete-message)
(define-key yammer-messages-mode-map "R" 'yammer-list-messages)
(define-key yammer-messages-mode-map "l" 'yammer-list-messages)
(set (make-local-variable 'font-lock-defaults)
(defvar yammer-font-lock-keywords-1
'("^\\(Bear:\\) \\(.*\\) r[0-9]+"
(1 font-lock-comment-face)
(2 font-lock-builtin-face))
'("^\\(.+\\) \\(in reply to\\) \\([^:]+\\):"
(1 font-lock-builtin-face)
(2 font-lock-type-face)
(3 font-lock-builtin-face))
'("^\\([[:word:]]+ ?[[:word:]]*\\):" .
'("^[ \t]+About [[:digit:]]+ [[:word:]]+ ago from .*" .
(defvar yammer-font-lock-keywords
"Default highlighting for yammer mode")
;; (yammer-authenticate unix-user-name)
(provide 'yammer)
;;; yammer.el ends here