diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-buffer.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-buffer.el | 448 |
1 files changed, 448 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-buffer.el b/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-buffer.el new file mode 100644 index 000000000000..ea56844e177f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-buffer.el @@ -0,0 +1,448 @@ +;;; slack-buffer.el --- slack buffer -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 南優也 + +;; Author: 南優也 <yuyaminami@minamiyuunari-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 'lui) +(require 'slack-util) +(require 'slack-room) + +(define-derived-mode slack-buffer-mode lui-mode "Slack Buffer" + (setq-local default-directory slack-default-directory) + (add-hook 'lui-pre-output-hook 'slack-buffer-buttonize-link nil t) + (add-hook 'lui-pre-output-hook 'slack-add-face-lazy nil t) + (add-hook 'lui-post-output-hook 'slack-display-image t t) + (lui-set-prompt " ")) + +(defvar-local slack-current-buffer nil) + +(defclass slack-buffer () + ((team :initarg :team :type slack-team))) + +(defun slack-buffer-push-new-3 (class a team) + (let ((buf (get-buffer (slack-buffer-name class a team)))) + (unless (slack-buffer-find class a team) + (push buf + (slot-value team class))) + buf)) + +(defun slack-buffer-push-new-4 (class a b team) + (let ((buf (get-buffer (slack-buffer-name class a b team)))) + (unless (slack-buffer-find class a b team) + (push buf (slot-value team class))) + buf)) + +(defmethod slack-buffer-find :static ((class slack-buffer) room team) + (slack-if-let* ((buf (cl-find-if + #'(lambda (buf) + (string= (buffer-name buf) + (slack-buffer-name class room team))) + (slot-value team class)))) + (with-current-buffer buf slack-current-buffer))) + +(defmethod slack-buffer-buffer ((this slack-buffer)) + (or (get-buffer (slack-buffer-name this)) + (slack-buffer-init-buffer this))) + +(defmethod slack-buffer-display ((this slack-buffer)) + (condition-case err + (funcall slack-buffer-function (slack-buffer-buffer this)) + (error (progn + (slack-if-let* ((buf (get-buffer (slack-buffer-name this)))) + (kill-buffer buf)) + (signal (car err) (cdr err)))))) + +(defmethod slack-buffer-name ((this slack-buffer)) + "*Slack*") + +(defun slack-message-buffer-on-killed () + (slack-if-let* ((buf slack-current-buffer) + (class (eieio-object-class-name buf)) + (cb (current-buffer))) + (set-slot-value (oref buf team) class + (cl-remove-if #'(lambda (e) (equal e cb)) + (slot-value (oref buf team) class))))) + +(defun slack-buffer-replace-image (buffer ts) + (and (buffer-live-p buffer) + (with-current-buffer buffer + (slack-buffer--replace slack-current-buffer ts)))) + +(defun slack-display-image () + (goto-char (point-min)) + (while (re-search-forward "\\[Image\\]" (point-max) t) + (slack-if-let* ((spec (get-text-property (1- (point)) 'slack-image-spec)) + (end (point)) + (beg (previous-single-property-change end 'slack-image-spec)) + (cur-buffer (current-buffer)) + (url (car spec)) + (ts (get-text-property beg 'ts)) + (path (slack-image-path url))) + (let* ((no-token-p (get-text-property (1- (point)) 'no-token)) + (token (and (not no-token-p) + (oref (oref slack-current-buffer team) + token)))) + (cl-labels + ((on-success () + (slack-buffer-replace-image cur-buffer ts))) + (unless (file-exists-p path) + (slack-url-copy-file url + path + :success #'on-success + :token token))))))) + +(defmethod slack-buffer-init-buffer :after (this) + (slack-if-let* ((buf (get-buffer (slack-buffer-name this)))) + (progn + (with-current-buffer buf + (slack-buffer-enable-emojify) + (add-hook 'kill-buffer-hook 'slack-message-buffer-on-killed nil t)) + buf))) + +(defmethod slack-buffer-set-current-buffer ((this slack-buffer)) + (setq-local slack-current-buffer this)) + + +(defmethod slack-buffer-init-buffer ((this slack-buffer)) + (generate-new-buffer (slack-buffer-name this))) + +(defmethod slack-buffer-replace ((this slack-buffer) message) + (with-slots (team) this + (with-current-buffer (slack-buffer-buffer this) + (lui-replace (slack-message-to-string message team) + (lambda () + (equal (get-text-property (point) 'ts) + (slack-ts message))))))) + +(defun slack-buffer-subscribe-cursor-event (window prev-point type) + (slack-if-let* ((buffer slack-current-buffer)) + (progn + (slack-log (format "CURSOR-EVENT: BUFFER: %s, PREV-POINT: %s, POINT: %s, TYPE: %s" + (buffer-name (window-buffer window)) + prev-point + (point) + type) + (oref buffer team) + :level 'trace) + + (when (eq type 'entered) + (unless (slack-team-mark-as-read-immediatelyp (oref buffer team)) + (slack-buffer-update-mark buffer)) + (add-hook 'post-command-hook 'slack-reaction-echo-description t t)) + + (when (eq type 'left) + (remove-hook 'post-command-hook 'slack-reaction-echo-description t))))) + +(defmethod slack-buffer-insert ((this slack-buffer) message &optional not-tracked-p) + (let ((lui-time-stamp-time (slack-message-time-stamp message)) + (team (oref this team))) + (lui-insert-with-text-properties + (slack-message-to-string message team) + 'not-tracked-p not-tracked-p + 'ts (slack-ts message) + 'slack-last-ts lui-time-stamp-last + 'cursor-sensor-functions '(slack-buffer-subscribe-cursor-event)) + (lui-insert "" t) + )) + +(defmethod slack-buffer-insert-load-more ((this slack-buffer)) + (let ((str (propertize "(load more)\n" + 'face '(:underline t :weight bold) + 'keymap (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") + #'(lambda () + (interactive) + (slack-buffer-load-more this))) + map) + 'loading-message t))) + (let ((lui-time-stamp-position nil)) + (lui-insert str)))) + +(defmethod slack-buffer-loading-message-end-point ((this slack-buffer)) + (next-single-property-change (point-min) 'loading-message)) + +(defmethod slack-buffer-delete-load-more-string ((this slack-buffer)) + (let ((loading-message-end + (slack-buffer-loading-message-end-point this))) + (delete-region (point-min) loading-message-end))) + +(defmethod slack-buffer-prepare-marker-for-history ((_this slack-buffer)) + (set-marker lui-output-marker (point-min))) + +(defmethod slack-buffer-insert--history ((this slack-buffer)) + (if (slack-buffer-has-next-page-p this) + (slack-buffer-insert-load-more this) + (let ((lui-time-stamp-position nil)) + (lui-insert "(no more messages)\n"))) + + (slack-buffer-insert-history this)) + +(defmethod slack-buffer-load-more ((this slack-buffer)) + (with-slots (team) this + (let ((cur-point (point))) + (if (slack-buffer-has-next-page-p this) + (cl-labels + ((after-success + () + (with-current-buffer (slack-buffer-buffer this) + (let ((inhibit-read-only t)) + (slack-buffer-delete-load-more-string this) + (slack-buffer-prepare-marker-for-history this) + (slack-buffer-insert--history this) + (lui-recover-output-marker))))) + (slack-buffer-request-history this #'after-success)) + (message "No more items."))))) + +(defmethod slack-buffer-display-file ((this slack-buffer) file-id) + (with-slots (team) this + (cl-labels + ((open (file _) + (slack-buffer-display + (slack-create-file-info-buffer team file)))) + (slack-file-request-info file-id 1 team #'open)))) + +(defmethod slack-buffer-cant-execute ((this slack-buffer)) + (error "Can't execute this command from %s" (eieio-object-class-name this))) + +(defmethod slack-buffer-display-pins-list ((this slack-buffer)) + (slack-buffer-cant-execute this)) +(defmethod slack-buffer-pins-add ((this slack-buffer) ts) + (slack-buffer-cant-execute this)) +(defmethod slack-buffer-pins-remove ((this slack-buffer) ts) + (slack-buffer-cant-execute this)) +(defmethod slack-buffer-display-user-profile ((this slack-buffer)) + (slack-buffer-cant-execute this)) +(defmethod slack-buffer-copy-link ((this slack-buffer) ts) + (slack-buffer-cant-execute this)) +(defmethod slack-file-upload-params ((this slack-buffer)) + (slack-buffer-cant-execute this)) +(defmethod slack-buffer-execute-message-action ((this slack-buffer) _ts) + (slack-buffer-cant-execute this)) + +(defvar lui-prompt-string "> ") + +(defvar slack-mode-map + (let ((map (make-sparse-keymap))) + ;; (define-key map (kbd "C-s C-r") #'slack-room-update-messages) + ;; (define-key map (kbd "C-s C-b") #'slack-message-write-another-buffer) + map)) + +(defcustom slack-default-directory + (expand-file-name (concat (or (getenv "HOME") "~") "/")) + "default directory at Slack Buffer.") + +(define-derived-mode slack-mode lui-mode "Slack" + "" + (setq-local default-directory slack-default-directory) + (lui-set-prompt lui-prompt-string) + (setq lui-input-function 'slack-message--send)) + +(define-derived-mode slack-info-mode lui-mode "Slack Info" + "" + (setq-local default-directory slack-default-directory) + (lui-set-prompt lui-prompt-string)) + +(defcustom slack-buffer-emojify nil + "Show emoji with `emojify' if true." + :group 'slack) + +(defcustom slack-buffer-create-on-notify nil + "Create a room buffer when notification received if it does not yet exist" + :group 'slack) + +(defmacro slack-buffer-widen (&rest body) + `(save-excursion + (save-restriction + (widen) + ,@body))) + +(defun slack-buffer-enable-emojify () + (if slack-buffer-emojify + (let ((emojify (require 'emojify nil t))) + (unless emojify + (error "Emojify is not installed")) + (emojify-mode t)))) + +(defun slack-buffer-goto (ts) + (let ((point (slack-buffer-ts-eq (point-min) (point-max) ts))) + (when point + (goto-char point)))) + +(defface slack-preview-face + (let* ((default-bg (or (face-background 'default) "unspecified-bg")) + (light-bg (if (equal default-bg "unspecified-bg") + "unspecified-bg" + (color-darken-name default-bg 3))) + (dark-bg (if (equal default-bg "unspecified-bg") + "unspecified-bg" + (color-lighten-name default-bg 3)))) + `((default :inherit (fixed-pitch shadow) :slant normal :weight normal) + (((type graphic) (class color) (background dark)) (:background ,dark-bg)) + (((type graphic) (class color) (background light)) (:background ,light-bg)))) + "Used preview text and code blocks" + :group 'slack) + +(defun slack-put-preview-overlay (start end) + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'face 'slack-preview-face))) + +(defalias 'slack-put-email-body-overlay 'slack-put-preview-overlay) +(defalias 'slack-put-code-block-overlay 'slack-put-preview-overlay) + +(defun slack-search-code-block () + (while (re-search-forward "`\\([^`]\\|\n\\)" (point-max) t) + (let* ((block-begin (- (point) 4)) + (block-p (and (<= (point-min) block-begin) + (string= (buffer-substring-no-properties block-begin + (+ block-begin 3)) + "```"))) + (beg (or (and block-p block-begin) (- (point) 2))) + (end-regex (or (and block-p "```") "[^`]`[^`]"))) + + (goto-char (+ beg (or (and block-p 3) 1))) + + (if (re-search-forward end-regex (point-max) t) + (let* ((end (or (and block-p (1+ (point))) (- (point) 1)))) + (slack-put-code-block-overlay beg end) + (put-text-property beg end 'slack-disable-buttonize t) + (goto-char end)))))) + + +(defun slack-add-face-lazy () + (let* ((start (or (get-text-property (point-min) 'slack-defer-face) + (next-single-property-change (point-min) 'slack-defer-face))) + (end (and start (next-single-property-change start 'slack-defer-face)))) + (when (and start end) + (let ((face-or-func (get-text-property start 'slack-defer-face))) + (if (functionp face-or-func) + (funcall face-or-func start end) + (add-text-properties start end (list 'face face))))))) + +(defun slack-buffer-buttonize-link () + (let ((regex "<\\(http://\\|https://\\)\\(.*?\\)|\\([[:ascii:][:nonascii:]]*?\\)>")) + (ignore-errors + (goto-char (point-min)) + (while (re-search-forward regex nil t) + (let* ((url-begin (match-beginning 1)) + (cur-point (point)) + (disabled (get-text-property cur-point 'slack-disable-buttonize)) + (replace (match-string 3))) + (if disabled + (replace-match replace nil) + (let ((url (concat (match-string 1) (match-string 2)))) + (replace-match replace nil) + (make-button (1- url-begin) + (+ (1- url-begin) (length replace)) + 'type 'lui-button + 'action 'lui-button-activate + 'lui-button-function 'browse-url + 'lui-button-arguments (list url))))))))) + +(defun slack-buffer-show-typing-p (buffer) + (cl-case slack-typing-visibility + ('frame (slack-buffer-in-current-frame buffer)) + ('buffer (slack-buffer-current-p buffer)) + ('never nil))) + +(defun slack-buffer-current-p (buffer) + (if buffer + (string= (buffer-name buffer) + (buffer-name (current-buffer))))) + +(defun slack-buffer-in-current-frame (buffer) + (if buffer + (cl-member (buffer-name buffer) + (mapcar #'buffer-name + (mapcar #'window-buffer (window-list))) + :test #'string=))) + +(defmacro slack-buffer-goto-char (find-point &rest else) + `(let* ((cur-point (point)) + (ts (get-text-property cur-point 'ts))) + (let ((next-point ,find-point)) + (if next-point + (goto-char next-point) + (if (< 0 (length ',else)) + ,@else))))) + +(defun slack-buffer-goto-next-message () + (interactive) + (slack-buffer-goto-char + (slack-buffer-next-point cur-point (point-max) ts) + (message "You are on Last Message."))) + +(defun slack-buffer-goto-prev-message () + (interactive) + (slack-buffer-goto-char + (slack-buffer-prev-point cur-point (point-min) ts) + (message "You are on First Message."))) + +(defun slack-buffer-goto-first-message () + (interactive) + (goto-char + (slack-buffer-next-point (point-min) (point-max) "0"))) + +(defun slack-buffer-goto-last-message () + (interactive) + (goto-char + (slack-buffer-prev-point (point-max) (point-min) (format-time-string "%s")))) + +(defun slack-buffer-header-p (point) + (let ((face (get-text-property point 'face))) + (string= (format "%s" face) "slack-message-output-header"))) + +(defun slack-buffer-next-point (start end ts) + (cl-loop for i from start to end + if (and (string< ts + (get-text-property i 'ts)) + (slack-buffer-header-p i)) + return i)) + +(defun slack-buffer-prev-point (start end ts) + (cl-loop for i from start downto end + if (and (string< (get-text-property i 'ts) + ts) + (slack-buffer-header-p i)) + return i)) + +(defun slack-buffer-ts-eq (start end ts) + (if (and start end) + (cl-loop for i from start to end + if (string= (get-text-property i 'ts) + ts) + return i))) + +(defun slack--get-channel-id () + (interactive) + (with-current-buffer (current-buffer) + (slack-if-let* ((buffer slack-current-buffer) + (boundp (slot-boundp buffer 'room)) + (room (oref buffer room))) + (progn + (kill-new (oref room id)) + (message "%s" (oref room id)))))) + +(provide 'slack-buffer) +;;; slack-buffer.el ends here |