;;; slack-util.el ---utility functions -*- lexical-binding: t; -*- ;; Copyright (C) 2015 yuya.minami ;; Author: yuya.minami ;; 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 . ;;; 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