my-emacs-d/elpa/slack-20160928.2036/slack-message.el

296 lines
12 KiB
EmacsLisp

;;; slack-message.el --- slack-message -*- lexical-binding: t; -*-
;; Copyright (C) 2015 yuya.minami
;; Author: yuya.minami <yuya.minami@yuyaminami-no-MacBook-Pro.local>
;; Keywords:
;; 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 of the License, 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'slack-util)
(require 'slack-reaction)
(defvar slack-current-room-id)
(defvar slack-current-team-id)
(defconst slack-message-pins-add-url "https://slack.com/api/pins.add")
(defconst slack-message-pins-remove-url "https://slack.com/api/pins.remove")
(defconst slack-message-delete-url "https://slack.com/api/chat.delete")
(defclass slack-message ()
((type :initarg :type :type string)
(subtype :initarg :subtype)
(channel :initarg :channel :initform nil)
(ts :initarg :ts :type string :initform "")
(text :initarg :text :type (or null string) :initform nil)
(item-type :initarg :item_type)
(attachments :initarg :attachments :type (or null list) :initform nil)
(reactions :initarg :reactions :type (or null list))
(is-starred :initarg :is_starred :type boolean)
(pinned-to :initarg :pinned_to :type (or null list))
(edited-at :initarg :edited-at :initform nil)
(deleted-at :initarg :deleted-at :initform nil)))
(defclass slack-file-message (slack-message)
((file :initarg :file)
;; (bot-id :initarg :bot_id :type (or null string))
;; (username :initarg :username)
;; (display-as-bot :initarg :display_as_bot)
(upload :initarg :upload)
(user :initarg :user :initform nil)))
(defclass slack-reply (slack-message)
((user :initarg :user :initform nil)
(reply-to :initarg :reply_to :type integer)
(id :initarg :id :type integer)))
(defclass slack-user-message (slack-message)
((user :initarg :user :type string)
(edited :initarg :edited)
(id :initarg :id)
(inviter :initarg :inviter)))
(defclass slack-bot-message (slack-message)
((bot-id :initarg :bot_id :type string)
(username :initarg :username :type string :initform "")
(icons :initarg :icons)))
(defclass slack-attachment ()
((fallback :initarg :fallback :initform nil)
(title :initarg :title :initform nil)
(title-link :initarg :title_link :initform nil)
(pretext :initarg :pretext :initform nil)
(text :initarg :text :initform nil)
(author-name :initarg :author_name)
(author-link :initarg :author_link)
(author-icon :initarg :author_icon)
(fields :initarg :fields :type (or null list))
(image-url :initarg :image_url)
(thumb-url :initarg :thumb_url)
(is-share :initarg :is_share :initform nil)))
(defclass slack-shared-message (slack-attachment)
((ts :initarg :ts :initform nil)
(color :initarg :color :initform nil)
(channel-id :initarg :channel_id :initform nil)
(channel-name :initarg :channel_name :initform nil)
(from-url :initarg :from_url :initform nil)))
(defgeneric slack-message-sender-name (slack-message team))
(defgeneric slack-message-to-string (slack-message))
(defgeneric slack-message-to-alert (slack-message))
(defgeneric slack-room-buffer-name (room))
(defun slack-room-find (id team)
(if (and id team)
(cl-labels ((find-room (room)
(string= id (oref room id))))
(cond
((string-prefix-p "F" id) (slack-file-room-obj team))
((string-prefix-p "C" id) (cl-find-if #'find-room
(oref team channels)))
((string-prefix-p "G" id) (cl-find-if #'find-room
(oref team groups)))
((string-prefix-p "D" id) (cl-find-if #'find-room
(oref team ims)))
((string-prefix-p "Q" id) (cl-find-if #'find-room
(oref team search-results)))))))
(defun slack-reaction-create (payload)
(apply #'slack-reaction "reaction"
(slack-collect-slots 'slack-reaction payload)))
(defmethod slack-message-set-reactions ((m slack-message) payload)
(let ((reactions (plist-get payload :reactions)))
(if (< 0 (length reactions))
(oset m reactions (mapcar #'slack-reaction-create reactions))))
m)
(defun slack-attachment-create (payload)
(plist-put payload :fields
(append (plist-get payload :fields) nil))
(if (plist-get payload :is_share)
(apply #'slack-shared-message "shared-attachment"
(slack-collect-slots 'slack-shared-message payload))
(apply #'slack-attachment "attachment"
(slack-collect-slots 'slack-attachment payload))))
(defmethod slack-message-set-attachments ((m slack-message) payload)
(let ((attachments (plist-get payload :attachments)))
(if (< 0 (length attachments))
(oset m attachments
(mapcar #'slack-attachment-create attachments))))
m)
(cl-defun slack-message-create (payload &key room)
(when payload
(plist-put payload :reactions (append (plist-get payload :reactions) nil))
(plist-put payload :attachments (append (plist-get payload :attachments) nil))
(plist-put payload :pinned_to (append (plist-get payload :pinned_to) nil))
(if room
(plist-put payload :channel (oref room id)))
(cl-labels ((create
(m)
(let ((subtype (plist-get m :subtype)))
(cond
((plist-member m :reply_to)
(apply #'slack-reply "reply"
(slack-collect-slots 'slack-reply m)))
((and subtype (string-prefix-p "file" subtype))
(apply #'slack-file-message "file-msg"
(slack-collect-slots 'slack-file-message m)))
((plist-member m :user)
(apply #'slack-user-message "user-msg"
(slack-collect-slots 'slack-user-message m)))
((and subtype (string= "bot_message" subtype))
(apply #'slack-bot-message "bot-msg"
(slack-collect-slots 'slack-bot-message m)))))))
(let ((message (create payload)))
(when message
(slack-message-set-attachments message payload)
(slack-message-set-reactions message payload))))))
(defmethod slack-message-equal ((m slack-message) n)
(string= (oref m ts) (oref n ts)))
(defmethod slack-message-update ((m slack-message) team &optional replace no-notify)
(cl-labels
((push-message-to (room msg)
(with-slots (messages) room
(when (< 0 (length messages))
(cl-pushnew msg messages
:test #'slack-message-equal))
(update-latest room msg)))
(update-latest (room msg)
(with-slots (latest) room
(if (or (null latest)
(string< (oref latest ts) (oref msg ts)))
(setq latest msg)))))
(with-slots (channel) m
(let ((room (slack-room-find channel team)))
(when room
(push-message-to room m)
(slack-buffer-update room m team :replace replace)
(unless no-notify
(slack-message-notify m room team)))))))
(defun slack-message-edited (payload team)
(let* ((edited-message (slack-decode (plist-get payload :message)))
(room (slack-room-find (plist-get payload :channel) team))
(message (slack-room-find-message room
(plist-get edited-message :ts)))
(edited-info (plist-get edited-message :edited)))
(if message
(progn
(with-slots (text edited-at attachments) message
(setq text (plist-get edited-message :text))
(setq edited-at (plist-get edited-info :ts))
(if (plist-get edited-message :attachments)
(setq attachments
(mapcar #'slack-attachment-create
(plist-get edited-message :attachments)))))
(slack-message-update message team t)))))
(defmethod slack-message-sender-name ((m slack-message) team)
(slack-user-name (oref m user) team))
(defun slack-message-pins-add ()
(interactive)
(slack-message-pins-request slack-message-pins-add-url))
(defun slack-message-pins-remove ()
(interactive)
(slack-message-pins-request slack-message-pins-remove-url))
(defun slack-message-pins-request (url)
(unless (and (bound-and-true-p slack-current-team-id)
(bound-and-true-p slack-current-room-id))
(error "Call From Slack Room Buffer"))
(let* ((team (slack-team-find slack-current-team-id))
(room (slack-room-find slack-current-room-id
team))
(word (thing-at-point 'word))
(ts (ignore-errors (get-text-property 0 'ts word))))
(unless ts
(error "Call From Slack Room Buffer"))
(cl-labels ((on-pins-add
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message-pins-request"))))
(slack-request
url
team
:params (list (cons "channel" (oref room id))
(cons "timestamp" ts))
:success #'on-pins-add
:sync nil))))
(defun slack-message-time-stamp (message)
(seconds-to-time (string-to-number (oref message ts))))
(defun slack-message-delete ()
(interactive)
(unless (and (boundp 'slack-current-team-id)
(boundp 'slack-current-room-id))
(error "Call From Slack Room Buffer"))
(let* ((team (slack-team-find slack-current-team-id))
(channel (slack-room-find slack-current-room-id
team))
(ts (ignore-errors (get-text-property (point) 'ts))))
(unless ts
(error "Call With Cursor On Message"))
(let ((message (slack-room-find-message channel ts)))
(when message
(cl-labels
((on-delete
(&key data &allow-other-keys)
(slack-request-handle-error
(data "slack-message-delete"))))
(if (yes-or-no-p "Are you sure you want to delete this message?")
(slack-request
slack-message-delete-url
team
:type "POST"
:params (list (cons "ts" (oref message ts))
(cons "channel" (oref channel id)))
:success #'on-delete
:sync nil)
(message "Canceled")))))))
(defun slack-message-deleted (payload team)
(let* ((channel-id (plist-get payload :channel))
(ts (plist-get payload :deleted_ts))
(deleted-ts (plist-get payload :ts))
(channel (slack-room-find channel-id team))
(message (slack-room-find-message channel ts)))
(when message
(oset message deleted-at deleted-ts)
(alert "message deleted"
:title (format "\\[%s] from %s"
(slack-room-name-with-team-name channel)
(slack-message-sender-name message team))
:category 'slack)
(slack-buffer-update channel message team :replace t))))
(provide 'slack-message)
;;; slack-message.el ends here