;;; 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
