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, 0 insertions, 448 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 deleted file mode 100644 index ea56844e177f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/slack-20180913.651/slack-buffer.el +++ /dev/null @@ -1,448 +0,0 @@ -;;; 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 |