Fun new stuff in site-lisp
This commit is contained in:
John Doty
parent
d68cc8afb9
commit
f488db1819
6 changed files with 5360 additions and 0 deletions
139
site-lisp/50-arc.el
Normal file
139
site-lisp/50-arc.el
Normal file
|
|
@ -0,0 +1,139 @@
|
||||||
|
;; 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* ((extract-uri (lambda (output) (->> output (assoc 'uri) cdr))))
|
||||||
|
(->> (arc--call-conduit "paste.create"
|
||||||
|
`(:title ,(when (buffer-file-name) (file-name-nondirectory (buffer-file-name)))
|
||||||
|
:content ,(buffer-substring start end)))
|
||||||
|
(funcall extract-uri) message kill-new)))
|
||||||
|
|
||||||
|
|
||||||
|
;;; ----------------------------------------------------------------------------
|
||||||
|
;;; 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
|
||||||
4720
site-lisp/color.term.el
Normal file
4720
site-lisp/color.term.el
Normal file
File diff suppressed because it is too large
Load diff
207
site-lisp/fb-note-publish.el
Normal file
207
site-lisp/fb-note-publish.el
Normal file
|
|
@ -0,0 +1,207 @@
|
||||||
|
;;; fb-note-publish.el --- Publish a markdown doc as a note -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2017 John Doty
|
||||||
|
|
||||||
|
;; Author: John Doty <doty@fb.com>
|
||||||
|
;; Keywords: wp, comm
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; This module provides some functions for publishing a markdown document as
|
||||||
|
;; a facebook note. (It's derived from the disseminate project's publishing
|
||||||
|
;; library, and it uses the same interngraph endpoint.)
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(require 'json)
|
||||||
|
(require 'subr-x)
|
||||||
|
(require 'url)
|
||||||
|
(require 'url-vars)
|
||||||
|
|
||||||
|
;; This is the unique app-id for authenticating to interngraph.
|
||||||
|
(defconst fbn--app-id "1910641509202249")
|
||||||
|
|
||||||
|
;; Go ahead and change this to '$USER.sb' if you want to test against your
|
||||||
|
;; devserver.
|
||||||
|
(defconst fbn--interngraph-tier "intern")
|
||||||
|
|
||||||
|
(defun fbn--keychain (secret secret-group &optional secrets-tool-path)
|
||||||
|
"Extract the SECRET in SECRET-GROUP using the secret_tool at SECRETS-TOOL-PATH."
|
||||||
|
(let ((tool-path (or secrets-tool-path "/usr/local/bin/secrets_tool")))
|
||||||
|
(with-temp-buffer
|
||||||
|
(call-process tool-path nil t nil "get_from_group" secret secret-group)
|
||||||
|
(string-trim (buffer-string)))))
|
||||||
|
|
||||||
|
(defun fbn--get-secret-token ()
|
||||||
|
"Extract the secret interngraph token for the disseminate library."
|
||||||
|
(fbn--keychain "INTERNGRAPH_TOKEN" "FBNOTE_PUBLISH"))
|
||||||
|
|
||||||
|
(defun fbn--intern-graph-url (path)
|
||||||
|
"Construct the url to PATH on the intern graph."
|
||||||
|
(concat "https://interngraph." fbn--interngraph-tier ".facebook.com/" path))
|
||||||
|
|
||||||
|
(defun fbn--get-unixname ()
|
||||||
|
"Get the unixname of the currently executing user."
|
||||||
|
(getenv "USER"))
|
||||||
|
|
||||||
|
(defun fbn--invoke-json (path params)
|
||||||
|
"Invoke the intern graph PATH with PARAMS.
|
||||||
|
|
||||||
|
Params should be a list of key/value cons cells describing form request data.
|
||||||
|
We return the resulting JSON, decoded."
|
||||||
|
(let
|
||||||
|
((url (fbn--intern-graph-url path))
|
||||||
|
(url-request-method "POST")
|
||||||
|
(url-proxy-services nil)
|
||||||
|
(url-request-data
|
||||||
|
(mapconcat (lambda (pair)
|
||||||
|
(format "%s=%s"
|
||||||
|
(car pair)
|
||||||
|
(url-hexify-string (cdr pair))))
|
||||||
|
params
|
||||||
|
"&")))
|
||||||
|
(with-current-buffer (url-retrieve-synchronously url)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(re-search-forward "^$")
|
||||||
|
(json-read)
|
||||||
|
)))
|
||||||
|
|
||||||
|
(defun fbn--publish (title note-id note-html)
|
||||||
|
"Publish a note with specified TITLE, NOTE-ID, and NOTE-HTML.
|
||||||
|
|
||||||
|
NOTE-ID may be nil to create a new note, or the ID of an existing note. This
|
||||||
|
function returns the ID of the created note."
|
||||||
|
(let ((json-response (fbn--invoke-json
|
||||||
|
"research/note/"
|
||||||
|
`((app . ,fbn--app-id)
|
||||||
|
(token . ,(fbn--get-secret-token))
|
||||||
|
(title . ,title)
|
||||||
|
(unixname . ,(fbn--get-unixname))
|
||||||
|
(note_id . ,note-id)
|
||||||
|
(html . ,note-html)))))
|
||||||
|
(cdr (assoc 'note_id json-response))))
|
||||||
|
|
||||||
|
(defun fbn--convert (&optional buffer)
|
||||||
|
"Convert the specified BUFFER to the correct html.
|
||||||
|
|
||||||
|
Here we force the use of pandoc since we don't want to have to do
|
||||||
|
that silly thing where we split out the YAML frontmatter first,
|
||||||
|
and of course we expect that frontmatter to exist so that we can
|
||||||
|
stash the note ID there."
|
||||||
|
(let ((in-buffer (or buffer (current-buffer))))
|
||||||
|
(with-temp-buffer
|
||||||
|
(let ((out-buffer (current-buffer)))
|
||||||
|
(with-current-buffer in-buffer
|
||||||
|
(call-process-region (point-min) (point-max)
|
||||||
|
"pandoc" nil out-buffer nil
|
||||||
|
"-f" "markdown+yaml_metadata_block"
|
||||||
|
"-t" "html"
|
||||||
|
))
|
||||||
|
(string-trim (buffer-string))))))
|
||||||
|
|
||||||
|
(defun fbn--frontmatter-end (&optional buffer)
|
||||||
|
"Go to the end of the frontmatter in BUFFER."
|
||||||
|
(let ((in-buffer (or buffer (current-buffer))))
|
||||||
|
(with-current-buffer in-buffer
|
||||||
|
(let ((frontmatter-start))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(unless (looking-at "^---$")
|
||||||
|
(error "This buffer does not have frontmatter"))
|
||||||
|
(setq frontmatter-start (match-end 0))
|
||||||
|
(goto-char frontmatter-start)
|
||||||
|
(unless (re-search-forward "^---$" (point-max) t)
|
||||||
|
(error "Cannot find the end of the frontmatter"))
|
||||||
|
(goto-char (match-beginning 0))
|
||||||
|
(point)))))
|
||||||
|
|
||||||
|
(defun fbn--unquote (value)
|
||||||
|
"Unquote the specified VALUE, if it is quoted."
|
||||||
|
(cond
|
||||||
|
;; Appears to be quoted.
|
||||||
|
((string-prefix-p "\"" value)
|
||||||
|
(let* ((value (replace-regexp-in-string "\\\\\\\"" "\"" value))
|
||||||
|
(value (substring value 1 -1)))
|
||||||
|
value))
|
||||||
|
;; Not quoted.
|
||||||
|
(t value)))
|
||||||
|
|
||||||
|
(ert-deftest fbn-test-unquote ()
|
||||||
|
"Test that unquoting front matter values works properly"
|
||||||
|
(should (equal (fbn--unquote "Foo") "Foo"))
|
||||||
|
(should (equal (fbn--unquote "\"Foo\"") "Foo"))
|
||||||
|
(should (equal (fbn--unquote "\" \\\" \"") " \" ")))
|
||||||
|
|
||||||
|
(defun fbn--frontmatter-field (field buffer)
|
||||||
|
"Fetch the specified FIELD from the specified BUFFER.
|
||||||
|
|
||||||
|
If successful, this function returns the field value (as a
|
||||||
|
string), and also leaves the point at the beginning of the note
|
||||||
|
entry."
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(goto-char (fbn--frontmatter-end buffer))
|
||||||
|
(if (re-search-backward (concat "^" field ": \\(\.\+\\)") nil t)
|
||||||
|
(fbn--unquote (match-string-no-properties 1)))))
|
||||||
|
|
||||||
|
(defun fbn--set-frontmatter-field (field value buffer)
|
||||||
|
"Set the specified FIELD to VALUE in the specified BUFFER.
|
||||||
|
|
||||||
|
This replaces the existing field value, if present, otherwise it
|
||||||
|
adds it."
|
||||||
|
(let ((in-buffer (or buffer (current-buffer))))
|
||||||
|
(with-current-buffer in-buffer
|
||||||
|
(let ((existing-value))
|
||||||
|
(setq existing-value (fbn--frontmatter-field field buffer))
|
||||||
|
(unless (equal value existing-value)
|
||||||
|
(if existing-value
|
||||||
|
(delete-region (line-beginning-position)
|
||||||
|
(progn (forward-line 1) (point))))
|
||||||
|
(fbn--frontmatter-end buffer)
|
||||||
|
(insert (concat field ": " value "\n"))
|
||||||
|
)))))
|
||||||
|
|
||||||
|
(defun fbn--note-id (&optional buffer)
|
||||||
|
"Get the existing note ID out of BUFFER.
|
||||||
|
|
||||||
|
If successful, this function returns the note ID (as a string), and also leaves
|
||||||
|
the point at the beginning of the note entry."
|
||||||
|
(fbn--frontmatter-field "fbnote" buffer))
|
||||||
|
|
||||||
|
(defun fbn--note-title (&optional buffer)
|
||||||
|
"Get the existing note title out of BUFFER.
|
||||||
|
|
||||||
|
If successful, this function returns the note title (as a
|
||||||
|
string), and also leaves the point at the beginning of the note
|
||||||
|
entry."
|
||||||
|
(fbn--frontmatter-field "title" buffer))
|
||||||
|
|
||||||
|
(defun fbn--set-note-id (id &optional buffer)
|
||||||
|
"Set the specified ID into the frontmatter in BUFFER.
|
||||||
|
|
||||||
|
This replaces the existing ID, if present, otherwise it adds it."
|
||||||
|
(let ((in-buffer (or buffer (current-buffer))))
|
||||||
|
(with-current-buffer in-buffer
|
||||||
|
(let ((existing-id))
|
||||||
|
(setq existing-id (fbn--note-id buffer))
|
||||||
|
(unless (equal id existing-id)
|
||||||
|
(if existing-id
|
||||||
|
(delete-region (line-beginning-position)
|
||||||
|
(progn (forward-line 1) (point))))
|
||||||
|
(fbn--frontmatter-end buffer)
|
||||||
|
(insert (concat "fbnote: " id "\n"))
|
||||||
|
)))))
|
||||||
|
|
||||||
|
(defun fbnote-publish-markdown (&optional buffer)
|
||||||
|
"Publish the current markdown BUFFER as a facebook note."
|
||||||
|
(interactive)
|
||||||
|
(let ((in-buffer (or buffer (current-buffer))))
|
||||||
|
(save-excursion
|
||||||
|
(with-current-buffer in-buffer
|
||||||
|
(let ((note-id (fbn--note-id in-buffer))
|
||||||
|
(note-title (fbn--note-title in-buffer))
|
||||||
|
(note-html (fbn--convert in-buffer))
|
||||||
|
(new-id))
|
||||||
|
(setq new-id (fbn--publish note-title note-id note-html))
|
||||||
|
(fbn--set-note-id new-id)
|
||||||
|
(message (concat "Published note " new-id)))))))
|
||||||
|
|
||||||
|
(provide 'fb-note-publish)
|
||||||
|
;;; fb-note-publish.el ends here
|
||||||
BIN
site-lisp/fb-note-publish.elc
Normal file
BIN
site-lisp/fb-note-publish.elc
Normal file
Binary file not shown.
66
site-lisp/ox-quip.el
Normal file
66
site-lisp/ox-quip.el
Normal file
|
|
@ -0,0 +1,66 @@
|
||||||
|
;;; ox-quip.el -- Publish from org-mode to Quip.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;; Publisher from org-mode to Quip. (Export as markdown, push as a new
|
||||||
|
;; thread or amend to existing quip thread.)
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(require 'cl-extra)
|
||||||
|
(require 'ox-md)
|
||||||
|
(require 'quip)
|
||||||
|
|
||||||
|
|
||||||
|
(org-export-define-derived-backend 'quip-html 'html
|
||||||
|
:options-alist
|
||||||
|
'((:section-numbers nil "num" nil)
|
||||||
|
(:with-toc nil "toc" nil))
|
||||||
|
|
||||||
|
|
||||||
|
(defun org-quip--get-thread-identifier ()
|
||||||
|
"Get the Quip thread identifier from the doc in the current buffer, if any."
|
||||||
|
(org-entry-get nil "quip-id" t))
|
||||||
|
|
||||||
|
(defun org-quip--put-thread-identifier (identifier)
|
||||||
|
"Put the Quip thread identifier in IDENTIFIER into the doc."
|
||||||
|
(save-excursion
|
||||||
|
(while (org-up-heading-safe))
|
||||||
|
(org-entry-put nil "quip-id" identifier)))
|
||||||
|
|
||||||
|
(defun org-quip--publish-quip (content)
|
||||||
|
"Publish CONTENT as a new Quip document. Return the ID of the new document."
|
||||||
|
(let ((response (quip-new-document content)))
|
||||||
|
(cdr (assoc 'id (cdr (assoc 'thread response))))))
|
||||||
|
|
||||||
|
(defun org-quip-publish-to-quip ()
|
||||||
|
"Publish the current buffer to Quip."
|
||||||
|
(interactive)
|
||||||
|
(let
|
||||||
|
((quip-id (org-quip--get-thread-identifier))
|
||||||
|
(content (org-export-as 'md)))
|
||||||
|
(if quip-id
|
||||||
|
(org-quip-update-quip quip-id content)
|
||||||
|
(let ((new-quip-id (org-quip--publish-quip content)))
|
||||||
|
(org-quip--put-thread-identifier new-quip-id)))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; Org-to-quip filter:
|
||||||
|
;;
|
||||||
|
;; So, Quip HTML is a very specific, strict subset of HTML. Quip has only a
|
||||||
|
;; few different block types, and it can't do certain things (like
|
||||||
|
;; multi-paragraph list items.)
|
||||||
|
;;
|
||||||
|
;; Structure:
|
||||||
|
;; - A list of top-level items:
|
||||||
|
;;
|
||||||
|
;; Headlines: <h1> <h2> <h3>
|
||||||
|
;; Block quotes: <blockquote>
|
||||||
|
;; Code block: <pre>
|
||||||
|
;;
|
||||||
|
;; <h3>
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'ox-quip)
|
||||||
|
;;; ox-quip.el ends here
|
||||||
228
site-lisp/quip.el
Normal file
228
site-lisp/quip.el
Normal file
|
|
@ -0,0 +1,228 @@
|
||||||
|
;;; quip.el --- Quip API client for emacs -*- lexical-binding: t; -*-
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'json)
|
||||||
|
(require 'url)
|
||||||
|
|
||||||
|
|
||||||
|
;; Customization groups
|
||||||
|
(defgroup quip-api nil
|
||||||
|
"Customization options for using the Quip API"
|
||||||
|
:prefix "quip-"
|
||||||
|
:group 'external
|
||||||
|
:tag "Quip")
|
||||||
|
|
||||||
|
(defcustom quip-api-key ""
|
||||||
|
"Your API key for Quip.
|
||||||
|
|
||||||
|
Get it from https://fb.quip.com/api/personal-token."
|
||||||
|
:type 'string
|
||||||
|
:group 'quip-api)
|
||||||
|
|
||||||
|
(defun quip-invoke-json (path method params)
|
||||||
|
"Make a request to the Quip API, and return the parsed JSON from the response.
|
||||||
|
|
||||||
|
A Quip API call involves issuing an HTTP request to path PATH,
|
||||||
|
with method METHOD, and parameters PARAMS. This routine knows the
|
||||||
|
base URL and adds the necessary headers."
|
||||||
|
(if (not quip-api-key)
|
||||||
|
(error "%s"
|
||||||
|
"The custom variable quip-api-key is undefined. Use custom-set-variable to set it before using quip."))
|
||||||
|
(let
|
||||||
|
((url (concat "https://platform.quip.com/1/" path))
|
||||||
|
(url-request-method method)
|
||||||
|
(url-request-extra-headers `(("Authorization" . ,(concat "Bearer " quip-api-key))
|
||||||
|
("Content-Type" . "application/x-www-form-urlencoded")))
|
||||||
|
(url-request-data
|
||||||
|
(mapconcat (lambda (pair) (format "%s=%s" (car pair) (url-hexify-string (cdr pair))))
|
||||||
|
params
|
||||||
|
"&")))
|
||||||
|
(with-current-buffer (url-retrieve-synchronously url)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(re-search-forward "^$")
|
||||||
|
(json-read))))
|
||||||
|
|
||||||
|
(defun quip-new-document (content &optional format)
|
||||||
|
"Create a new Quip document with the provided CONTENT.
|
||||||
|
|
||||||
|
This function returns the parsed JSON response. The optional
|
||||||
|
FORMAT argument is one of 'html' or 'markdown', and indicates
|
||||||
|
that the content should be interpreted as such."
|
||||||
|
(quip-invoke-json "threads/new-document"
|
||||||
|
"POST"
|
||||||
|
`((format . ,(or format "markdown"))
|
||||||
|
(content . ,content))))
|
||||||
|
|
||||||
|
(defun quip-get-thread (id)
|
||||||
|
"Get the Quip thread with the specified ID. Return the parsed JSON response."
|
||||||
|
(quip-invoke-json (concat "threads/" id) "GET" nil))
|
||||||
|
|
||||||
|
(defconst quip-location-append 0)
|
||||||
|
(defconst quip-location-prepend 1)
|
||||||
|
(defconst quip-location-after-section 2)
|
||||||
|
(defconst quip-location-before-section 3)
|
||||||
|
(defconst quip-location-replace-section 4)
|
||||||
|
(defconst quip-location-delete-section 5)
|
||||||
|
|
||||||
|
(defun quip-thread-append (thread content &optional format)
|
||||||
|
; checkdoc-order: nil
|
||||||
|
"Append CONTENT to the specified THREAD.
|
||||||
|
|
||||||
|
The optional FORMAT argument is one of 'html' or 'markdown', and
|
||||||
|
indicates how the content is to be interpreted."
|
||||||
|
(quip-invoke-json "threads/edit-document"
|
||||||
|
"POST"
|
||||||
|
`((format . ,(or format "markdown"))
|
||||||
|
(content . ,content)
|
||||||
|
(location . ,quip-location-append)
|
||||||
|
(thread_id . ,thread))))
|
||||||
|
|
||||||
|
(defun quip-thread-prepend (thread content &optional format)
|
||||||
|
; checkdoc-order: nil
|
||||||
|
"Prepend CONTENT to the specified THREAD.
|
||||||
|
|
||||||
|
The optional FORMAT argument is one of 'html' or 'markdown', and
|
||||||
|
indicates how the content is to be interpreted."
|
||||||
|
(quip-invoke-json "threads/edit-document"
|
||||||
|
"POST"
|
||||||
|
`((format . ,(or format "markdown"))
|
||||||
|
(content . ,content)
|
||||||
|
(location . ,quip-location-prepend)
|
||||||
|
(thread_id . ,thread))))
|
||||||
|
|
||||||
|
(defun quip-thread-append-after (thread section content &optional format)
|
||||||
|
; checkdoc-order: nil
|
||||||
|
"Append CONTENT to specified SECTION in the specified THREAD.
|
||||||
|
|
||||||
|
The content is appended after the specified section.
|
||||||
|
|
||||||
|
The optional FORMAT argument is one of 'html' or 'markdown', and
|
||||||
|
indicates how the content is to be interpreted."
|
||||||
|
(quip-invoke-json "threads/edit-document"
|
||||||
|
"POST"
|
||||||
|
`((format . ,(or format "markdown"))
|
||||||
|
(content . ,content)
|
||||||
|
(location . ,quip-location-after-section)
|
||||||
|
(section_id . ,section)
|
||||||
|
(thread_id . ,thread))))
|
||||||
|
|
||||||
|
(defun quip-thread-prepend-before (thread section content &optional format)
|
||||||
|
; checkdoc-order: nil
|
||||||
|
"Prepend CONTENT to the specified SECTION of THREAD.
|
||||||
|
|
||||||
|
The content is added before the specified section.
|
||||||
|
|
||||||
|
The optional FORMAT argument is one of 'html' or 'markdown', and
|
||||||
|
indicates how the content is to be interpreted."
|
||||||
|
(quip-invoke-json "threads/edit-document"
|
||||||
|
"POST"
|
||||||
|
`((format . ,(or format "markdown"))
|
||||||
|
(content . ,content)
|
||||||
|
(location . ,quip-location-before-section)
|
||||||
|
(section_id . ,section)
|
||||||
|
(thread_id . ,thread))))
|
||||||
|
|
||||||
|
(defun quip-thread-replace-section (thread section content &optional format)
|
||||||
|
; checkdoc-order: nil
|
||||||
|
"Replace the specified SECTION of THREAD with the specified CONTENT.
|
||||||
|
|
||||||
|
The optional FORMAT argument is one of 'html' or 'markdown', and
|
||||||
|
indicates how the content is to be interpreted."
|
||||||
|
(quip-invoke-json "threads/edit-document"
|
||||||
|
"POST"
|
||||||
|
`((format . ,(or format "markdown"))
|
||||||
|
(content . ,content)
|
||||||
|
(location . ,quip-location-replace-section)
|
||||||
|
(section_id . ,section)
|
||||||
|
(thread_id . ,thread))))
|
||||||
|
|
||||||
|
(defun quip-thread-delete-section (thread section)
|
||||||
|
; checkdoc-order: nil
|
||||||
|
"Delete the specified SECTION of THREAD."
|
||||||
|
(quip-invoke-json "threads/edit-document"
|
||||||
|
"POST"
|
||||||
|
`((location . ,quip-location-delete-section)
|
||||||
|
(section_id . ,section)
|
||||||
|
(thread_id . ,thread))))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Content parsing functions
|
||||||
|
|
||||||
|
(defun quip-get-item-type (item)
|
||||||
|
"Classify the specified HTML ITEM."
|
||||||
|
(let ((elem-type (car item)))
|
||||||
|
(cond
|
||||||
|
((eq elem-type 'p) 'paragraph)
|
||||||
|
((eq elem-type 'h1) 'h1)
|
||||||
|
((eq elem-type 'h2) 'h2)
|
||||||
|
((eq elem-type 'h3) 'h3)
|
||||||
|
((eq elem-type 'blockquote) 'block-quote)
|
||||||
|
((eq elem-type 'q) 'pull-quote)
|
||||||
|
((eq elem-type 'pre) 'code-block)
|
||||||
|
((eq elem-type 'li) 'list-item)
|
||||||
|
((eq elem-type 'span) 'span)
|
||||||
|
((eq elem-type 'div)
|
||||||
|
(letrec ((inner (cl-caddr item))
|
||||||
|
(inner-elem-type (car inner)))
|
||||||
|
(cond
|
||||||
|
((eq inner-elem-type 'ul) 'ul)
|
||||||
|
((eq inner-elem-type 'ol) 'ol)
|
||||||
|
(t 'unrecognized-inner))))
|
||||||
|
(t 'unrecognized))))
|
||||||
|
|
||||||
|
(defun quip-get-item-id (item type)
|
||||||
|
"Extract the ID from the provided ITEM given its TYPE."
|
||||||
|
(let ((attribs (cadr item)))
|
||||||
|
(cond
|
||||||
|
((or (eq type 'ul) ;; Nested IDs.
|
||||||
|
(eq type 'ol))
|
||||||
|
(letrec ((inner (cl-caddr item))
|
||||||
|
(inner-attribs (cadr inner)))
|
||||||
|
(assoc-default 'id inner-attribs)))
|
||||||
|
(t (assoc-default 'id attribs)))))
|
||||||
|
|
||||||
|
(defun quip-get-item-content (item type)
|
||||||
|
"Extract the content from the provided ITEM given its TYPE."
|
||||||
|
(cond
|
||||||
|
((or (eq type 'ul) ;; Nested Content
|
||||||
|
(eq type 'ol))
|
||||||
|
(letrec ((inner (cl-caddr item))
|
||||||
|
(inner-elems (cddr inner)))
|
||||||
|
(mapcar #'quip-get-item-from-element inner-elems)))
|
||||||
|
(t (cl-caddr item))))
|
||||||
|
|
||||||
|
(cl-defstruct quip-item type id content)
|
||||||
|
|
||||||
|
(defun quip-get-item-from-element (element)
|
||||||
|
"Construct a (type, id, content) list from the given ELEMENT."
|
||||||
|
(letrec
|
||||||
|
((item-type (quip-get-item-type element))
|
||||||
|
(item-id (quip-get-item-id element item-type))
|
||||||
|
(item-content (quip-get-item-content element item-type)))
|
||||||
|
(make-quip-item
|
||||||
|
:type item-type
|
||||||
|
:id item-id
|
||||||
|
:content item-content)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun quip-parse-html-content (html)
|
||||||
|
"Parse the provided HTML into a list of (type, item, content) lists."
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert html)
|
||||||
|
(letrec
|
||||||
|
((parsed-html (libxml-parse-html-region (point-min) (point-max)))
|
||||||
|
(raw-items (cddr (cl-caddr parsed-html)))
|
||||||
|
(html-items (cl-remove-if #'stringp raw-items)))
|
||||||
|
|
||||||
|
(mapcar #'quip-get-item-from-element html-items)
|
||||||
|
)))
|
||||||
|
|
||||||
|
;; (prin1
|
||||||
|
;; (quip-parse-html-content
|
||||||
|
;; (assoc-default 'html (quip-get-thread "idflAWG6R6Uu"))))
|
||||||
|
|
||||||
|
(provide 'quip)
|
||||||
|
;;; quip.el ends here
|
||||||
Loading…
Add table
Add a link
Reference in a new issue