about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/slack-20180712.2222/slack-util.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/slack-20180712.2222/slack-util.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/slack-20180712.2222/slack-util.el471
1 files changed, 471 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/slack-20180712.2222/slack-util.el b/configs/shared/emacs/.emacs.d/elpa/slack-20180712.2222/slack-util.el
new file mode 100644
index 000000000000..37c154d9887b
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/slack-20180712.2222/slack-util.el
@@ -0,0 +1,471 @@
+;;; 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