diff options
author | William Carroll <wpcarro@gmail.com> | 2018-04-25T17·26-0400 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2018-07-19T16·00-0400 |
commit | 3c8e6f0cc5eac51e369b8ffbd0441366cdc6da40 (patch) | |
tree | e1c98f5b22dd258e4ae331c0591e0527fe5233a1 /emacs.d/vendor | |
parent | 56a7b9fa41c6edbb960686ccffb7a8949d242eab (diff) |
Support updated emacs
Finally ported my up-to-date emacs configuration here. I was putting this off for a long while, unsure of how to handle all of the work. All it took was my laptop being fried to force me to do this. So... voila!
Diffstat (limited to 'emacs.d/vendor')
-rw-r--r-- | emacs.d/vendor/org-clubhouse.el | 365 | ||||
-rw-r--r-- | emacs.d/vendor/reason-indent.el | 304 | ||||
-rw-r--r-- | emacs.d/vendor/reason-interaction.el | 216 | ||||
-rw-r--r-- | emacs.d/vendor/reason-mode.el | 242 | ||||
-rw-r--r-- | emacs.d/vendor/refmt.el | 231 | ||||
-rw-r--r-- | emacs.d/vendor/slack-snippets.el | 228 |
6 files changed, 1586 insertions, 0 deletions
diff --git a/emacs.d/vendor/org-clubhouse.el b/emacs.d/vendor/org-clubhouse.el new file mode 100644 index 000000000000..ba1f004a2410 --- /dev/null +++ b/emacs.d/vendor/org-clubhouse.el @@ -0,0 +1,365 @@ +;;; private/grfn/org-clubhouse.el + +(require 'dash) +(require 'dash-functional) +(require 's) +(require 'org) +(require 'org-element) +(require 'cl) + +;;; +;;; Configuration +;;; + +(defvar org-clubhouse-auth-token nil + "Authorization token for the Clubhouse API") + +(defvar org-clubhouse-team-name nil + "Team name to use in links to Clubhouse +ie https://app.clubhouse.io/<TEAM_NAME>/stories") + +(defvar org-clubhouse-project-ids nil + "Specific list of project IDs to synchronize with clubhouse. +If unset all projects will be synchronized") + +(defvar org-clubhouse-workflow-name "Default") + +(defvar org-clubhouse-state-alist + '(("LATER" . "Unscheduled") + ("[ ]" . "Ready for Development") + ("TODO" . "Ready for Development") + ("OPEN" . "Ready for Development") + ("ACTIVE" . "In Development") + ("PR" . "Review") + ("DONE" . "Merged") + ("[X]" . "Merged") + ("CLOSED" . "Merged"))) + +;;; +;;; Utilities +;;; + +(defun ->list (vec) (append vec nil)) + +(defun reject-archived (item-list) + (-filter (lambda (item) (equal :json-false (alist-get 'archived item))) item-list)) + +(defun alist->plist (key-map alist) + (->> key-map + (-map (lambda (key-pair) + (let ((alist-key (car key-pair)) + (plist-key (cdr key-pair))) + (list plist-key (alist-get alist-key alist))))) + (-flatten-n 1))) + +(defun alist-get-equal (key alist) + "Like `alist-get', but uses `equal' instead of `eq' for comparing keys" + (->> alist + (-find (lambda (pair) (equal key (car pair)))) + (cdr))) + +;;; +;;; Org-element interaction +;;; + +;; (defun org-element-find-headline () +;; (let ((current-elt (org-element-at-point))) +;; (if (equal 'headline (car current-elt)) +;; current-elt +;; (let* ((elt-attrs (cadr current-elt)) +;; (parent (plist-get elt-attrs :post-affiliated))) +;; (goto-char parent) +;; (org-element-find-headline))))) + +(defun org-element-find-headline () + (let ((current-elt (org-element-at-point))) + (when (equal 'headline (car current-elt)) + (cadr current-elt)))) + +(defun org-element-extract-clubhouse-id (elt) + (when-let ((clubhouse-id-link (plist-get elt :CLUBHOUSE-ID))) + (string-match + (rx "[[" (one-or-more anything) "]" + "[" (group (one-or-more digit)) "]]") + clubhouse-id-link) + (string-to-int (match-string 1 clubhouse-id-link)))) + + + +(defun org-element-clubhouse-id () + (org-element-extract-clubhouse-id + (org-element-find-headline))) + +;;; +;;; API integration +;;; + +(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v2") + +(defun org-clubhouse-auth-url (url) + (concat url + "?" + (url-build-query-string + `(("token" ,org-clubhouse-auth-token))))) + +(defun org-clubhouse-baseify-url (url) + (if (s-starts-with? org-clubhouse-base-url* url) url + (concat org-clubhouse-base-url* + (if (s-starts-with? "/" url) url + (concat "/" url))))) + +(defun org-clubhouse-request (method url &optional data) + (message "%s %s %s" method url (prin1-to-string data)) + (let* ((url-request-method method) + (url-request-extra-headers + '(("Content-Type" . "application/json"))) + (url-request-data data) + (buf)) + + (setq url (-> url + org-clubhouse-baseify-url + org-clubhouse-auth-url)) + + (setq buf (url-retrieve-synchronously url)) + + (with-current-buffer buf + (goto-char url-http-end-of-headers) + (prog1 (json-read) (kill-buffer))))) + +(cl-defun to-id-name-pairs + (seq &optional (id-attr 'id) (name-attr 'name)) + (->> seq + ->list + (-map (lambda (resource) + (cons (alist-get id-attr resource) + (alist-get name-attr resource)))))) + +(cl-defun org-clubhouse-fetch-as-id-name-pairs + (resource &optional + (id-attr 'id) + (name-attr 'name)) + "Returns the given resource from clubhouse as (id . name) pairs" + (let ((resp-json (org-clubhouse-request "GET" resource))) + (-> resp-json + ->list + reject-archived + (to-id-name-pairs id-attr name-attr)))) + +(defun org-clubhouse-link-to-story (story-id) + (format "https://app.clubhouse.io/%s/story/%d" + org-clubhouse-team-name + story-id)) + +(defun org-clubhouse-link-to-epic (epic-id) + (format "https://app.clubhouse.io/%s/epic/%d" + org-clubhouse-team-name + epic-id)) + +(defun org-clubhouse-link-to-project (project-id) + (format "https://app.clubhouse.io/%s/project/%d" + org-clubhouse-team-name + project-id)) + +;;; +;;; Caching +;;; + + + +(defvar org-clubhouse-cache-clear-functions ()) + +(defmacro defcache (name &optional docstring &rest body) + (let* ((doc (when docstring (list docstring))) + (cache-var-name (intern (concat (symbol-name name) + "-cache"))) + (clear-cache-function-name + (intern (concat "clear-" (symbol-name cache-var-name))))) + `(progn + (defvar ,cache-var-name :no-cache) + (defun ,name () + ,@doc + (when (equal :no-cache ,cache-var-name) + (setq ,cache-var-name (progn ,@body))) + ,cache-var-name) + (defun ,clear-cache-function-name () + (interactive) + (setq ,cache-var-name :no-cache)) + + (push (quote ,clear-cache-function-name) + org-clubhouse-cache-clear-functions)))) + +(defun org-clubhouse-clear-cache () + (interactive) + (-map #'funcall org-clubhouse-cache-clear-functions)) + +;;; +;;; API resource functions +;;; + +(defcache org-clubhouse-projects + "Returns projects as (project-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "projects")) + +(defcache org-clubhouse-epics + "Returns projects as (project-id . name)" + (org-clubhouse-fetch-as-id-name-pairs "epics")) + +(defcache org-clubhouse-workflow-states + "Returns worflow states as (name . id) pairs" + (let* ((resp-json (org-clubhouse-request "GET" "workflows")) + (workflows (->list resp-json)) + ;; just assume it exists, for now + (workflow (-find (lambda (workflow) + (equal org-clubhouse-workflow-name + (alist-get 'name workflow))) + workflows)) + (states (->list (alist-get 'states workflow)))) + (to-id-name-pairs states + 'name + 'id))) + +(defun org-clubhouse-stories-in-project (project-id) + "Returns the stories in the given project as org bugs" + (let ((resp-json (org-clubhouse-request "GET" (format "/projects/%d/stories" project-id)))) + (->> resp-json ->list reject-archived + (-reject (lambda (story) (equal :json-true (alist-get 'completed story)))) + (-map (lambda (story) + (cons + (cons 'status + (cond + ((equal :json-true (alist-get 'started story)) + 'started) + ((equal :json-true (alist-get 'completed story)) + 'completed) + ('t + 'open))) + story))) + (-map (-partial #'alist->plist + '((name . :title) + (id . :id) + (status . :status))))))) + +;;; +;;; Story creation +;;; + +(cl-defun org-clubhouse-create-story-internal + (title &key project-id epic-id) + (assert (and (stringp title) + (integerp project-id) + (or (null epic-id) (integerp epic-id)))) + (org-clubhouse-request + "POST" + "stories" + (json-encode + `((name . ,title) + (project_id . ,project-id) + (epic_id . ,epic-id))))) + +(defun org-clubhouse-prompt-for-project (cb) + (ivy-read + "Select a project: " + (-map #'cdr (org-clubhouse-projects)) + :require-match t + :history 'org-clubhouse-project-history + :action (lambda (selected) + (let ((project-id + (->> (org-clubhouse-projects) + (-find (lambda (proj) + (string-equal (cdr proj) selected))) + car))) + (message "%d" project-id) + (funcall cb project-id))))) + +(defun org-clubhouse-prompt-for-epic (cb) + (ivy-read + "Select an epic: " + (-map #'cdr (org-clubhouse-epics)) + :history 'org-clubhouse-epic-history + :action (lambda (selected) + (let ((epic-id + (->> (org-clubhouse-epics) + (-find (lambda (proj) + (string-equal (cdr proj) selected))) + car))) + (message "%d" epic-id) + (funcall cb epic-id))))) + +(defun org-clubhouse-populate-created-story (story) + (let ((elt (org-element-find-headline)) + (story-id (alist-get 'id story)) + (epic-id (alist-get 'epic_id story)) + (project-id (alist-get 'project_id story))) + + (org-set-property "clubhouse-id" + (org-make-link-string + (org-clubhouse-link-to-story story-id) + (number-to-string story-id))) + + (org-set-property "clubhouse-epic" + (org-make-link-string + (org-clubhouse-link-to-epic epic-id) + (alist-get epic-id (org-clubhouse-epics)))) + + (org-set-property "clubhouse-project" + (org-make-link-string + (org-clubhouse-link-to-project project-id) + (alist-get project-id (org-clubhouse-projects)))) + + (org-todo "TODO"))) + +(defun org-clubhouse-create-story () + (interactive) + ;; (message (org-element-find-headline)) + (when-let ((elt (org-element-find-headline)) + (title (plist-get elt :title))) + (if (plist-get elt :CLUBHOUSE-ID) + (message "This headline is already a clubhouse story!") + (org-clubhouse-prompt-for-project + (lambda (project-id) + (when project-id + (org-clubhouse-prompt-for-epic + (lambda (epic-id) + (let* ((story (org-clubhouse-create-story-internal + title + :project-id project-id + :epic-id epic-id))) + (org-clubhouse-populate-created-story story)))))))))) + +;;; +;;; Story updates +;;; + +(cl-defun org-clubhouse-update-story-internal + (story-id &rest attrs) + (assert (and (integerp story-id) + (listp attrs))) + (org-clubhouse-request + "PUT" + (format "stories/%d" story-id) + (json-encode attrs))) + +(defun org-clubhouse-update-status () + (when-let (clubhouse-id (org-element-clubhouse-id)) + (let* ((elt (org-element-find-headline)) + (todo-keyword (-> elt (plist-get :todo-keyword) (substring-no-properties)))) + (message todo-keyword) + (when-let ((clubhouse-workflow-state + (alist-get-equal todo-keyword org-clubhouse-state-alist)) + (workflow-state-id + (alist-get-equal clubhouse-workflow-state (org-clubhouse-workflow-states)))) + (org-clubhouse-update-story-internal + clubhouse-id + :workflow_state_id workflow-state-id) + (message "Successfully updated clubhouse status to \"%s\"" + clubhouse-workflow-state))))) + +(define-minor-mode org-clubhouse-mode + :init-value nil + :group 'org + :lighter "Org-Clubhouse" + :keymap '() + (add-hook 'org-after-todo-state-change-hook + 'org-clubhouse-update-status + nil + t)) diff --git a/emacs.d/vendor/reason-indent.el b/emacs.d/vendor/reason-indent.el new file mode 100644 index 000000000000..8fd3c9425866 --- /dev/null +++ b/emacs.d/vendor/reason-indent.el @@ -0,0 +1,304 @@ +;;; reason-indent.el --- Indentation functions for ReasonML -*-lexical-binding: t-*- + +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;;; Commentary: + +;; Indentation functions for Reason. + +;;; Code: + +(defconst reason-re-ident "[[:word:][:multibyte:]_][[:word:][:multibyte:]_[:digit:]]*") + +(defcustom reason-indent-offset 2 + "Indent Reason code by this number of spaces." + :type 'integer + :group 'reason-mode + :safe #'integerp) + +(defun reason-looking-back-str (str) + "Like `looking-back' but for fixed strings rather than regexps. +Works around some regexp slowness. +Argument STR string to search for." + (let ((len (length str))) + (and (> (point) len) + (equal str (buffer-substring-no-properties (- (point) len) (point)))))) + +(defun reason-paren-level () + "Get the level of nesting inside parentheses." + (nth 0 (syntax-ppss))) + +(defun reason-in-str-or-cmnt () + "Return whether point is currently inside a string or a comment." + (nth 8 (syntax-ppss))) + +(defun reason-rewind-past-str-cmnt () + "Rewind past string or comment." + (goto-char (nth 8 (syntax-ppss)))) + +(defun reason-rewind-irrelevant () + "Rewind past irrelevant characters (whitespace of inside comments)." + (interactive) + (let ((starting (point))) + (skip-chars-backward "[:space:]\n") + (if (reason-looking-back-str "*/") (backward-char)) + (if (reason-in-str-or-cmnt) + (reason-rewind-past-str-cmnt)) + (if (/= starting (point)) + (reason-rewind-irrelevant)))) + +(defun reason-align-to-expr-after-brace () + "Align the expression at point to the expression after the previous brace." + (save-excursion + (forward-char) + ;; We don't want to indent out to the open bracket if the + ;; open bracket ends the line + (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) + (when (looking-at "[[:space:]]") + (forward-word 1) + (backward-word 1)) + (current-column)))) + +(defun reason-align-to-prev-expr () + "Align the expression at point to the previous expression." + (let ((alignment (save-excursion + (forward-char) + ;; We don't want to indent out to the open bracket if the + ;; open bracket ends the line + (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) + (if (looking-at "[[:space:]]") + (progn + (forward-word 1) + (backward-word 1)) + (backward-char)) + (current-column))))) + (if (not alignment) + (save-excursion + (forward-char) + (forward-line) + (back-to-indentation) + (current-column)) + alignment))) + +;;; Start of a reason binding +(defvar reason-binding + (regexp-opt '("let" "type" "module" "fun"))) + +(defun reason-beginning-of-defun (&optional arg) + "Move backward to the beginning of the current defun. + +With ARG, move backward multiple defuns. Negative ARG means +move forward. + +This is written mainly to be used as `beginning-of-defun-function'. +Don't move to the beginning of the line. `beginning-of-defun', +which calls this, does that afterwards." + (interactive "p") + (re-search-backward (concat "^\\(" reason-binding "\\)\\_>") + nil 'move (or arg 1))) + +(defun reason-end-of-defun () + "Move forward to the next end of defun. + +With argument, do it that many times. +Negative argument -N means move back to Nth preceding end of defun. + +Assume that this is called after ‘beginning-of-defun’. So point is +at the beginning of the defun body. + +This is written mainly to be used as `end-of-defun-function' for Reason." + (interactive) + ;; Find the opening brace + (if (re-search-forward "[{]" nil t) + (progn + (goto-char (match-beginning 0)) + ;; Go to the closing brace + (condition-case nil + (forward-sexp) + (scan-error + ;; The parentheses are unbalanced; instead of being unable to fontify, just jump to the end of the buffer + (goto-char (point-max))))) + ;; There is no opening brace, so consider the whole buffer to be one "defun" + (goto-char (point-max)))) + +(defun reason-rewind-to-beginning-of-current-level-expr () + "Rewind to the beginning of the expression on the current level of nesting." + (interactive) + (let ((current-level (reason-paren-level))) + (back-to-indentation) + (when (looking-at "=>") + (reason-rewind-irrelevant) + (back-to-indentation)) + (while (> (reason-paren-level) current-level) + (backward-up-list) + (back-to-indentation)))) + +(defun reason-mode-indent-line () + "Indent current line." + (interactive) + (let ((indent + (save-excursion + (back-to-indentation) + ;; Point is now at beginning of current line + (let* ((level (reason-paren-level)) + (baseline + ;; Our "baseline" is one level out from the indentation of the expression + ;; containing the innermost enclosing opening bracket. That + ;; way if we are within a block that has a different + ;; indentation than this mode would give it, we still indent + ;; the inside of it correctly relative to the outside. + (if (= 0 level) + 0 + (save-excursion + (reason-rewind-irrelevant) + (if (save-excursion + (reason-rewind-to-beginning-of-current-level-expr) + (looking-at "<")) + (progn + (reason-rewind-to-beginning-of-current-level-expr) + (current-column)) + (progn + (backward-up-list) + (reason-rewind-to-beginning-of-current-level-expr) + + (cond + ((looking-at "switch") + (current-column)) + + ((looking-at "|") + (+ (current-column) (* reason-indent-offset 2))) + + (t + (let ((current-level (reason-paren-level))) + (save-excursion + (while (and (= current-level (reason-paren-level)) + (not (looking-at reason-binding))) + (reason-rewind-irrelevant) + (reason-rewind-to-beginning-of-current-level-expr)) + (+ (current-column) reason-indent-offset))))))))))) + (cond + ;; A function return type is indented to the corresponding function arguments + ((looking-at "=>") + (+ baseline reason-indent-offset)) + + ((reason-in-str-or-cmnt) + (cond + ;; In the end of the block -- align with star + ((looking-at "*/") (+ baseline 1)) + ;; Indent to the following shape: + ;; /* abcd + ;; * asdf + ;; */ + ;; + ((looking-at "*") (+ baseline 1)) + ;; Indent to the following shape: + ;; /* abcd + ;; asdf + ;; */ + ;; + (t (+ baseline (+ reason-indent-offset 1))))) + + ((looking-at "</") (- baseline reason-indent-offset)) + + ;; A closing brace is 1 level unindented + ((looking-at "}\\|)\\|\\]") + (save-excursion + (reason-rewind-irrelevant) + (let ((jsx? (reason-looking-back-str ">"))) + (backward-up-list) + (reason-rewind-to-beginning-of-current-level-expr) + (cond + ((looking-at "switch") baseline) + + (jsx? (current-column)) + + (t (- baseline reason-indent-offset)))))) + + ;; Doc comments in /** style with leading * indent to line up the *s + ((and (nth 4 (syntax-ppss)) (looking-at "*")) + (+ 1 baseline)) + + ;; If we're in any other token-tree / sexp, then: + (t + (or + ;; If we are inside a pair of braces, with something after the + ;; open brace on the same line and ending with a comma, treat + ;; it as fields and align them. + (when (> level 0) + (save-excursion + (reason-rewind-irrelevant) + (backward-up-list) + ;; Point is now at the beginning of the containing set of braces + (reason-align-to-expr-after-brace))) + + (progn + (back-to-indentation) + (cond ((looking-at (regexp-opt '("and" "type"))) + baseline) + ((save-excursion + (reason-rewind-irrelevant) + (= (point) 1)) + baseline) + ((save-excursion + (while (looking-at "|") + (reason-rewind-irrelevant) + (back-to-indentation)) + (looking-at (regexp-opt '("type")))) + (+ baseline reason-indent-offset)) + ((looking-at "|\\|/[/*]") + baseline) + ((and (> level 0) + (save-excursion + (reason-rewind-irrelevant) + (backward-up-list) + (reason-rewind-to-beginning-of-current-level-expr) + (looking-at "switch"))) + (+ baseline reason-indent-offset)) + ((save-excursion + (reason-rewind-irrelevant) + (looking-back "[{;,\\[(]" (- (point) 2))) + baseline) + ((and + (save-excursion + (reason-rewind-irrelevant) + (reason-rewind-to-beginning-of-current-level-expr) + (and (looking-at reason-binding) + (not (progn + (forward-sexp) + (forward-sexp) + (skip-chars-forward "[:space:]\n") + (looking-at "="))))) + (not (save-excursion + (skip-chars-backward "[:space:]\n") + (reason-looking-back-str "=>")))) + (save-excursion + (reason-rewind-irrelevant) + (backward-sexp) + (reason-align-to-prev-expr))) + ((save-excursion + (reason-rewind-irrelevant) + (looking-back "<\/.*?>" (- (point) 30))) + baseline) + (t + (save-excursion + (reason-rewind-irrelevant) + (reason-rewind-to-beginning-of-current-level-expr) + + (if (looking-at "|") + baseline + (+ baseline reason-indent-offset))))) + ;; Point is now at the beginning of the current line + )))))))) + + (when indent + ;; If we're at the beginning of the line (before or at the current + ;; indentation), jump with the indentation change. Otherwise, save the + ;; excursion so that adding the indentations will leave us at the + ;; equivalent position within the line to where we were before. + (if (<= (current-column) (current-indentation)) + (indent-line-to indent) + (save-excursion (indent-line-to indent)))))) + +(provide 'reason-indent) + +;;; reason-indent.el ends here diff --git a/emacs.d/vendor/reason-interaction.el b/emacs.d/vendor/reason-interaction.el new file mode 100644 index 000000000000..6ceaed1e9340 --- /dev/null +++ b/emacs.d/vendor/reason-interaction.el @@ -0,0 +1,216 @@ +;;; reason-interaction.el --- Phrase navitagion for rtop -*-lexical-binding: t-*- + +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;;; Commentary: + +;; Phrase navigation for utop and maybe other REPLs. + +;; The utop compatibility layer for Reason was mainly taken from: +;; https://github.com/ocaml/tuareg/blob/master/tuareg-light.el (big thanks!) + +;;; Code: + +(defun reason-backward-char (&optional step) + "Go back one char. +Similar to `backward-char` but it does not signal errors +`beginning-of-buffer` and `end-of-buffer`. It optionally takes a +STEP parameter for jumping back more than one character." + (when step (goto-char (- (point) step)) + (goto-char (1- (point))))) + +(defun reason-forward-char (&optional step) + "Go forward one char. +Similar to `forward-char` but it does not signal errors +`beginning-of-buffer` and `end-of-buffer`. It optionally takes a +STEP parameter for jumping back more than one character." + (when step (goto-char (+ (point) step)) + (goto-char (1+ (point))))) + +(defun reason-in-literal-p () + "Return non-nil if point is inside an Reason literal." + (nth 3 (syntax-ppss))) + +(defconst reason-comment-delimiter-regexp "\\*/\\|/\\*" + "Regex for identify either open or close comment delimiters.") + +(defun reason-in-between-comment-chars-p () + "Return non-nil iff point is in between the comment delimiter chars. +It returns non-nil if point is between the chars only (*|/ or /|* +where | is point)." + (and (not (bobp)) (not (eobp)) + (or (and (char-equal ?/ (char-before)) (char-equal ?* (char-after))) + (and (char-equal ?* (char-before)) (char-equal ?/ (char-after)))))) + +(defun reason-looking-at-comment-delimiters-p () + "Return non-nil iff point in between comment delimiters." + (looking-at-p reason-comment-delimiter-regexp)) + +(defun reason-in-between-comment-delimiters-p () + "Return non-nil if inside /* and */." + (nth 4 (syntax-ppss))) + +(defun reason-in-comment-p () + "Return non-nil iff point is inside or right before a comment." + (or (reason-in-between-comment-delimiters-p) + (reason-in-between-comment-chars-p) + (reason-looking-at-comment-delimiters-p))) + +(defun reason-beginning-of-literal-or-comment () + "Skip to the beginning of the current literal or comment (or buffer)." + (interactive) + (goto-char (or (nth 8 (syntax-ppss)) (point)))) + +(defun reason-inside-block-scope-p () + "Skip to the beginning of the current literal or comment (or buffer)." + (and (> (nth 0 (syntax-ppss)) 0) + (let ((delim-start (nth 1 (syntax-ppss)))) + (save-excursion + (goto-char delim-start) + (char-equal ?{ (following-char)))))) + +(defun reason-at-phrase-break-p () + "Is the underlying `;' a phrase break?" + ;; Difference from OCaml, the phrase separator is a single semi-colon + (and (not (eobp)) + (char-equal ?\; (following-char)))) + +(defun reason-skip-to-close-delimiter (&optional limit) + "Skip to the end of a Reason block. +It basically calls `re-search-forward` in order to go to any +closing delimiter, not concerning itself with balancing of any +sort. Client code needs to check that. +LIMIT is passed to `re-search-forward` directly." + (re-search-forward "\\s)" limit 'move)) + +(defun reason-skip-back-to-open-delimiter (&optional limit) + "Skip to the beginning of a Reason block backwards. +It basically calls `re-search-backward` in order to go to any +opening delimiter, not concerning itself with balancing of any +sort. Client code needs to check that. +LIMIT is passed to `re-search-backward` directly." + (re-search-backward "\\s(" limit 'move)) + +(defun reason-find-phrase-end () + "Skip to the end of a phrase." + (while (and (not (eobp)) + (not (reason-at-phrase-break-p))) + (if (re-search-forward ";" nil 'move) + (progn (when (reason-inside-block-scope-p) + (reason-skip-to-close-delimiter)) + (goto-char (1- (point)))) + ;; avoid infinite loop at the end of the buffer + (re-search-forward "[[:space:]\\|\n]+" nil 'move))) + (min (goto-char (1+ (point))) (point-max))) + +(defun reason-skip-blank-and-comments () + "Skip blank spaces and comments." + (cond + ((eobp) (point)) + ((or (reason-in-between-comment-chars-p) + (reason-looking-at-comment-delimiters-p)) (progn + (reason-forward-char 1) + (reason-skip-blank-and-comments))) + ((reason-in-between-comment-delimiters-p) (progn + (search-forward "*/" nil t) + (reason-skip-blank-and-comments))) + ((eolp) (progn + (reason-forward-char 1) + (reason-skip-blank-and-comments))) + (t (progn (skip-syntax-forward " ") + (point))))) + +(defun reason-skip-back-blank-and-comments () + "Skip blank spaces and comments backwards." + (cond + ((bobp) (point)) + ((looking-back reason-comment-delimiter-regexp) (progn + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + ((reason-in-between-comment-delimiters-p) (progn + (search-backward "/*" nil t) + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + ((or (reason-in-between-comment-chars-p) + (reason-looking-at-comment-delimiters-p)) (progn + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + ((bolp) (progn + (reason-backward-char 1) + (reason-skip-back-blank-and-comments))) + (t (progn (skip-syntax-backward " ") + (point))))) + +(defun reason-ro (&rest words) + "Build a regex matching iff at least a word in WORDS is present." + (concat "\\<" (regexp-opt words t) "\\>")) + +(defconst reason-find-phrase-beginning-regexp + (concat (reason-ro "end" "type" "module" "sig" "struct" "class" + "exception" "open" "let") + "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;")) + +(defun reason-at-phrase-start-p () + "Return t if is looking at the beginning of a phrase. +A phrase starts when a toplevel keyword is at the beginning of a line." + (or (looking-at "#") + (looking-at reason-find-phrase-beginning-regexp))) + +(defun reason-find-phrase-beginning-backward () + "Find the beginning of a phrase and return point. +It scans code backwards, therefore the caller can assume that the +beginning of the phrase (if found) is always before the starting +point. No error is signalled and (point-min) is returned when a +phrease cannot be found." + (beginning-of-line) + (while (and (not (bobp)) (not (reason-at-phrase-start-p))) + (if (reason-inside-block-scope-p) + (reason-skip-back-to-open-delimiter) + (re-search-backward reason-find-phrase-beginning-regexp nil 'move))) + (point)) + +(defun reason-discover-phrase () + "Discover a Reason phrase in the buffer." + ;; TODO reason-with-internal-syntax ;; tuareg2 modifies the syntax table (removed for now) + ;; TODO stop-at-and feature for phrase detection (do we need it?) + ;; TODO tuareg2 has some custom logic for module and class (do we need it?) + (save-excursion + (let ((case-fold-search nil)) + (reason-skip-blank-and-comments) + (list (reason-find-phrase-beginning-backward) ;; beginning + (reason-find-phrase-end) ;; end + (save-excursion ;; end-with-comment + (reason-skip-blank-and-comments) + (point)))))) + +(defun reason-discover-phrase-debug () + "Discover a Reason phrase in the buffer (debug mode)." + (let ((triple (reason-discover-phrase))) + (message (concat "Evaluating: \"" (reason-fetch-phrase triple) "\"")) + triple)) + +(defun reason-fetch-phrase (triple) + "Fetch the phrase text given a TRIPLE." + (let* ((start (nth 0 triple)) + (end (nth 1 triple))) ;; we don't need end-with-comment + (buffer-substring-no-properties start end))) + +(defun reason-next-phrase () + "Skip to the beginning of the next phrase." + (cond + ((reason-at-phrase-start-p) (point)) + ((eolp) (progn + (forward-char 1) + (reason-skip-blank-and-comments) + (reason-next-phrase))) + ((reason-inside-block-scope-p) (progn (reason-skip-to-close-delimiter) + (reason-next-phrase))) + ((looking-at ";") (progn + (forward-char 1) + (reason-next-phrase))) + (t (progn (end-of-line) + (reason-next-phrase))))) + +(provide 'reason-interaction) + +;;; reason-interaction.el ends here diff --git a/emacs.d/vendor/reason-mode.el b/emacs.d/vendor/reason-mode.el new file mode 100644 index 000000000000..789735955db2 --- /dev/null +++ b/emacs.d/vendor/reason-mode.el @@ -0,0 +1,242 @@ +;;; reason-mode.el --- A major mode for editing ReasonML -*-lexical-binding: t-*- +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;; Version: 0.4.0 +;; Author: Mozilla +;; Url: https://github.com/reasonml-editor/reason-mode +;; Keywords: languages, ocaml +;; Package-Requires: ((emacs "24.3")) + +;; This file is NOT part of GNU Emacs. + +;; This file is distributed under the terms of both the MIT license and the +;; Apache License (version 2.0). + +;;; Commentary: +;; This project provides useful functions and helpers for developing code +;; using the Reason programming language (https://facebook.github.io/reason). +;; +;; Reason is an umbrella project that provides a curated layer for OCaml. +;; +;; It offers: +;; - A new, familiar syntax for the battle-tested language that is OCaml. +;; - A workflow for compiling to JavaScript and native code. +;; - A set of friendly documentations, libraries and utilities. +;; +;; See the README.md for more details. + +;;; Code: + +(require 'reason-indent) +(require 'refmt) +(require 'reason-interaction) + +(eval-when-compile (require 'rx) + (require 'compile) + (require 'url-vars)) + +;; Syntax definitions and helpers +(defvar reason-mode-syntax-table + (let ((table (make-syntax-table))) + + ;; Operators + (dolist (i '(?+ ?- ?* ?/ ?& ?| ?^ ?! ?< ?> ?~ ?@)) + (modify-syntax-entry i "." table)) + + ;; Strings + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?\' "_" table) + + ;; Comments + (modify-syntax-entry ?/ ". 124b" table) + (modify-syntax-entry ?* ". 23n" table) + (modify-syntax-entry ?\n "> b" table) + (modify-syntax-entry ?\^m "> b" table) + + table)) + +(defgroup reason nil + "Support for Reason code." + :link '(url-link "http://facebook.github.io/reason/") + :group 'languages) + +(defcustom reason-mode-hook nil + "Hook called by `reason-mode'." + :type 'hook + :group 'reason) + +;; Font-locking definitions and helpers +(defconst reason-mode-keywords + '("and" "as" + "else" "external" + "fun" "for" + "if" "impl" "in" "include" + "let" + "module" "match" "mod" "move" "mutable" + "open" + "priv" "pub" + "rec" "ref" "return" + "self" "static" "switch" "struct" "super" + "trait" "type" + "use" + "virtual" + "where" "when" "while")) + +(defconst reason-mode-consts + '("true" "false")) + +(defconst reason-special-types + '("int" "float" "string" "char" + "bool" "unit" "list" "array" "exn" + "option" "ref")) + +(defconst reason-camel-case + (rx symbol-start + (group upper (0+ (any word nonascii digit "_"))) + symbol-end)) + +(eval-and-compile + (defconst reason--char-literal-rx + (rx (seq (group "'") + (or (seq "\\" anything) + (not (any "'\\"))) + (group "'"))))) + +(defun reason-re-word (inner) + "Build a word regexp given INNER." + (concat "\\<" inner "\\>")) + +(defun reason-re-grab (inner) + "Build a grab regexp given INNER." + (concat "\\(" inner "\\)")) + +(defun reason-regexp-opt-symbols (words) + "Like `(regexp-opt words 'symbols)`, but will work on Emacs 23. +See rust-mode PR #42. +Argument WORDS argument to pass to `regexp-opt`." + (concat "\\_<" (regexp-opt words t) "\\_>")) + +;;; Syntax highlighting for Reason +(defvar reason-font-lock-keywords + `((,(reason-regexp-opt-symbols reason-mode-keywords) . font-lock-keyword-face) + (,(reason-regexp-opt-symbols reason-special-types) . font-lock-builtin-face) + (,(reason-regexp-opt-symbols reason-mode-consts) . font-lock-constant-face) + + (,reason-camel-case 1 font-lock-type-face) + + ;; Field names like `foo:`, highlight excluding the : + (,(concat (reason-re-grab reason-re-ident) ":[^:]") 1 font-lock-variable-name-face) + ;; Module names like `foo::`, highlight including the :: + (,(reason-re-grab (concat reason-re-ident "::")) 1 font-lock-type-face) + ;; Name punned labeled args like ::foo + (,(concat "[[:space:]]+" (reason-re-grab (concat "::" reason-re-ident))) 1 font-lock-type-face) + + ;; TODO jsx attribs? + (, + (concat "<[/]?" (reason-re-grab reason-re-ident) "[^>]*" ">") + 1 font-lock-type-face))) + +(defun reason-mode-try-find-alternate-file (mod-name extension) + "Switch to the file given by MOD-NAME and EXTENSION." + (let* ((filename (concat mod-name extension)) + (buffer (get-file-buffer filename))) + (if buffer (switch-to-buffer buffer) + (find-file filename)))) + +(defun reason-mode-find-alternate-file () + "Switch to implementation/interface file." + (interactive) + (let ((name buffer-file-name)) + (when (string-match "\\`\\(.*\\)\\.re\\([il]\\)?\\'" name) + (let ((mod-name (match-string 1 name)) + (e (match-string 2 name))) + (cond + ((string= e "i") + (reason-mode-try-find-alternate-file mod-name ".re")) + (t + (reason-mode-try-find-alternate-file mod-name ".rei"))))))) + +(defun reason--syntax-propertize-multiline-string (end) + "Propertize Reason multiline string. +Argument END marks the end of the string." + (let ((ppss (syntax-ppss))) + (when (eq t (nth 3 ppss)) + (let ((key (save-excursion + (goto-char (nth 8 ppss)) + (and (looking-at "{\\([a-z]*\\)|") + (match-string 1))))) + (when (search-forward (format "|%s}" key) end 'move) + (put-text-property (1- (match-end 0)) (match-end 0) + 'syntax-table (string-to-syntax "|"))))))) + +(defun reason-syntax-propertize-function (start end) + "Propertize Reason function. +Argument START marks the beginning of the function. +Argument END marks the end of the function." + (goto-char start) + (reason--syntax-propertize-multiline-string end) + (funcall + (syntax-propertize-rules + (reason--char-literal-rx (1 "\"") (2 "\"")) + ;; multi line strings + ("\\({\\)[a-z]*|" + (1 (prog1 "|" + (goto-char (match-end 0)) + (reason--syntax-propertize-multiline-string end))))) + (point) end)) + +(defvar reason-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-a" #'reason-mode-find-alternate-file) + (define-key map "\C-c\C-r" #'refmt-region-ocaml-to-reason) + (define-key map "\C-c\C-o" #'refmt-region-reason-to-ocaml) + map)) + +;;;###autoload +(define-derived-mode reason-mode prog-mode "Reason" + "Major mode for Reason code. + +\\{reason-mode-map}" + :group 'reason + :syntax-table reason-mode-syntax-table + :keymap reason-mode-map + + ;; Syntax + (setq-local syntax-propertize-function #'reason-syntax-propertize-function) + ;; Indentation + (setq-local indent-line-function 'reason-mode-indent-line) + ;; Fonts + (setq-local font-lock-defaults '(reason-font-lock-keywords)) + ;; Misc + (setq-local comment-start "/*") + (setq-local comment-end "*/") + (setq-local indent-tabs-mode nil) + ;; Allow paragraph fills for comments + (setq-local comment-start-skip "/\\*+[ \t]*") + (setq-local paragraph-start + (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local require-final-newline t) + (setq-local normal-auto-fill-function nil) + (setq-local comment-multi-line t) + + (setq-local beginning-of-defun-function 'reason-beginning-of-defun) + (setq-local end-of-defun-function 'reason-end-of-defun) + (setq-local parse-sexp-lookup-properties t)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.rei?\\'" . reason-mode)) + +(defun reason-mode-reload () + "Reload Reason mode." + (interactive) + (unload-feature 'reason-mode) + (unload-feature 'reason-indent) + (unload-feature 'reason-interaction) + (require 'reason-mode) + (reason-mode)) + +(provide 'reason-mode) + +;;; reason-mode.el ends here diff --git a/emacs.d/vendor/refmt.el b/emacs.d/vendor/refmt.el new file mode 100644 index 000000000000..b9ea2b43f0ce --- /dev/null +++ b/emacs.d/vendor/refmt.el @@ -0,0 +1,231 @@ +;;; refmt.el --- utility functions to format reason code + +;; Copyright (c) 2014 The go-mode Authors. All rights reserved. +;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. + +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions are +;; met: + +;; * Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; * Redistributions in binary form must reproduce the above +;; copyright notice, this list of conditions and the following disclaimer +;; in the documentation and/or other materials provided with the +;; distribution. +;; * Neither the name of the copyright holder nor the names of its +;; contributors may be used to endorse or promote products derived from +;; this software without specific prior written permission. + +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.) + +;;; Commentary: +;; + +;;; Code: + +(require 'cl-lib) + +(defcustom refmt-command "refmt" + "The 'refmt' command." + :type 'string + :group 're-fmt) + +(defcustom refmt-show-errors 'buffer + "Where to display refmt error output. +It can either be displayed in its own buffer, in the echo area, or not at all. +Please note that Emacs outputs to the echo area when writing +files and will overwrite refmt's echo output if used from inside +a `before-save-hook'." + :type '(choice + (const :tag "Own buffer" buffer) + (const :tag "Echo area" echo) + (const :tag "None" nil)) + :group 're-fmt) + +(defcustom refmt-width-mode nil + "Specify width when formatting buffer contents." + :type '(choice + (const :tag "Window width" window) + (const :tag "Fill column" fill) + (const :tag "None" nil)) + :group 're-fmt) + +;;;###autoload +(defun refmt-before-save () + "Add this to .emacs to run refmt on the current buffer when saving: + (add-hook 'before-save-hook 'refmt-before-save)." + (interactive) + (when (eq major-mode 'reason-mode) (refmt))) + +(defun reason--goto-line (line) + (goto-char (point-min)) + (forward-line (1- line))) + +(defun reason--delete-whole-line (&optional arg) + "Delete the current line without putting it in the `kill-ring'. +Derived from function `kill-whole-line'. ARG is defined as for that +function." + (setq arg (or arg 1)) + (if (and (> arg 0) + (eobp) + (save-excursion (forward-visible-line 0) (eobp))) + (signal 'end-of-buffer nil)) + (if (and (< arg 0) + (bobp) + (save-excursion (end-of-visible-line) (bobp))) + (signal 'beginning-of-buffer nil)) + (cond ((zerop arg) + (delete-region (progn (forward-visible-line 0) (point)) + (progn (end-of-visible-line) (point)))) + ((< arg 0) + (delete-region (progn (end-of-visible-line) (point)) + (progn (forward-visible-line (1+ arg)) + (unless (bobp) + (backward-char)) + (point)))) + (t + (delete-region (progn (forward-visible-line 0) (point)) + (progn (forward-visible-line arg) (point)))))) + +(defun reason--apply-rcs-patch (patch-buffer &optional start-pos) + "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer." + (setq start-pos (or start-pos (point-min))) + (let ((first-line (line-number-at-pos start-pos)) + (target-buffer (current-buffer)) + ;; Relative offset between buffer line numbers and line numbers + ;; in patch. + ;; + ;; Line numbers in the patch are based on the source file, so + ;; we have to keep an offset when making changes to the + ;; buffer. + ;; + ;; Appending lines decrements the offset (possibly making it + ;; negative), deleting lines increments it. This order + ;; simplifies the forward-line invocations. + (line-offset 0)) + (save-excursion + (with-current-buffer patch-buffer + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)") + (error "invalid rcs patch or internal error in reason--apply-rcs-patch")) + (forward-line) + (let ((action (match-string 1)) + (from (string-to-number (match-string 2))) + (len (string-to-number (match-string 3)))) + (cond + ((equal action "a") + (let ((start (point))) + (forward-line len) + (let ((text (buffer-substring start (point)))) + (with-current-buffer target-buffer + (cl-decf line-offset len) + (goto-char start-pos) + (forward-line (- from len line-offset)) + (insert text))))) + ((equal action "d") + (with-current-buffer target-buffer + (reason--goto-line (- (1- (+ first-line from)) line-offset)) + (cl-incf line-offset len) + (reason--delete-whole-line len))) + (t + (error "invalid rcs patch or internal error in reason--apply-rcs-patch"))))))))) + +(defun refmt--process-errors (filename tmpfile errorfile errbuf) + (with-current-buffer errbuf + (if (eq refmt-show-errors 'echo) + (progn + (message "%s" (buffer-string)) + (refmt--kill-error-buffer errbuf)) + (insert-file-contents errorfile nil nil nil) + ;; Convert the refmt stderr to something understood by the compilation mode. + (goto-char (point-min)) + (insert "refmt errors:\n") + (while (search-forward-regexp (regexp-quote tmpfile) nil t) + (replace-match (file-name-nondirectory filename))) + (compilation-mode) + (display-buffer errbuf)))) + +(defun refmt--kill-error-buffer (errbuf) + (let ((win (get-buffer-window errbuf))) + (if win + (quit-window t win) + (with-current-buffer errbuf + (erase-buffer)) + (kill-buffer errbuf)))) + +(defun apply-refmt (&optional start end from to) + (setq start (or start (point-min)) + end (or end (point-max)) + from (or from "re") + to (or to "re")) + (let* ((ext (file-name-extension buffer-file-name t)) + (bufferfile (make-temp-file "refmt" nil ext)) + (outputfile (make-temp-file "refmt" nil ext)) + (errorfile (make-temp-file "refmt" nil ext)) + (errbuf (if refmt-show-errors (get-buffer-create "*Refmt Errors*"))) + (patchbuf (get-buffer-create "*Refmt patch*")) + (coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8) + (width-args + (cond + ((equal refmt-width-mode 'window) + (list "--print-width" (number-to-string (window-body-width)))) + ((equal refmt-width-mode 'fill) + (list "--print-width" (number-to-string fill-column))) + (t + '())))) + (unwind-protect + (save-restriction + (widen) + (write-region start end bufferfile) + (if errbuf + (with-current-buffer errbuf + (setq buffer-read-only nil) + (erase-buffer))) + (with-current-buffer patchbuf + (erase-buffer)) + (if (zerop (apply 'call-process + refmt-command nil (list (list :file outputfile) errorfile) + nil (append width-args (list "--parse" from "--print" to bufferfile)))) + (progn + (call-process-region start end "diff" nil patchbuf nil "-n" "-" + outputfile) + (reason--apply-rcs-patch patchbuf start) + (message "Applied refmt") + (if errbuf (refmt--kill-error-buffer errbuf))) + (message "Could not apply refmt") + (if errbuf + (refmt--process-errors (buffer-file-name) bufferfile errorfile errbuf))))) + (kill-buffer patchbuf) + (delete-file errorfile) + (delete-file bufferfile) + (delete-file outputfile))) + +(defun refmt () + "Format the current buffer according to the refmt tool." + (interactive) + (apply-refmt)) + +(defun refmt-region-ocaml-to-reason (start end) + (interactive "r") + (apply-refmt start end "ml")) + +(defun refmt-region-reason-to-ocaml (start end) + (interactive "r") + (apply-refmt start end "re" "ml")) + +(provide 'refmt) + +;;; refmt.el ends here diff --git a/emacs.d/vendor/slack-snippets.el b/emacs.d/vendor/slack-snippets.el new file mode 100644 index 000000000000..6bf933cfb86d --- /dev/null +++ b/emacs.d/vendor/slack-snippets.el @@ -0,0 +1,228 @@ +;;; private/grfn/slack-snippets.el -*- lexical-binding: t; -*- + +(require 's) +(require 'json) +(require 'dash) +(require 'dash-functional) +(require 'request) +(require 'subr-x) + +;;; +;;; Configuration +;;; + +(defvar slack/token nil + "Legacy (https://api.slack.com/custom-integrations/legacy-tokens) access token") + +(defvar slack/include-public-channels 't + "Whether or not to inclue public channels in the list of conversations") + +(defvar slack/include-private-channels 't + "Whether or not to inclue public channels in the list of conversations") + +(defvar slack/include-im 't + "Whether or not to inclue IMs (private messages) in the list of conversations") + +(defvar slack/include-mpim nil + "Whether or not to inclue multi-person IMs (multi-person private messages) in + the list of conversations") + +;;; +;;; Utilities +;;; + +(defmacro comment (&rest _body) + "Comment out one or more s-expressions" + nil) + +(defun ->list (vec) (append vec nil)) + +(defun json-truthy? (x) (and x (not (equal :json-false x)))) + +;;; +;;; Generic API integration +;;; + +(defvar slack/base-url "https://slack.com/api") + +(defun slack/get (path params &optional callback) + "params is an alist of query parameters" + (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) + (params (car params-callback)) (callback (cdr params-callback)) + (params (append `(("token" . ,slack/token)) params)) + (url (concat (file-name-as-directory slack/base-url) path))) + (request url + :type "GET" + :params params + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall callback data)))))) + +(defun slack/post (path params &optional callback) + (let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback))) + (params (car params-callback)) (callback (cdr params-callback)) + (url (concat (file-name-as-directory slack/base-url) path))) + (request url + :type "POST" + :data (json-encode params) + :headers `(("Content-Type" . "application/json") + ("Authorization" . ,(format "Bearer %s" slack/token))) + :success (cl-function + (lambda (&key data &allow-other-keys) + (funcall callback data)))))) + + +;;; +;;; Specific API endpoints +;;; + +;; Users + +(defun slack/users (cb) + "Returns users as (id . name) pairs" + (slack/get + "users.list" + (lambda (data) + (->> data + (assoc-default 'members) + ->list + (-map (lambda (user) + (cons (assoc-default 'id user) + (assoc-default 'real_name user)))) + (-filter #'cdr) + (funcall cb))))) + +(comment + (slack/get + "users.list" + (lambda (data) (setq response-data data))) + + (slack/users (lambda (data) (setq --users data))) + + ) + +;; Conversations + +(defun slack/conversation-types () + (->> + (list (when slack/include-public-channels "public_channel") + (when slack/include-private-channels "private_channel") + (when slack/include-im "im") + (when slack/include-mpim "mpim")) + (-filter #'identity) + (s-join ","))) + +(defun channel-label (chan users-alist) + (cond + ((json-truthy? (assoc-default 'is_channel chan)) + (format "#%s" (assoc-default 'name chan))) + ((json-truthy? (assoc-default 'is_im chan)) + (let ((user-id (assoc-default 'user chan))) + (format "Private message with %s" (assoc-default user-id users-alist)))) + ((json-truthy? (assoc-default 'is_mpim chan)) + (->> chan + (assoc-default 'purpose) + (assoc-default 'value))))) + +(defun slack/conversations (cb) + "Calls `cb' with (id . '((label . \"label\") '(topic . \"topic\") '(purpose . \"purpose\"))) pairs" + (slack/get + "conversations.list" + `(("types" . ,(slack/conversation-types)) + ("exclude-archived" . "true")) + (lambda (data) + (setq --data data) + (slack/users + (lambda (users) + (->> data + (assoc-default 'channels) + ->list + (-filter + (lambda (chan) (channel-label chan users))) + (-map + (lambda (chan) + (cons (assoc-default 'id chan) + `((label . ,(channel-label chan users)) + (topic . ,(->> chan + (assoc-default 'topic) + (assoc-default 'value))) + (purpose . ,(->> chan + (assoc-default 'purpose) + (assoc-default 'value))))))) + (funcall cb))))))) + +(comment + (slack/get + "conversations.list" + '(("types" . "public_channel,private_channel,im,mpim")) + (lambda (data) (setq response-data data))) + + (slack/get + "conversations.list" + '(("types" . "im")) + (lambda (data) (setq response-data data))) + + (slack/conversations + (lambda (convos) (setq --conversations convos))) + + ) + +;; Messages + +(cl-defun slack/post-message + (&key text channel-id (on-success #'identity)) + (slack/post "chat.postMessage" + `((text . ,text) + (channel . ,channel-id) + (as_user . t)) + on-success)) + +(comment + + (slack/post-message + :text "hi slackbot" + :channel-id slackbot-channel-id + :on-success (lambda (data) (setq resp data))) + + (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))) + --conversations) + + ) + +;;; +;;; Posting code snippets to slack +;;; + +(defun prompt-for-channel (cb) + (slack/conversations + (lambda (conversations) + (setq testing (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))) + conversations)) + (ivy-read + "Select channel: " + ;; TODO want to potentially use purpose / topic stuff here + (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan))) + (id (car chan))) + (propertize label 'channel-id id))) + conversations) + :history 'slack/channel-history + :action (lambda (selected) + (let ((channel-id (get-text-property 0 'channel-id selected))) + (funcall cb channel-id) + (message "Sent message to %s" selected)))))) + nil) + +(defun slack-send-code-snippet (&optional snippet-text) + (interactive) + (when-let ((snippet-text (or snippet-text + (buffer-substring-no-properties (mark) (point))))) + (prompt-for-channel + (lambda (channel-id) + (slack/post-message + :text (format "```\n%s```" snippet-text) + :channel-id channel-id))))) |