diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-util.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-util.el | 481 |
1 files changed, 0 insertions, 481 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-util.el b/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-util.el deleted file mode 100644 index dd415a941d02..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-util.el +++ /dev/null @@ -1,481 +0,0 @@ -;;; 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)) - "LEVEL is one of 'trace, 'debug, 'info, 'warn, 'error" - (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 command in (oref slack-current-team commands) - if (string-prefix-p (concat "/" content) - (oref command name)) - collect (oref command name)) - )))) - (doc-buffer - (cl-case (prefix-type arg) - (slash - (company-doc-buffer - (let* ((team slack-current-team) - (command (slack-command-find arg team))) - (when command - (slack-command-company-doc-string command team)))))))))) - -(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 (and (display-graphic-p) 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 &optional pad no-token) - "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)))) - pad) - (propertize "[Image]" - 'slack-image-spec spec - 'no-token no-token)) - "") - "")) - -(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 &optional pad) - (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) - (format "\n%s" (or pad "")))))) - -(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 |