473 lines
17 KiB
EmacsLisp
473 lines
17 KiB
EmacsLisp
|
;;; slack-room.el --- slack generic room interface -*- lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2015 南優也
|
||
|
|
|
||
|
|
;; Author: 南優也 <yuyaminami@minamiyuunari-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-request)
|
||
|
|
(require 'slack-message)
|
||
|
|
|
||
|
|
(defvar slack-current-room-id)
|
||
|
|
(defvar slack-current-team-id)
|
||
|
|
(defvar slack-buffer-function)
|
||
|
|
(defconst slack-room-pins-list-url "https://slack.com/api/pins.list")
|
||
|
|
|
||
|
|
(defclass slack-room ()
|
||
|
|
((name :initarg :name :type string)
|
||
|
|
(id :initarg :id)
|
||
|
|
(created :initarg :created)
|
||
|
|
(has-pins :initarg :has_pins)
|
||
|
|
(last-read :initarg :last_read :type string :initform "0")
|
||
|
|
(latest :initarg :latest)
|
||
|
|
(oldest :initarg :oldest)
|
||
|
|
(unread-count :initarg :unread_count)
|
||
|
|
(unread-count-display :initarg :unread_count_display :initform 0 :type integer)
|
||
|
|
(messages :initarg :messages :initform ())
|
||
|
|
(team-id :initarg :team-id)))
|
||
|
|
|
||
|
|
(defgeneric slack-room-name (room))
|
||
|
|
(defgeneric slack-room-history (room team &optional oldest after-success sync))
|
||
|
|
(defgeneric slack-room-update-mark-url (room))
|
||
|
|
|
||
|
|
(defun slack-room-create (payload team class)
|
||
|
|
(cl-labels
|
||
|
|
((prepare (p)
|
||
|
|
(plist-put p :members
|
||
|
|
(append (plist-get p :members) nil))
|
||
|
|
(plist-put p :latest
|
||
|
|
(slack-message-create (plist-get p :latest)))
|
||
|
|
(plist-put p :team-id (oref team id))
|
||
|
|
p))
|
||
|
|
(let ((attributes (slack-collect-slots class (prepare payload))))
|
||
|
|
(apply #'make-instance class attributes))))
|
||
|
|
|
||
|
|
(defmethod slack-room-subscribedp ((_room slack-room) _team)
|
||
|
|
nil)
|
||
|
|
|
||
|
|
(defmethod slack-room-buffer-name ((room slack-room))
|
||
|
|
(concat "*Slack*"
|
||
|
|
" : "
|
||
|
|
(slack-room-name-with-team-name room)))
|
||
|
|
|
||
|
|
(cl-defmacro slack-room-request-update (room team url latest after-success sync)
|
||
|
|
`(cl-labels
|
||
|
|
((on-request-update
|
||
|
|
(&key data &allow-other-keys)
|
||
|
|
(slack-request-handle-error
|
||
|
|
(data "slack-room-request-update")
|
||
|
|
(let* ((datum (plist-get data :messages))
|
||
|
|
(messages
|
||
|
|
(cl-loop for data across datum
|
||
|
|
collect (slack-message-create data :room ,room))))
|
||
|
|
(if ,latest
|
||
|
|
(slack-room-set-prev-messages ,room messages)
|
||
|
|
(slack-room-set-messages ,room messages)
|
||
|
|
(slack-room-update-last-read
|
||
|
|
room
|
||
|
|
(make-instance 'slack-message :ts "0")))
|
||
|
|
(if (and ,after-success
|
||
|
|
(functionp ,after-success))
|
||
|
|
(funcall ,after-success))))))
|
||
|
|
(slack-request
|
||
|
|
,url
|
||
|
|
,team
|
||
|
|
:params (list (cons "channel" (oref ,room id))
|
||
|
|
(if ,latest
|
||
|
|
(cons "latest" ,latest)))
|
||
|
|
:success #'on-request-update
|
||
|
|
:sync (if ,sync t nil))))
|
||
|
|
|
||
|
|
(cl-defun slack-room-make-buffer-with-room (room team &key update)
|
||
|
|
(with-slots (messages latest) room
|
||
|
|
(if (or update (< (length messages) 1))
|
||
|
|
(slack-room-history room team))
|
||
|
|
(funcall slack-buffer-function
|
||
|
|
(slack-buffer-create room team))))
|
||
|
|
|
||
|
|
(cl-defmacro slack-select-from-list ((alist prompt) &body body)
|
||
|
|
"Bind candidates from selected."
|
||
|
|
(let ((key (cl-gensym)))
|
||
|
|
`(let* ((,key (let ((completion-ignore-case t))
|
||
|
|
(completing-read (format "%s" ,prompt)
|
||
|
|
,alist nil t)))
|
||
|
|
(selected (cdr (cl-assoc ,key ,alist :test #'string=))))
|
||
|
|
,@body
|
||
|
|
selected)))
|
||
|
|
|
||
|
|
(defun slack-room-select (rooms)
|
||
|
|
(let* ((alist (slack-room-names
|
||
|
|
rooms
|
||
|
|
#'(lambda (rs)
|
||
|
|
(cl-remove-if #'(lambda (r)
|
||
|
|
(or (not (slack-room-member-p r))
|
||
|
|
(slack-room-archived-p r)
|
||
|
|
(not (slack-room-open-p r))))
|
||
|
|
rs)))))
|
||
|
|
(slack-select-from-list
|
||
|
|
(alist "Select Channel: ")
|
||
|
|
(slack-room-make-buffer-with-room
|
||
|
|
selected
|
||
|
|
(slack-team-find (oref selected team-id))
|
||
|
|
:update nil))))
|
||
|
|
|
||
|
|
(cl-defun slack-room-list-update (url success team &key (sync t))
|
||
|
|
(slack-request
|
||
|
|
url
|
||
|
|
team
|
||
|
|
:success success
|
||
|
|
:sync sync))
|
||
|
|
|
||
|
|
(defun slack-room-update-messages ()
|
||
|
|
(interactive)
|
||
|
|
(unless (and (boundp 'slack-current-room-id)
|
||
|
|
(boundp 'slack-current-team-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))
|
||
|
|
(cur-point (point)))
|
||
|
|
(slack-room-history room team)
|
||
|
|
(slack-buffer-create
|
||
|
|
room team :insert-func
|
||
|
|
#'(lambda (room team)
|
||
|
|
(slack-buffer-widen
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
(delete-region (point-min) (marker-position lui-output-marker))))
|
||
|
|
(slack-buffer-insert-previous-link room)
|
||
|
|
(slack-buffer-insert-messages room team)
|
||
|
|
(goto-char cur-point)))))
|
||
|
|
|
||
|
|
(defmethod slack-room-render-prev-messages ((room slack-room) team
|
||
|
|
oldest ts)
|
||
|
|
(slack-buffer-create
|
||
|
|
room team
|
||
|
|
:insert-func
|
||
|
|
#'(lambda (room team)
|
||
|
|
(slack-buffer-widen
|
||
|
|
(let ((inhibit-read-only t)
|
||
|
|
(loading-message-end
|
||
|
|
(slack-buffer-ts-eq (point-min) (point-max) oldest)))
|
||
|
|
(delete-region (point-min) loading-message-end)
|
||
|
|
(slack-buffer-insert-prev-messages room team oldest)))
|
||
|
|
(slack-buffer-goto ts))))
|
||
|
|
|
||
|
|
(defmethod slack-room-prev-link-info ((room slack-room))
|
||
|
|
(with-slots (oldest) room
|
||
|
|
(if oldest
|
||
|
|
(oref oldest ts))))
|
||
|
|
|
||
|
|
(defun slack-room-load-prev-messages ()
|
||
|
|
(interactive)
|
||
|
|
(let* ((cur-point (point))
|
||
|
|
(ts (get-text-property (next-single-property-change cur-point 'ts)
|
||
|
|
'ts))
|
||
|
|
(oldest (ignore-errors (get-text-property 0 'oldest
|
||
|
|
(thing-at-point 'line))))
|
||
|
|
(current-team (slack-team-find slack-current-team-id))
|
||
|
|
(current-room (slack-room-find slack-current-room-id
|
||
|
|
current-team)))
|
||
|
|
(slack-room-history current-room
|
||
|
|
current-team
|
||
|
|
oldest
|
||
|
|
#'(lambda ()
|
||
|
|
(slack-room-render-prev-messages current-room
|
||
|
|
current-team
|
||
|
|
oldest ts)))))
|
||
|
|
|
||
|
|
(defun slack-room-find-message (room ts)
|
||
|
|
(cl-find-if #'(lambda (m) (string= ts (oref m ts)))
|
||
|
|
(oref room messages)
|
||
|
|
:from-end t))
|
||
|
|
|
||
|
|
(defmethod slack-room-name-with-team-name ((room slack-room))
|
||
|
|
(with-slots (team-id name) room
|
||
|
|
(let ((team (slack-team-find team-id)))
|
||
|
|
(format "%s - %s" (oref team name) name))))
|
||
|
|
|
||
|
|
(defmacro slack-room-names (rooms &optional filter)
|
||
|
|
`(cl-labels
|
||
|
|
((latest-ts (room)
|
||
|
|
(with-slots (latest) room
|
||
|
|
(if latest (oref latest ts) "0")))
|
||
|
|
(unread-count (room)
|
||
|
|
(with-slots (unread-count-display) room
|
||
|
|
(if (< 0 unread-count-display)
|
||
|
|
(concat "("
|
||
|
|
(number-to-string unread-count-display)
|
||
|
|
")")
|
||
|
|
"")))
|
||
|
|
(sort-rooms (rooms)
|
||
|
|
(nreverse
|
||
|
|
(cl-sort rooms #'string<
|
||
|
|
:key #'(lambda (name-with-room) (latest-ts (cdr name-with-room))))))
|
||
|
|
(build-label (room)
|
||
|
|
(concat (im-presence room)
|
||
|
|
(format "%s %s"
|
||
|
|
(slack-room-name-with-team-name room)
|
||
|
|
(unread-count room))))
|
||
|
|
(im-presence (room)
|
||
|
|
(if (object-of-class-p room 'slack-im)
|
||
|
|
(slack-im-user-presence room)
|
||
|
|
" "))
|
||
|
|
(build-cons (room)
|
||
|
|
(cons (build-label room) room)))
|
||
|
|
(sort-rooms
|
||
|
|
(cl-loop for room in (if ,filter
|
||
|
|
(funcall ,filter ,rooms)
|
||
|
|
,rooms)
|
||
|
|
collect (cons (build-label room) room)))))
|
||
|
|
|
||
|
|
(defmethod slack-room-name ((room slack-room))
|
||
|
|
(oref room name))
|
||
|
|
|
||
|
|
(defmethod slack-room-update-last-read ((room slack-room) msg)
|
||
|
|
(with-slots (ts) msg
|
||
|
|
(oset room last-read ts)))
|
||
|
|
|
||
|
|
(defmethod slack-room-latest-messages ((room slack-room) messages)
|
||
|
|
(with-slots (last-read) room
|
||
|
|
(cl-remove-if #'(lambda (m)
|
||
|
|
(or (string< (oref m ts) last-read)
|
||
|
|
(string= (oref m ts) last-read)))
|
||
|
|
messages)))
|
||
|
|
|
||
|
|
(defun slack-room-sort-messages (messages)
|
||
|
|
(cl-sort messages
|
||
|
|
#'string<
|
||
|
|
:key #'(lambda (m) (oref m ts))))
|
||
|
|
|
||
|
|
(defmethod slack-room-sorted-messages ((room slack-room))
|
||
|
|
(with-slots (messages) room
|
||
|
|
(slack-room-sort-messages (copy-sequence messages))))
|
||
|
|
|
||
|
|
(defmethod slack-room-set-prev-messages ((room slack-room) prev-messages)
|
||
|
|
(slack-room-set-messages
|
||
|
|
room
|
||
|
|
(cl-delete-duplicates (append (oref room messages)
|
||
|
|
prev-messages)
|
||
|
|
:test #'slack-message-equal)))
|
||
|
|
|
||
|
|
(defmethod slack-room-set-messages ((room slack-room) m)
|
||
|
|
(let ((sorted (slack-room-sort-messages m)))
|
||
|
|
(oset room oldest (car sorted))
|
||
|
|
(oset room messages sorted)
|
||
|
|
(oset room latest (car (last sorted)))))
|
||
|
|
|
||
|
|
(defmethod slack-room-prev-messages ((room slack-room) from)
|
||
|
|
(with-slots (messages) room
|
||
|
|
(cl-remove-if #'(lambda (m)
|
||
|
|
(or (string< from (oref m ts))
|
||
|
|
(string= from (oref m ts))))
|
||
|
|
(slack-room-sort-messages (copy-sequence messages)))))
|
||
|
|
|
||
|
|
(defmethod slack-room-update-mark ((room slack-room) team msg)
|
||
|
|
(cl-labels ((on-update-mark (&key data &allow-other-keys)
|
||
|
|
(slack-request-handle-error
|
||
|
|
(data "slack-room-update-mark"))))
|
||
|
|
(with-slots (ts) msg
|
||
|
|
(with-slots (id) room
|
||
|
|
(slack-request
|
||
|
|
(slack-room-update-mark-url room)
|
||
|
|
team
|
||
|
|
:type "POST"
|
||
|
|
:params (list (cons "channel" id)
|
||
|
|
(cons "ts" ts))
|
||
|
|
:success #'on-update-mark
|
||
|
|
:sync nil)))))
|
||
|
|
|
||
|
|
(defun slack-room-pins-list ()
|
||
|
|
(interactive)
|
||
|
|
(unless (and (bound-and-true-p slack-current-room-id)
|
||
|
|
(bound-and-true-p slack-current-team-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))
|
||
|
|
(channel (oref room id)))
|
||
|
|
(cl-labels ((on-pins-list (&key data &allow-other-keys)
|
||
|
|
(slack-request-handle-error
|
||
|
|
(data "slack-room-pins-list")
|
||
|
|
(slack-room-on-pins-list
|
||
|
|
(plist-get data :items)
|
||
|
|
room team))))
|
||
|
|
(slack-request
|
||
|
|
slack-room-pins-list-url
|
||
|
|
team
|
||
|
|
:params (list (cons "channel" channel))
|
||
|
|
:success #'on-pins-list
|
||
|
|
:sync nil))))
|
||
|
|
|
||
|
|
(defun slack-room-on-pins-list (items room team)
|
||
|
|
(cl-labels ((buffer-name (room)
|
||
|
|
(concat "*Slack - Pinned Items*"
|
||
|
|
" : "
|
||
|
|
(slack-room-name-with-team-name room))))
|
||
|
|
(let* ((messages (mapcar #'slack-message-create
|
||
|
|
(mapcar #'(lambda (i)
|
||
|
|
(plist-get i :message))
|
||
|
|
items)))
|
||
|
|
(buf-header (propertize "Pinned Items"
|
||
|
|
'face '(:underline
|
||
|
|
t
|
||
|
|
:weight bold))))
|
||
|
|
(funcall slack-buffer-function
|
||
|
|
(slack-buffer-create-info
|
||
|
|
(buffer-name room)
|
||
|
|
#'(lambda ()
|
||
|
|
(insert buf-header)
|
||
|
|
(insert "\n\n")
|
||
|
|
(mapc #'(lambda (m) (insert
|
||
|
|
(slack-message-to-string m)))
|
||
|
|
messages)))
|
||
|
|
team))))
|
||
|
|
|
||
|
|
(defun slack-select-rooms ()
|
||
|
|
(interactive)
|
||
|
|
(let ((team (slack-team-select)))
|
||
|
|
(slack-room-select
|
||
|
|
(cl-loop for team in (list team)
|
||
|
|
append (with-slots (groups ims channels) team
|
||
|
|
(append ims groups channels))))))
|
||
|
|
|
||
|
|
(defun slack-create-room (url team success)
|
||
|
|
(slack-request
|
||
|
|
url
|
||
|
|
team
|
||
|
|
:type "POST"
|
||
|
|
:params (list (cons "name" (read-from-minibuffer "Name: ")))
|
||
|
|
:success success
|
||
|
|
:sync nil))
|
||
|
|
|
||
|
|
(defun slack-room-rename (url room-alist-func)
|
||
|
|
(cl-labels
|
||
|
|
((on-rename-success (&key data &allow-other-keys)
|
||
|
|
(slack-request-handle-error
|
||
|
|
(data "slack-room-rename"))))
|
||
|
|
(let* ((team (slack-team-select))
|
||
|
|
(room-alist (funcall room-alist-func team))
|
||
|
|
(room (slack-select-from-list
|
||
|
|
(room-alist "Select Channel: ")))
|
||
|
|
(name (read-from-minibuffer "New Name: ")))
|
||
|
|
(slack-request
|
||
|
|
url
|
||
|
|
team
|
||
|
|
:params (list (cons "channel" (oref room id))
|
||
|
|
(cons "name" name))
|
||
|
|
:success #'on-rename-success
|
||
|
|
:sync nil))))
|
||
|
|
|
||
|
|
(defmacro slack-current-room-or-select (room-alist-func)
|
||
|
|
`(if (and (boundp 'slack-current-room-id)
|
||
|
|
(boundp 'slack-current-team-id))
|
||
|
|
(slack-room-find slack-current-room-id
|
||
|
|
(slack-team-find slack-current-team-id))
|
||
|
|
(let* ((room-alist (funcall ,room-alist-func)))
|
||
|
|
(slack-select-from-list
|
||
|
|
(room-alist "Select Channel: ")))))
|
||
|
|
|
||
|
|
(defmacro slack-room-invite (url room-alist-func)
|
||
|
|
`(cl-labels
|
||
|
|
((on-group-invite (&key data &allow-other-keys)
|
||
|
|
(slack-request-handle-error
|
||
|
|
(data "slack-room-invite")
|
||
|
|
(if (plist-get data :already_in_group)
|
||
|
|
(message "User already in group")
|
||
|
|
(message "Invited!")))))
|
||
|
|
(let* ((team (slack-team-select))
|
||
|
|
(room (slack-current-room-or-select
|
||
|
|
#'(lambda ()
|
||
|
|
(funcall ,room-alist-func team
|
||
|
|
#'(lambda (rooms)
|
||
|
|
(cl-remove-if #'slack-room-archived-p
|
||
|
|
rooms))))))
|
||
|
|
(user-id (plist-get (slack-select-from-list
|
||
|
|
((slack-user-names team)
|
||
|
|
"Select User: ")) :id)))
|
||
|
|
(slack-request
|
||
|
|
,url
|
||
|
|
team
|
||
|
|
:params (list (cons "channel" (oref room id))
|
||
|
|
(cons "user" user-id))
|
||
|
|
:success #'on-group-invite
|
||
|
|
:sync nil))))
|
||
|
|
|
||
|
|
(defmethod slack-room-member-p ((_room slack-room))
|
||
|
|
t)
|
||
|
|
|
||
|
|
(defmethod slack-room-archived-p ((_room slack-room))
|
||
|
|
nil)
|
||
|
|
|
||
|
|
(defmethod slack-room-open-p ((_room slack-room))
|
||
|
|
t)
|
||
|
|
|
||
|
|
(defmethod slack-room-equal-p ((room slack-room) other)
|
||
|
|
(with-slots (id) room
|
||
|
|
(with-slots ((other-id id)) other
|
||
|
|
(string= id other-id))))
|
||
|
|
|
||
|
|
(defun slack-room-deleted (id team)
|
||
|
|
(let ((room (slack-room-find id team)))
|
||
|
|
(cond
|
||
|
|
((object-of-class-p room 'slack-channel)
|
||
|
|
(with-slots (channels) team
|
||
|
|
(setq channels (cl-delete-if #'(lambda (c) (slack-room-equal-p room c))
|
||
|
|
channels)))
|
||
|
|
(message "Channel: %s deleted"
|
||
|
|
(slack-room-name-with-team-name room))))))
|
||
|
|
|
||
|
|
(cl-defun slack-room-request-with-id (url id team success)
|
||
|
|
(slack-request
|
||
|
|
url
|
||
|
|
team
|
||
|
|
:params (list (cons "channel" id))
|
||
|
|
:success success
|
||
|
|
:sync nil))
|
||
|
|
|
||
|
|
(defmethod slack-room-history ((room slack-room) team
|
||
|
|
&optional
|
||
|
|
oldest
|
||
|
|
after-success
|
||
|
|
async)
|
||
|
|
(slack-room-request-update room
|
||
|
|
team
|
||
|
|
(slack-room-history-url room)
|
||
|
|
oldest
|
||
|
|
after-success
|
||
|
|
(if async nil t)))
|
||
|
|
|
||
|
|
(defmethod slack-room-inc-unread-count ((room slack-room))
|
||
|
|
(cl-incf (oref room unread-count-display)))
|
||
|
|
|
||
|
|
(defun slack-room-find-by-name (name team)
|
||
|
|
(cl-labels
|
||
|
|
((find-by-name (rooms name)
|
||
|
|
(cl-find-if #'(lambda (e) (string= name
|
||
|
|
(slack-room-name e)))
|
||
|
|
rooms)))
|
||
|
|
(or (find-by-name (oref team groups) name)
|
||
|
|
(find-by-name (oref team channels) name)
|
||
|
|
(find-by-name (oref team ims) name))))
|
||
|
|
|
||
|
|
(provide 'slack-room)
|
||
|
|
;;; slack-room.el ends here
|