472 lines
19 KiB
EmacsLisp
472 lines
19 KiB
EmacsLisp
|
;;; slack-util.el ---utility functions -*- 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 'timer)
|
|||
|
(require 'diary-lib)
|
|||
|
|
|||
|
(defcustom slack-profile-image-file-directory temporary-file-directory
|
|||
|
"Default directory for slack profile images."
|
|||
|
:group 'slack)
|
|||
|
|
|||
|
(defcustom slack-image-file-directory temporary-file-directory
|
|||
|
"Default directory for slack images."
|
|||
|
:group 'slack)
|
|||
|
|
|||
|
(defcustom slack-image-max-height 300
|
|||
|
"Max Height of image. nil is unlimited. integer."
|
|||
|
:group 'slack)
|
|||
|
|
|||
|
(defconst slack-log-levels
|
|||
|
'(;; debugging
|
|||
|
(trace . 40) (debug . 30)
|
|||
|
;; information
|
|||
|
(info . 20)
|
|||
|
;; errors
|
|||
|
(warn . 10) (error . 0))
|
|||
|
"Named logging levels.")
|
|||
|
|
|||
|
(defcustom slack-log-level 'info
|
|||
|
"Used in `slack-message-logger'.
|
|||
|
One of 'info, 'debug"
|
|||
|
:group 'slack)
|
|||
|
|
|||
|
(defcustom slack-log-time-format
|
|||
|
"[%Y-%m-%d %H:%M:%S]"
|
|||
|
"Time format for log."
|
|||
|
:group 'slack)
|
|||
|
|
|||
|
(defalias 'slack-if-let*
|
|||
|
(if (fboundp 'if-let*)
|
|||
|
'if-let*
|
|||
|
'if-let))
|
|||
|
|
|||
|
(defun slack-seq-to-list (seq)
|
|||
|
(if (listp seq) seq (append seq nil)))
|
|||
|
|
|||
|
(defun slack-decode (seq)
|
|||
|
(cl-loop for e in (slack-seq-to-list seq)
|
|||
|
collect (if (stringp e)
|
|||
|
(decode-coding-string e 'utf-8)
|
|||
|
(if (listp e)
|
|||
|
(slack-decode e)
|
|||
|
e))))
|
|||
|
|
|||
|
(defun slack-class-have-slot-p (class slot)
|
|||
|
(and (symbolp slot)
|
|||
|
(let* ((stripped (substring (symbol-name slot) 1))
|
|||
|
(replaced (replace-regexp-in-string "_" "-"
|
|||
|
stripped))
|
|||
|
(symbolized (intern replaced)))
|
|||
|
(slot-exists-p class symbolized))))
|
|||
|
|
|||
|
(defun slack-collect-slots (class seq)
|
|||
|
(let ((plist (slack-seq-to-list seq)))
|
|||
|
(cl-loop for p in plist
|
|||
|
if (and (slack-class-have-slot-p class p)
|
|||
|
(plist-member plist p))
|
|||
|
nconc (let ((value (plist-get plist p)))
|
|||
|
(list p (if (stringp value)
|
|||
|
(decode-coding-string value 'utf-8)
|
|||
|
(if (eq :json-false value)
|
|||
|
nil
|
|||
|
value)))))))
|
|||
|
(defun slack-log-level-to-int (level)
|
|||
|
(slack-if-let* ((cell (cl-assoc level slack-log-levels)))
|
|||
|
(cdr cell)
|
|||
|
20))
|
|||
|
|
|||
|
|
|||
|
(defun slack-message-logger (message level team)
|
|||
|
"Display message using `message'."
|
|||
|
(let ((user-level (slack-log-level-to-int slack-log-level))
|
|||
|
(current-level (slack-log-level-to-int level)))
|
|||
|
(when (<= current-level user-level)
|
|||
|
(message (format "%s [%s] [%s] %s"
|
|||
|
(format-time-string slack-log-time-format)
|
|||
|
level
|
|||
|
(oref team name)
|
|||
|
message)))))
|
|||
|
|
|||
|
(cl-defun slack-log (msg team &key
|
|||
|
(logger #'slack-message-logger)
|
|||
|
(level 'debug))
|
|||
|
(let ((log (format "%s [%s] %s - %s"
|
|||
|
(format-time-string slack-log-time-format)
|
|||
|
level
|
|||
|
msg
|
|||
|
(oref team name)))
|
|||
|
(buf (get-buffer-create (slack-log-buffer-name team))))
|
|||
|
(when (functionp logger)
|
|||
|
(funcall logger msg level team))
|
|||
|
(with-current-buffer buf
|
|||
|
(setq buffer-read-only nil)
|
|||
|
(save-excursion
|
|||
|
(goto-char (point-max))
|
|||
|
(insert log)
|
|||
|
(insert "\n"))
|
|||
|
(setq buffer-read-only t))))
|
|||
|
|
|||
|
(defun company-slack-backend (command &optional arg &rest ignored)
|
|||
|
"Completion backend for slack chats. It currently understands
|
|||
|
@USER; adding #CHANNEL should be a simple matter of programming."
|
|||
|
(interactive (list 'interactive))
|
|||
|
(cl-labels
|
|||
|
((start-from-line-beginning (str)
|
|||
|
(let ((prompt-length (length lui-prompt-string)))
|
|||
|
(>= 0 (- (current-column) prompt-length (length str)))))
|
|||
|
(prefix-type (str) (cond
|
|||
|
((string-prefix-p "@" str) 'user)
|
|||
|
((string-prefix-p "#" str) 'channel)
|
|||
|
((and (string-prefix-p "/" str)
|
|||
|
(start-from-line-beginning str))
|
|||
|
'slash)))
|
|||
|
(content (str) (substring str 1 nil)))
|
|||
|
(cl-case command
|
|||
|
(interactive (company-begin-backend 'company-slack-backend))
|
|||
|
(prefix (when (string= "slack" (car (split-string (format "%s" major-mode) "-")))
|
|||
|
;; (cl-find major-mode '(slack-mode
|
|||
|
;; slack-edit-message-mode
|
|||
|
;; slack-thread-mode))
|
|||
|
(company-grab-line "\\(\\W\\|^\\)\\(@\\w*\\|#\\w*\\|/\\w*\\)"
|
|||
|
2)))
|
|||
|
(candidates (let ((content (content arg)))
|
|||
|
(cl-case (prefix-type arg)
|
|||
|
(user
|
|||
|
(cl-loop for user in (oref slack-current-team users)
|
|||
|
if (and (not (eq (plist-get user :deleted) t))
|
|||
|
(string-prefix-p content
|
|||
|
(plist-get user :name)))
|
|||
|
collect (concat "@" (plist-get user :name))))
|
|||
|
(channel
|
|||
|
(cl-loop for team in (oref slack-current-team channels)
|
|||
|
if (string-prefix-p content
|
|||
|
(oref team name))
|
|||
|
collect (concat "#" (oref team name))))
|
|||
|
(slash
|
|||
|
(cl-loop for com in slack-slash-commands-available
|
|||
|
if (string-prefix-p content com)
|
|||
|
collect (concat "/" com))
|
|||
|
))))
|
|||
|
(doc-buffer
|
|||
|
(cl-case (prefix-type arg)
|
|||
|
(slash
|
|||
|
(company-doc-buffer
|
|||
|
(documentation
|
|||
|
(slack-slash-commands-find (substring arg 1))
|
|||
|
t)))))
|
|||
|
)))
|
|||
|
|
|||
|
(defun slack-get-ts ()
|
|||
|
(get-text-property 0 'ts (thing-at-point 'line)))
|
|||
|
|
|||
|
(defun slack-linkfy (text link)
|
|||
|
(if (not (slack-string-blankp link))
|
|||
|
(format "<%s|%s>" link text)
|
|||
|
text))
|
|||
|
|
|||
|
(defun slack-string-blankp (str)
|
|||
|
(if str
|
|||
|
(> 1 (length str))
|
|||
|
t))
|
|||
|
|
|||
|
(defun slack-log-buffer-name (team)
|
|||
|
(format "*Slack Log - %s*" (slack-team-name team)))
|
|||
|
|
|||
|
(defun slack-log-open-buffer ()
|
|||
|
(interactive)
|
|||
|
(let ((team (slack-team-select)))
|
|||
|
(funcall slack-buffer-function (get-buffer-create (slack-log-buffer-name team)))))
|
|||
|
|
|||
|
(defun slack-event-log-buffer-name (team)
|
|||
|
(format "*Slack Event Log - %s*" (slack-team-name team)))
|
|||
|
|
|||
|
(defun slack-log-websocket-payload (payload team)
|
|||
|
(let* ((bufname (slack-event-log-buffer-name team))
|
|||
|
(buf (get-buffer-create bufname)))
|
|||
|
(when buf
|
|||
|
(with-current-buffer buf
|
|||
|
(setq buffer-read-only nil)
|
|||
|
(save-excursion
|
|||
|
(goto-char (point-max))
|
|||
|
(insert (format "[%s] %s\n"
|
|||
|
(format-time-string "%Y-%m-%d %H:%M:%S")
|
|||
|
payload)))
|
|||
|
(setq buffer-read-only t)))))
|
|||
|
|
|||
|
(defun slack-log-open-websocket-buffer ()
|
|||
|
(interactive)
|
|||
|
(if websocket-debug
|
|||
|
(progn
|
|||
|
(let* ((team (slack-team-select))
|
|||
|
(websocket (oref team ws-conn)))
|
|||
|
(if websocket
|
|||
|
(funcall slack-buffer-function
|
|||
|
(websocket-get-debug-buffer-create websocket))
|
|||
|
(error "Websocket is not connected"))))
|
|||
|
(error "`websocket-debug` is not t")))
|
|||
|
|
|||
|
(defun slack-log-open-event-buffer ()
|
|||
|
(interactive)
|
|||
|
(let* ((team (slack-team-select))
|
|||
|
(bufname (slack-event-log-buffer-name team))
|
|||
|
(buf (get-buffer bufname)))
|
|||
|
(if buf
|
|||
|
(funcall slack-buffer-function buf)
|
|||
|
(error "No Event Log Buffer"))))
|
|||
|
|
|||
|
(defun slack-profile-image-path (image-url team)
|
|||
|
(expand-file-name
|
|||
|
(concat (md5 (concat (slack-team-name team) "-" image-url))
|
|||
|
"."
|
|||
|
(file-name-extension image-url))
|
|||
|
slack-profile-image-file-directory))
|
|||
|
|
|||
|
(cl-defun slack-image--create (path &key (width nil) (height nil) (max-height nil) (max-width nil))
|
|||
|
(let* ((imagemagick-available-p (image-type-available-p 'imagemagick))
|
|||
|
(image (apply #'create-image (append (list path (and imagemagick-available-p 'imagemagick) nil)
|
|||
|
(if height (list :height height))
|
|||
|
(if width (list :width width))
|
|||
|
(if max-height
|
|||
|
(list :max-height max-height))
|
|||
|
(if max-width
|
|||
|
(list :max-width max-width))))))
|
|||
|
(if imagemagick-available-p
|
|||
|
(slack-image-shrink image max-height)
|
|||
|
image)))
|
|||
|
|
|||
|
(defun slack-image-exists-p (image-spec)
|
|||
|
(file-exists-p (slack-image-path (car image-spec))))
|
|||
|
|
|||
|
(defun slack-image-string (spec)
|
|||
|
"SPEC: (list URL WIDTH HEIGHT MAX-HEIGHT MAX-WIDTH)"
|
|||
|
(if spec
|
|||
|
(slack-if-let* ((path (slack-image-path (car spec))))
|
|||
|
(if (file-exists-p path)
|
|||
|
(slack-mapconcat-images
|
|||
|
(slack-image-slice
|
|||
|
(slack-image--create path
|
|||
|
:width (cadr spec)
|
|||
|
:height (caddr spec)
|
|||
|
:max-height (cadddr spec)
|
|||
|
:max-width (cadr (cdddr spec)))))
|
|||
|
(propertize "[Image]" 'slack-image-spec spec))
|
|||
|
"")
|
|||
|
""))
|
|||
|
|
|||
|
(defun slack-image-path (image-url)
|
|||
|
(and image-url
|
|||
|
(expand-file-name
|
|||
|
(concat (md5 image-url)
|
|||
|
"."
|
|||
|
(file-name-extension image-url))
|
|||
|
slack-image-file-directory)))
|
|||
|
|
|||
|
(defun slack-image-slice (image)
|
|||
|
(when image
|
|||
|
(let* ((line-height 50.0)
|
|||
|
(height (or (plist-get (cdr image) :height)
|
|||
|
(cdr (image-size image t))))
|
|||
|
(line-count (/ height line-height))
|
|||
|
(line (/ 1.0 line-count)))
|
|||
|
(if (< line-height height)
|
|||
|
(cl-loop for i from 0 to (- line-count 1)
|
|||
|
collect (list (list 'slice 0 (* line i) 1.0 line)
|
|||
|
image))
|
|||
|
(list image)))))
|
|||
|
|
|||
|
(defun slack-image-shrink (image &optional max-height)
|
|||
|
(unless (image-type-available-p 'imagemagick)
|
|||
|
(error "Need Imagemagick"))
|
|||
|
(if max-height
|
|||
|
(let* ((data (plist-get (cdr image) :data))
|
|||
|
(file (plist-get (cdr image) :file))
|
|||
|
(size (image-size image t))
|
|||
|
(height (cdr size))
|
|||
|
(width (car size))
|
|||
|
(h (min height max-height))
|
|||
|
(w (if (< max-height height)
|
|||
|
(ceiling
|
|||
|
(* (/ (float max-height) height)
|
|||
|
width))
|
|||
|
width)))
|
|||
|
(create-image (or file data) 'imagemagick data :height h :width w))
|
|||
|
image))
|
|||
|
|
|||
|
(defun slack-mapconcat-images (images)
|
|||
|
(when images
|
|||
|
(cl-labels ((sort-images (images)
|
|||
|
(let ((compare (if (or (and (eq system-type 'darwin) (< emacs-major-version 26))
|
|||
|
(< emacs-major-version 25))
|
|||
|
#'>
|
|||
|
#'<)))
|
|||
|
(cl-sort images compare :key #'(lambda (image) (caddr (car image))))))
|
|||
|
(propertize-image (image)
|
|||
|
(propertize "image"
|
|||
|
'display image
|
|||
|
'face 'slack-profile-image-face)))
|
|||
|
(mapconcat #'propertize-image (sort-images images) "\n"))))
|
|||
|
|
|||
|
(cl-defun slack-url-copy-file (url newname &key (success nil) (error nil) (sync nil) (token nil))
|
|||
|
(if (executable-find "curl")
|
|||
|
(slack-curl-downloader url newname
|
|||
|
:success success
|
|||
|
:error error
|
|||
|
:token token)
|
|||
|
(cl-labels
|
|||
|
((on-success (&key data &allow-other-keys)
|
|||
|
(when (functionp success) (funcall success)))
|
|||
|
(on-error (&key error-thrown symbol-status response data)
|
|||
|
(message "Error Fetching Image: %s %s %s, url: %s"
|
|||
|
(request-response-status-code response)
|
|||
|
error-thrown symbol-status url)
|
|||
|
(if (file-exists-p newname)
|
|||
|
(delete-file newname))
|
|||
|
(case (request-response-status-code response)
|
|||
|
(403 nil)
|
|||
|
(404 nil)
|
|||
|
(t (when (functionp error)
|
|||
|
(funcall error
|
|||
|
(request-response-status-code response)
|
|||
|
error-thrown
|
|||
|
symbol-status
|
|||
|
url)))))
|
|||
|
(parser () (mm-write-region (point-min) (point-max)
|
|||
|
newname nil nil nil 'binary t)))
|
|||
|
(let* ((url-obj (url-generic-parse-url url))
|
|||
|
(need-token-p (and url-obj
|
|||
|
(string-match-p "slack"
|
|||
|
(url-host url-obj))))
|
|||
|
(use-https-p (and url-obj
|
|||
|
(string= "https" (url-type url-obj)))))
|
|||
|
(request
|
|||
|
url
|
|||
|
:success #'on-success
|
|||
|
:error #'on-error
|
|||
|
:parser #'parser
|
|||
|
:sync sync
|
|||
|
:headers (if (and token use-https-p need-token-p)
|
|||
|
(list (cons "Authorization" (format "Bearer %s" token)))))))))
|
|||
|
|
|||
|
(defun slack-render-image (image team)
|
|||
|
(let ((buf (get-buffer-create
|
|||
|
(format "*Slack - %s Image*" (slack-team-name team)))))
|
|||
|
(with-current-buffer buf
|
|||
|
(setq buffer-read-only nil)
|
|||
|
(erase-buffer)
|
|||
|
(if image
|
|||
|
(insert (slack-mapconcat-images (slack-image-slice image)))
|
|||
|
(insert "Loading Image..."))
|
|||
|
(setq buffer-read-only t)
|
|||
|
(goto-char (point-min)))
|
|||
|
|
|||
|
buf))
|
|||
|
|
|||
|
(defun slack-parse-time-string (time)
|
|||
|
"TIME should be one of:
|
|||
|
- a string giving today’s time like \"11:23pm\"
|
|||
|
(the acceptable formats are HHMM, H:MM, HH:MM, HHam, HHAM,
|
|||
|
HHpm, HHPM, HH:MMam, HH:MMAM, HH:MMpm, or HH:MMPM;
|
|||
|
a period ‘.’ can be used instead of a colon ‘:’ to separate
|
|||
|
the hour and minute parts);
|
|||
|
- a string giving specific date and time like \"1991/03/23 03:00\";
|
|||
|
- a string giving a relative time like \"90\" or \"2 hours 35 minutes\"
|
|||
|
(the acceptable forms are a number of seconds without units
|
|||
|
or some combination of values using units in ‘timer-duration-words’);
|
|||
|
- a number of seconds from now;"
|
|||
|
(if (numberp time)
|
|||
|
(setq time (timer-relative-time nil time)))
|
|||
|
(if (stringp time)
|
|||
|
(let ((secs (timer-duration time)))
|
|||
|
(if secs
|
|||
|
(setq time (timer-relative-time nil secs)))))
|
|||
|
(if (stringp time)
|
|||
|
(progn
|
|||
|
(let* ((date-and-time (split-string time " "))
|
|||
|
(date (and (eq (length date-and-time) 2) (split-string (car date-and-time) "/")))
|
|||
|
(time-str (or (and (eq (length date-and-time) 2) (cadr date-and-time))
|
|||
|
(car date-and-time)))
|
|||
|
(hhmm (diary-entry-time time-str))
|
|||
|
(now (or (and date (decode-time
|
|||
|
(encode-time 0 0 0
|
|||
|
(string-to-number (nth 2 date))
|
|||
|
(string-to-number (nth 1 date))
|
|||
|
(string-to-number (nth 0 date))
|
|||
|
)))
|
|||
|
(decode-time))))
|
|||
|
(if (>= hhmm 0)
|
|||
|
(setq time
|
|||
|
(encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
|
|||
|
(nth 4 now) (nth 5 now) (nth 8 now)))))))
|
|||
|
time)
|
|||
|
|
|||
|
(defmacro slack-merge-list (old-list new-list)
|
|||
|
`(cl-loop for n in ,new-list
|
|||
|
do (let ((o (cl-find-if #'(lambda (e) (slack-equalp n e))
|
|||
|
,old-list)))
|
|||
|
(if o (slack-merge o n)
|
|||
|
(push n ,old-list)))))
|
|||
|
|
|||
|
(cl-defun slack-curl-downloader (url name &key (success nil) (error nil) (token nil))
|
|||
|
(cl-labels
|
|||
|
((sentinel (proc event)
|
|||
|
(cond
|
|||
|
((string-equal "finished\n" event)
|
|||
|
(when (functionp success) (funcall success)))
|
|||
|
(t
|
|||
|
(let ((status (process-status proc))
|
|||
|
(output (with-current-buffer (process-buffer proc)
|
|||
|
(buffer-substring-no-properties (point-min)
|
|||
|
(point-max)))))
|
|||
|
(if (functionp error)
|
|||
|
(funcall error status output url name)
|
|||
|
(message "Download Failed. STATUS: %s, EVENT: %s, URL: %s, NAME: %s, OUTPUT: %s"
|
|||
|
status
|
|||
|
event
|
|||
|
url
|
|||
|
name
|
|||
|
output))
|
|||
|
(if (file-exists-p name)
|
|||
|
(delete-file name))
|
|||
|
(delete-process proc))))))
|
|||
|
(let* ((url-obj (url-generic-parse-url url))
|
|||
|
(need-token-p (and url-obj
|
|||
|
(string-match-p "slack" (url-host url-obj))))
|
|||
|
(header (or (and token
|
|||
|
need-token-p
|
|||
|
(string-prefix-p "https" url)
|
|||
|
(format "-H 'Authorization: Bearer %s'" token))
|
|||
|
""))
|
|||
|
(output (format "--output '%s'" name))
|
|||
|
(command (format "curl --silent --show-error --fail --location %s %s '%s'" output header url))
|
|||
|
(proc (start-process-shell-command "slack-curl-downloader"
|
|||
|
"slack-curl-downloader"
|
|||
|
command)))
|
|||
|
(set-process-sentinel proc #'sentinel))))
|
|||
|
|
|||
|
(provide 'slack-util)
|
|||
|
;;; slack-util.el ends here
|