diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/vendor')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/vendor/org-clubhouse.el | 365 | ||||
| -rw-r--r-- | configs/shared/emacs/.emacs.d/vendor/reason-indent.el | 304 | ||||
| -rw-r--r-- | configs/shared/emacs/.emacs.d/vendor/reason-interaction.el | 216 | ||||
| -rw-r--r-- | configs/shared/emacs/.emacs.d/vendor/reason-mode.el | 242 | ||||
| -rw-r--r-- | configs/shared/emacs/.emacs.d/vendor/refmt.el | 231 | ||||
| -rw-r--r-- | configs/shared/emacs/.emacs.d/vendor/slack-snippets.el | 228 |
6 files changed, 0 insertions, 1586 deletions
diff --git a/configs/shared/emacs/.emacs.d/vendor/org-clubhouse.el b/configs/shared/emacs/.emacs.d/vendor/org-clubhouse.el deleted file mode 100644 index ba1f004a2410..000000000000 --- a/configs/shared/emacs/.emacs.d/vendor/org-clubhouse.el +++ /dev/null @@ -1,365 +0,0 @@ -;;; 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/configs/shared/emacs/.emacs.d/vendor/reason-indent.el b/configs/shared/emacs/.emacs.d/vendor/reason-indent.el deleted file mode 100644 index 8fd3c9425866..000000000000 --- a/configs/shared/emacs/.emacs.d/vendor/reason-indent.el +++ /dev/null @@ -1,304 +0,0 @@ -;;; 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/configs/shared/emacs/.emacs.d/vendor/reason-interaction.el b/configs/shared/emacs/.emacs.d/vendor/reason-interaction.el deleted file mode 100644 index 6ceaed1e9340..000000000000 --- a/configs/shared/emacs/.emacs.d/vendor/reason-interaction.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; 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/configs/shared/emacs/.emacs.d/vendor/reason-mode.el b/configs/shared/emacs/.emacs.d/vendor/reason-mode.el deleted file mode 100644 index 789735955db2..000000000000 --- a/configs/shared/emacs/.emacs.d/vendor/reason-mode.el +++ /dev/null @@ -1,242 +0,0 @@ -;;; 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/configs/shared/emacs/.emacs.d/vendor/refmt.el b/configs/shared/emacs/.emacs.d/vendor/refmt.el deleted file mode 100644 index b9ea2b43f0ce..000000000000 --- a/configs/shared/emacs/.emacs.d/vendor/refmt.el +++ /dev/null @@ -1,231 +0,0 @@ -;;; 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/configs/shared/emacs/.emacs.d/vendor/slack-snippets.el b/configs/shared/emacs/.emacs.d/vendor/slack-snippets.el deleted file mode 100644 index 6bf933cfb86d..000000000000 --- a/configs/shared/emacs/.emacs.d/vendor/slack-snippets.el +++ /dev/null @@ -1,228 +0,0 @@ -;;; 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))))) |