157 lines
6.1 KiB
EmacsLisp
157 lines
6.1 KiB
EmacsLisp
;; arc --- Summary
|
|
;;; Commentary:
|
|
;;; A bunch of helpers for Phabricator and arc
|
|
;;; Code:
|
|
|
|
(require 'dash)
|
|
(require 'dash-functional)
|
|
(require 'ido)
|
|
(require 'image)
|
|
(require 'json)
|
|
(require 'projectile)
|
|
(require 's)
|
|
|
|
(defconst arc-binary "arc")
|
|
(defconst phabricator-macro-dir "~/public_html")
|
|
(defconst phabricator-macro-list "~tulloch/.arc_macros")
|
|
(defconst phabricator-macro-refresh-script "~tulloch/bin/arc_macros.sh")
|
|
|
|
(defcustom arc-repo-prefix-list
|
|
'(("fbcode" . "https://phabricator.fb.com/diffusion/FBCODE/browse/master")
|
|
("www" . "https://phabricator.fb.com/diffusion/E/browse/tfb/trunk/www"))
|
|
"*Mapping from repository name to path in diffusion."
|
|
:group 'arc)
|
|
|
|
(defun arc--call-conduit (method req)
|
|
"Call conduit METHOD with the parameters REQ."
|
|
(with-temp-buffer
|
|
(let ((tmp-file (make-temp-file "arc-conduit")))
|
|
(with-temp-file tmp-file (->> req json-encode insert))
|
|
(call-process
|
|
arc-binary tmp-file `(,(current-buffer) nil) nil "call-conduit" method)
|
|
(->> (buffer-string) json-read-from-string (assoc 'response) cdr))))
|
|
|
|
;;; ----------------------------------------------------------------------------
|
|
;;; arc macro commands.
|
|
(defun arc--list-macros ()
|
|
"Load phabricator-macro-list into an ido completion window."
|
|
(with-temp-buffer
|
|
(insert-file-contents phabricator-macro-list)
|
|
(->> (buffer-string) (s-split "\n") (ido-completing-read "Macro: "))))
|
|
|
|
(defun arc-refresh-macros ()
|
|
"Refresh phabricator-macro-list from Phabricator with the latest macros."
|
|
(interactive)
|
|
(call-process-shell-command
|
|
phabricator-macro-refresh-script nil nil nil phabricator-macro-list))
|
|
|
|
(defun arc-insert-macro (name)
|
|
"Insert image NAME from a list of Phabricator macros."
|
|
(interactive `(,(arc--list-macros)))
|
|
(if (display-graphic-p)
|
|
(let ((img (->> name arc--get-macro create-image)))
|
|
(when (image-animated-p img)
|
|
(image-animate img 0 t))
|
|
(insert-image img name)
|
|
(insert "\n\n"))
|
|
(insert name)))
|
|
|
|
(defun arc--get-macro (macro-name)
|
|
"Retrieve the given MACRO-NAME image and save it to *phabricator-macro-dir*."
|
|
(interactive `(,(arc--list-macros)))
|
|
(let* ((macro-file-name (format "%s/%s" phabricator-macro-dir macro-name))
|
|
(download-uri
|
|
(lambda (uri)
|
|
(when (not (file-exists-p macro-file-name))
|
|
(url-copy-file uri macro-file-name)
|
|
(shell-command (format "chmod 644 %s" macro-file-name)))
|
|
macro-file-name))
|
|
(extract-uri
|
|
(lambda (output)
|
|
(->> output (assoc (intern macro-name)) cdr (assoc 'uri) cdr))))
|
|
(->> (arc--call-conduit "macro.query" `(:names (,macro-name)))
|
|
(funcall extract-uri) (funcall download-uri) message)))
|
|
|
|
|
|
;;; ----------------------------------------------------------------------------
|
|
;;; arc paste commands.
|
|
(defun arc-paste (start end)
|
|
"Pastes the specified region from START to END (or whole file) with arcanist.
|
|
|
|
The resulting URL is stored in the kill ring and messaged in the minibuffer."
|
|
(interactive (if (use-region-p) `(,(region-beginning) ,(region-end))
|
|
`(,(point-min) ,(point-max))))
|
|
|
|
(let ((title (when (buffer-file-name)
|
|
(list "--title" (file-name-nondirectory (buffer-file-name)))))
|
|
(content (buffer-substring start end)))
|
|
(with-temp-buffer
|
|
(let ((tmp-file (make-temp-file "arc-paste")))
|
|
(with-temp-file tmp-file (insert content))
|
|
(apply 'call-process "pastry" tmp-file `(,(current-buffer) nil) nil
|
|
"--json" title)
|
|
(goto-char (point-min))
|
|
(let ((json-object-type 'alist)
|
|
(last-json))
|
|
(while (not (eobp)) ;; Pastry dumps *many* JSON objects.
|
|
(setq last-json (json-read))
|
|
(json-skip-whitespace))
|
|
(->> last-json ;; Starting with the last JSON object we got...
|
|
(assoc 'data) ;; ...grab the "data" element...
|
|
cdr ;; ...well, its value...
|
|
(assoc 'createdPaste) ;; ...then "createdPaste"...
|
|
cdr ;; ...(ugh)...
|
|
(assoc 'url) ;; ...then "url"...
|
|
cdr ;; ...(gosh darn it!)...
|
|
message ;; ...then show it to the user...
|
|
kill-new)))))) ;; ...and drop it into the kill ring. Easy!
|
|
|
|
;;; ----------------------------------------------------------------------------
|
|
;;; arc inlines commands
|
|
(defun arc-inlines ()
|
|
"Display the inlines for the current branch in a compilation buffer."
|
|
(interactive)
|
|
(let ((previous-dir default-directory))
|
|
(unwind-protect
|
|
(save-excursion
|
|
(cd (projectile-project-root))
|
|
(compile (format "%s inlines" arc-binary)))
|
|
(cd previous-dir))))
|
|
|
|
;;; ----------------------------------------------------------------------------
|
|
;;; arc browse commands
|
|
(defun arc--repo-prefix ()
|
|
"So fbcode2, fbcode_contbuild dirs should still map to fbcode."
|
|
(->> (-first
|
|
(lambda (p) (s-starts-with? (car p) (projectile-project-name)))
|
|
arc-repo-prefix-list)
|
|
cdr))
|
|
|
|
(defun arc-browse (start end)
|
|
"Paste the specified region from START to END (or current line).
|
|
The resulting URL is stored in the kill ring and messaged in the
|
|
minibuffer."
|
|
(interactive (if (use-region-p)
|
|
(mapc 'line-number-at-pos
|
|
`(,(region-beginning) ,(region-end)))
|
|
`(,(line-number-at-pos) ,(line-number-at-pos))))
|
|
(when (not (arc--repo-prefix))
|
|
(error "Not in a known Diffusion repository"))
|
|
(let* ((url (format "%s/%s$%s-%s"
|
|
(arc--repo-prefix)
|
|
(file-relative-name
|
|
(file-truename buffer-file-name)
|
|
(file-truename (projectile-project-root)))
|
|
start end)))
|
|
(->> url message kill-new)))
|
|
|
|
|
|
;;; ----------------------------------------------------------------------------
|
|
;;; Shortcuts
|
|
(global-set-key (kbd "C-c C-a i") 'arc-inlines)
|
|
(global-set-key (kbd "C-c C-a b") 'arc-browse)
|
|
(global-set-key (kbd "C-c C-a p") 'arc-paste)
|
|
(global-set-key (kbd "C-c C-a m") 'arc-insert-macro)
|
|
|
|
(provide '50-arc)
|
|
;;; 50-arc.el ends here
|