My personal configuration files for Doom emacs
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

791 lines
32 KiB

  1. ;;; custom/leo-restclient.el -*- lexical-binding: t; -*-
  2. ;;; leo/restclient.el --- An interactive HTTP client for Emacs
  3. ;;
  4. ;; Public domain.
  5. ;; Author: Pavel Kurnosov <pashky@gmail.com>
  6. ;; Maintainer: Pavel Kurnosov <pashky@gmail.com>
  7. ;; Created: 01 Apr 2012
  8. ;; Keywords: http
  9. ;; This file is not part of GNU Emacs.
  10. ;; This file is public domain software. Do what you want.
  11. ;;; Commentary:
  12. ;;
  13. ;; This is a tool to manually explore and test HTTP REST
  14. ;; webservices. Runs queries from a plain-text query sheet, displays
  15. ;; results as a pretty-printed XML, JSON and even images.
  16. ;;; Code:
  17. ;;
  18. (require 'url)
  19. (require 'json)
  20. (require 'outline)
  21. (eval-when-compile (require 'subr-x))
  22. (eval-when-compile (require 'cl))
  23. (defgroup leo/restclient nil
  24. "An interactive HTTP client for Emacs."
  25. :group 'tools)
  26. (defcustom leo/restclient-log-request t
  27. "Log leo/restclient requests to *Messages*."
  28. :group 'leo/restclient
  29. :type 'boolean)
  30. (defcustom leo/restclient-same-buffer-response t
  31. "Re-use same buffer for responses or create a new one each time."
  32. :group 'leo/restclient
  33. :type 'boolean)
  34. (defcustom leo/restclient-same-buffer-response-name "*HTTP Response*"
  35. "Name for response buffer."
  36. :group 'leo/restclient
  37. :type 'string)
  38. (defcustom leo/restclient-info-buffer-name "*Leo/Restclient Info*"
  39. "Name for info buffer."
  40. :group 'leo/restclient
  41. :type 'string)
  42. (defcustom leo/restclient-inhibit-cookies nil
  43. "Inhibit leo/restclient from sending cookies implicitly."
  44. :group 'leo/restclient
  45. :type 'boolean)
  46. (defcustom leo/restclient-content-type-modes '(("text/xml" . xml-mode)
  47. ("text/plain" . text-mode)
  48. ("application/xml" . xml-mode)
  49. ("application/json" . js-mode)
  50. ("image/png" . image-mode)
  51. ("image/jpeg" . image-mode)
  52. ("image/jpg" . image-mode)
  53. ("image/gif" . image-mode)
  54. ("text/html" . html-mode))
  55. "An association list mapping content types to buffer modes"
  56. :group 'leo/restclient
  57. :type '(alist :key-type string :value-type symbol))
  58. (defgroup leo/restclient-faces nil
  59. "Faces used in Leo/Restclient Mode"
  60. :group 'leo/restclient
  61. :group 'faces)
  62. (defface leo/restclient-variable-name-face
  63. '((t (:inherit font-lock-preprocessor-face)))
  64. "Face for variable name."
  65. :group 'leo/restclient-faces)
  66. (defface leo/restclient-variable-string-face
  67. '((t (:inherit font-lock-string-face)))
  68. "Face for variable value (string)."
  69. :group 'leo/restclient-faces)
  70. (defface leo/restclient-variable-elisp-face
  71. '((t (:inherit font-lock-function-name-face)))
  72. "Face for variable value (Emacs lisp)."
  73. :group 'leo/restclient-faces)
  74. (defface leo/restclient-variable-multiline-face
  75. '((t (:inherit font-lock-doc-face)))
  76. "Face for multi-line variable value marker."
  77. :group 'leo/restclient-faces)
  78. (defface leo/restclient-variable-usage-face
  79. '((t (:inherit leo/restclient-variable-name-face)))
  80. "Face for variable usage (only used when headers/body is represented as a single variable, not highlighted when variable appears in the middle of other text)."
  81. :group 'leo/restclient-faces)
  82. (defface leo/restclient-method-face
  83. '((t (:inherit font-lock-keyword-face)))
  84. "Face for HTTP method."
  85. :group 'leo/restclient-faces)
  86. (defface leo/restclient-url-face
  87. '((t (:inherit font-lock-function-name-face)))
  88. "Face for variable value (Emacs lisp)."
  89. :group 'leo/restclient-faces)
  90. (defface leo/restclient-file-upload-face
  91. '((t (:inherit leo/restclient-variable-multiline-face)))
  92. "Face for highlighting upload file paths."
  93. :group 'leo/restclient-faces)
  94. (defface leo/restclient-header-name-face
  95. '((t (:inherit font-lock-variable-name-face)))
  96. "Face for HTTP header name."
  97. :group 'leo/restclient-faces)
  98. (defface leo/restclient-header-value-face
  99. '((t (:inherit font-lock-string-face)))
  100. "Face for HTTP header value."
  101. :group 'leo/restclient-faces)
  102. (defface leo/restclient-request-hook-face
  103. '((t (:inherit font-lock-preprocessor-face)))
  104. "Face for single request hook indicator."
  105. :group 'leo/restclient-faces)
  106. (defface leo/restclient-request-hook-name-face
  107. '((t (:inherit font-lock-function-name-face)))
  108. "Face for single request hook type names."
  109. :group 'leo/restclient-faces)
  110. (defface leo/restclient-request-hook-args-face
  111. '((t (:inherit font-lock-string-face)))
  112. "Face for single request hook type arguments."
  113. :group 'leo/restclient-faces)
  114. (defvar leo/restclient-within-call nil)
  115. (defvar leo/restclient-request-time-start nil)
  116. (defvar leo/restclient-request-time-end nil)
  117. (defvar leo/restclient-var-overrides nil
  118. "An alist of vars that will override any set in the file,
  119. also where dynamic vars set on callbacks are stored.")
  120. (defvar leo/restclient-result-handlers '()
  121. "A registry of available completion hooks.
  122. Stored as an alist of name -> (hook-creation-func . description)")
  123. (defvar leo/restclient-curr-request-functions nil
  124. "A list of functions to run once when the next request is loaded")
  125. (defvar leo/restclient-response-loaded-hook nil
  126. "Hook run after response buffer is formatted.")
  127. (defvar leo/restclient-http-do-hook nil
  128. "Hook to run before making request.")
  129. (defvar leo/restclient-response-received-hook nil
  130. "Hook run after data is loaded into response buffer.")
  131. (defcustom leo/restclient-vars-max-passes 10
  132. "Maximum number of recursive variable references. This is to prevent hanging if two variables reference each other directly or indirectly."
  133. :group 'leo/restclient
  134. :type 'integer)
  135. (defconst leo/restclient-comment-separator "#")
  136. (defconst leo/restclient-comment-start-regexp (concat "^" leo/restclient-comment-separator))
  137. (defconst leo/restclient-comment-not-regexp (concat "^[^" leo/restclient-comment-separator "]"))
  138. (defconst leo/restclient-empty-line-regexp "^\\s-*$")
  139. (defconst leo/restclient-method-url-regexp
  140. "^\\(GET\\|POST\\|DELETE\\|PUT\\|HEAD\\|OPTIONS\\|PATCH\\) \\(.*\\)$")
  141. (defconst leo/restclient-header-regexp
  142. "^\\([^](),/:;@[\\{}= \t]+\\): \\(.*\\)$")
  143. (defconst leo/restclient-use-var-regexp
  144. "^\\(:[^: \n]+\\)$")
  145. (defconst leo/restclient-var-regexp
  146. (concat "^\\(:[^:= ]+\\)[ \t]*\\(:?\\)=[ \t]*\\(<<[ \t]*\n\\(\\(.*\n\\)*?\\)" leo/restclient-comment-separator "\\|\\([^<].*\\)$\\)"))
  147. (defconst leo/restclient-svar-regexp
  148. "^\\(:[^:= ]+\\)[ \t]*=[ \t]*\\(.+?\\)$")
  149. (defconst leo/restclient-evar-regexp
  150. "^\\(:[^: ]+\\)[ \t]*:=[ \t]*\\(.+?\\)$")
  151. (defconst leo/restclient-mvar-regexp
  152. "^\\(:[^: ]+\\)[ \t]*:?=[ \t]*\\(<<\\)[ \t]*$")
  153. (defconst leo/restclient-file-regexp
  154. "^<[ \t]*\\([^<>\n\r]+\\)[ \t]*$")
  155. (defconst leo/restclient-content-type-regexp
  156. "^Content-[Tt]ype: \\(\\w+\\)/\\(?:[^\\+\r\n]*\\+\\)*\\([^;\r\n]+\\)")
  157. (defconst leo/restclient-response-hook-regexp
  158. "^\\(->\\) \\([^[:space:]]+\\) +\\(.*\\)$")
  159. ;; The following disables the interactive request for user name and
  160. ;; password should an API call encounter a permission-denied response.
  161. ;; This API is meant to be usable without constant asking for username
  162. ;; and password.
  163. (defadvice url-http-handle-authentication (around leo/restclient-fix)
  164. (if leo/restclient-within-call
  165. (setq ad-return-value t)
  166. ad-do-it))
  167. (ad-activate 'url-http-handle-authentication)
  168. (defadvice url-cache-extract (around leo/restclient-fix-2)
  169. (unless leo/restclient-within-call
  170. ad-do-it))
  171. (ad-activate 'url-cache-extract)
  172. (defadvice url-http-user-agent-string (around leo/restclient-fix-3)
  173. (if leo/restclient-within-call
  174. (setq ad-return-value nil)
  175. ad-do-it))
  176. (ad-activate 'url-http-user-agent-string)
  177. (defun leo/restclient-http-do (method url headers entity &rest handle-args)
  178. "Send ENTITY and HEADERS to URL as a METHOD request."
  179. (if leo/restclient-log-request
  180. (message "HTTP %s %s Headers:[%s] Body:[%s]" method url headers entity))
  181. (let ((url-request-method (encode-coding-string method 'us-ascii))
  182. (url-request-extra-headers '())
  183. (url-request-data (encode-coding-string entity 'utf-8))
  184. (url-mime-charset-string (url-mime-charset-string))
  185. (url-mime-language-string nil)
  186. (url-mime-encoding-string nil)
  187. (url-mime-accept-string nil)
  188. (url-personal-mail-address nil))
  189. (dolist (header headers)
  190. (let* ((mapped (assoc-string (downcase (car header))
  191. '(("from" . url-personal-mail-address)
  192. ("accept-encoding" . url-mime-encoding-string)
  193. ("accept-charset" . url-mime-charset-string)
  194. ("accept-language" . url-mime-language-string)
  195. ("accept" . url-mime-accept-string)))))
  196. (if mapped
  197. (set (cdr mapped) (encode-coding-string (cdr header) 'us-ascii))
  198. (let* ((hkey (encode-coding-string (car header) 'us-ascii))
  199. (hvalue (encode-coding-string (cdr header) 'us-ascii)))
  200. (setq url-request-extra-headers (cons (cons hkey hvalue) url-request-extra-headers))))))
  201. (setq leo/restclient-within-call t)
  202. (setq leo/restclient-request-time-start (current-time))
  203. (run-hooks 'leo/restclient-http-do-hook)
  204. (url-retrieve url 'leo/restclient-http-handle-response
  205. (append (list method url (if leo/restclient-same-buffer-response
  206. leo/restclient-same-buffer-response-name
  207. (format "*HTTP %s %s*" method url))) handle-args) nil leo/restclient-inhibit-cookies)))
  208. (defun leo/restclient-prettify-response (method url)
  209. (save-excursion
  210. (let ((start (point)) (guessed-mode) (end-of-headers))
  211. (while (and (not (looking-at leo/restclient-empty-line-regexp))
  212. (eq (progn
  213. (when (looking-at leo/restclient-content-type-regexp)
  214. (setq guessed-mode
  215. (cdr (assoc-string (concat
  216. (match-string-no-properties 1)
  217. "/"
  218. (match-string-no-properties 2))
  219. leo/restclient-content-type-modes
  220. t))))
  221. (forward-line)) 0)))
  222. (setq end-of-headers (point))
  223. (while (and (looking-at leo/restclient-empty-line-regexp)
  224. (eq (forward-line) 0)))
  225. (unless guessed-mode
  226. (setq guessed-mode
  227. (or (assoc-default nil
  228. ;; magic mode matches
  229. '(("<\\?xml " . xml-mode)
  230. ("{\\s-*\"" . js-mode))
  231. (lambda (re _dummy)
  232. (looking-at re))) 'js-mode)))
  233. (let ((headers (buffer-substring-no-properties start end-of-headers)))
  234. (when guessed-mode
  235. (delete-region start (point))
  236. (unless (eq guessed-mode 'image-mode)
  237. (apply guessed-mode '())
  238. (if (fboundp 'font-lock-flush)
  239. (font-lock-flush)
  240. (with-no-warnings
  241. (font-lock-fontify-buffer))))
  242. (cond
  243. ((eq guessed-mode 'xml-mode)
  244. (goto-char (point-min))
  245. (while (search-forward-regexp "\>[ \\t]*\<" nil t)
  246. (backward-char) (insert "\n"))
  247. (indent-region (point-min) (point-max)))
  248. ((eq guessed-mode 'image-mode)
  249. (let* ((img (buffer-string)))
  250. (delete-region (point-min) (point-max))
  251. (fundamental-mode)
  252. (insert-image (create-image img nil t))))
  253. ((eq guessed-mode 'js-mode)
  254. (let ((json-special-chars (remq (assoc ?/ json-special-chars) json-special-chars))
  255. ;; Emacs 27 json.el uses `replace-buffer-contents' for
  256. ;; pretty-printing which is great because it keeps point and
  257. ;; markers intact but can be very slow with huge minimalized
  258. ;; JSON. We don't need that here.
  259. (json-pretty-print-max-secs 0))
  260. (ignore-errors (json-pretty-print-buffer)))
  261. (leo/restclient-prettify-json-unicode)))
  262. (goto-char (point-max))
  263. (or (eq (point) (point-min)) (insert "\n"))
  264. (let ((hstart (point)))
  265. (insert method " " url "\n" headers)
  266. (insert (format "Request duration: %fs\n" (float-time (time-subtract leo/restclient-request-time-end leo/restclient-request-time-start))))
  267. (unless (member guessed-mode '(image-mode text-mode))
  268. (comment-region hstart (point)))))))))
  269. (defun leo/restclient-prettify-json-unicode ()
  270. (save-excursion
  271. (goto-char (point-min))
  272. (while (re-search-forward "\\\\[Uu]\\([0-9a-fA-F]\\{4\\}\\)" nil t)
  273. (replace-match (char-to-string (decode-char 'ucs (string-to-number (match-string 1) 16))) t nil))))
  274. (defun leo/restclient-http-handle-response (status method url bufname raw stay-in-window)
  275. "Switch to the buffer returned by `url-retreive'.
  276. The buffer contains the raw HTTP response sent by the server."
  277. (setq leo/restclient-within-call nil)
  278. (setq leo/restclient-request-time-end (current-time))
  279. (if (= (point-min) (point-max))
  280. (signal (car (plist-get status :error)) (cdr (plist-get status :error)))
  281. (when (buffer-live-p (current-buffer))
  282. (with-current-buffer (leo/restclient-decode-response
  283. (current-buffer)
  284. bufname
  285. leo/restclient-same-buffer-response)
  286. (run-hooks 'leo/restclient-response-received-hook)
  287. (unless raw
  288. (leo/restclient-prettify-response method url))
  289. (buffer-enable-undo)
  290. (leo/restclient-response-mode)
  291. (run-hooks 'leo/restclient-response-loaded-hook)
  292. (if stay-in-window
  293. (display-buffer (current-buffer) t)
  294. (switch-to-buffer-other-window (current-buffer)))))))
  295. (defun leo/restclient-decode-response (raw-http-response-buffer target-buffer-name same-name)
  296. "Decode the HTTP response using the charset (encoding) specified in the Content-Type header. If no charset is specified, default to UTF-8."
  297. (let* ((charset-regexp "^Content-Type.*charset=\\([-A-Za-z0-9]+\\)")
  298. (image? (save-excursion
  299. (search-forward-regexp "^Content-Type.*[Ii]mage" nil t)))
  300. (encoding (if (save-excursion
  301. (search-forward-regexp charset-regexp nil t))
  302. (intern (downcase (match-string 1)))
  303. 'utf-8)))
  304. (if image?
  305. ;; Dont' attempt to decode. Instead, just switch to the raw HTTP response buffer and
  306. ;; rename it to target-buffer-name.
  307. (with-current-buffer raw-http-response-buffer
  308. ;; We have to kill the target buffer if it exists, or `rename-buffer'
  309. ;; will raise an error.
  310. (when (get-buffer target-buffer-name)
  311. (kill-buffer target-buffer-name))
  312. (rename-buffer target-buffer-name)
  313. raw-http-response-buffer)
  314. ;; Else, switch to the new, empty buffer that will contain the decoded HTTP
  315. ;; response. Set its encoding, copy the content from the unencoded
  316. ;; HTTP response buffer and decode.
  317. (let ((decoded-http-response-buffer
  318. (get-buffer-create
  319. (if same-name target-buffer-name (generate-new-buffer-name target-buffer-name)))))
  320. (with-current-buffer decoded-http-response-buffer
  321. (setq buffer-file-coding-system encoding)
  322. (save-excursion
  323. (erase-buffer)
  324. (insert-buffer-substring raw-http-response-buffer))
  325. (kill-buffer raw-http-response-buffer)
  326. (condition-case nil
  327. (decode-coding-region (point-min) (point-max) encoding)
  328. (error
  329. (message (concat "Error when trying to decode http response with encoding: "
  330. (symbol-name encoding)))))
  331. decoded-http-response-buffer)))))
  332. (defun leo/restclient-current-min ()
  333. (save-excursion
  334. (beginning-of-line)
  335. (if (looking-at leo/restclient-comment-start-regexp)
  336. (if (re-search-forward leo/restclient-comment-not-regexp (point-max) t)
  337. (point-at-bol) (point-max))
  338. (if (re-search-backward leo/restclient-comment-start-regexp (point-min) t)
  339. (point-at-bol 2)
  340. (point-min)))))
  341. (defun leo/restclient-current-max ()
  342. (save-excursion
  343. (if (re-search-forward leo/restclient-comment-start-regexp (point-max) t)
  344. (max (- (point-at-bol) 1) 1)
  345. (progn (goto-char (point-max))
  346. (if (looking-at "^$") (- (point) 1) (point))))))
  347. (defun leo/restclient-replace-all-in-string (replacements string)
  348. (if replacements
  349. (let ((current string)
  350. (pass leo/restclient-vars-max-passes)
  351. (continue t))
  352. (while (and continue (> pass 0))
  353. (setq pass (- pass 1))
  354. (setq current (replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
  355. (lambda (key)
  356. (setq continue t)
  357. (cdr (assoc key replacements)))
  358. current t t)))
  359. current)
  360. string))
  361. (defun leo/restclient-replace-all-in-header (replacements header)
  362. (cons (car header)
  363. (leo/restclient-replace-all-in-string replacements (cdr header))))
  364. (defun leo/restclient-chop (text)
  365. (if text (replace-regexp-in-string "\n$" "" text) nil))
  366. (defun leo/restclient-find-vars-before-point ()
  367. (let ((vars nil)
  368. (bound (point)))
  369. (save-excursion
  370. (goto-char (point-min))
  371. (while (search-forward-regexp leo/restclient-var-regexp bound t)
  372. (let ((name (match-string-no-properties 1))
  373. (should-eval (> (length (match-string 2)) 0))
  374. (value (or (leo/restclient-chop (match-string-no-properties 4)) (match-string-no-properties 3))))
  375. (setq vars (cons (cons name (if should-eval (leo/restclient-eval-var value) value)) vars))))
  376. (append leo/restclient-var-overrides vars))))
  377. (defun leo/restclient-eval-var (string)
  378. (with-output-to-string (princ (eval (read string)))))
  379. (defun leo/restclient-make-header (&optional string)
  380. (cons (match-string-no-properties 1 string)
  381. (match-string-no-properties 2 string)))
  382. (defun leo/restclient-parse-headers (string)
  383. (let ((start 0)
  384. (headers '()))
  385. (while (string-match leo/restclient-header-regexp string start)
  386. (setq headers (cons (leo/restclient-make-header string) headers)
  387. start (match-end 0)))
  388. headers))
  389. (defun leo/restclient-read-file (path)
  390. (with-temp-buffer
  391. (insert-file-contents path)
  392. (buffer-string)))
  393. (defun leo/restclient-parse-body (entity vars)
  394. (if (= 0 (or (string-match leo/restclient-file-regexp entity) 1))
  395. (leo/restclient-read-file (match-string 1 entity))
  396. (leo/restclient-replace-all-in-string vars entity)))
  397. (defun leo/restclient-parse-hook (cb-type args-offset args)
  398. (if-let ((handler (assoc cb-type leo/restclient-result-handlers)))
  399. (funcall (cadr handler) args args-offset)
  400. `(lambda ()
  401. (message "Unknown leo/restclient hook type %s" ,cb-type))))
  402. (defun leo/restclient-register-result-func (name creation-func description)
  403. (let ((new-cell (cons name (cons creation-func description))))
  404. (setq leo/restclient-result-handlers (cons new-cell leo/restclient-result-handlers))))
  405. (defun leo/restclient-remove-var (var-name)
  406. (setq leo/restclient-var-overrides (assoc-delete-all var-name leo/restclient-var-overrides)))
  407. (defun leo/restclient-set-var (var-name value)
  408. (leo/restclient-remove-var var-name)
  409. (setq leo/restclient-var-overrides (cons (cons var-name value) leo/restclient-var-overrides)))
  410. (defun leo/restclient-get-var-at-point (var-name buffer-name buffer-pos)
  411. (message (format "getting var %s form %s at %s" var-name buffer-name buffer-pos))
  412. (let* ((vars-at-point (save-excursion
  413. (switch-to-buffer buffer-name)
  414. (goto-char buffer-pos)
  415. ;; if we're called from a leo/restclient buffer we need to lookup vars before the current hook or evar
  416. ;; outside a leo/restclient buffer only globals are available so moving the point wont matter
  417. (re-search-backward "^:\\|->" (point-min) t)
  418. (leo/restclient-find-vars-before-point))))
  419. (leo/restclient-replace-all-in-string vars-at-point (cdr (assoc var-name vars-at-point)))))
  420. (defmacro leo/restclient-get-var (var-name)
  421. (lexical-let ((buf-name (buffer-name (current-buffer)))
  422. (buf-point (point)))
  423. `(leo/restclient-get-var-at-point ,var-name ,buf-name ,buf-point)))
  424. (defun leo/restclient-single-request-function ()
  425. (dolist (f leo/restclient-curr-request-functions)
  426. (ignore-errors
  427. (funcall f)))
  428. (setq leo/restclient-curr-request-functions nil)
  429. (remove-hook 'leo/restclient-response-loaded-hook 'leo/restclient-single-request-function))
  430. (defun leo/restclient-http-parse-current-and-do (func &rest args)
  431. (save-excursion
  432. (goto-char (leo/restclient-current-min))
  433. (when (re-search-forward leo/restclient-method-url-regexp (point-max) t)
  434. (let ((method (match-string-no-properties 1))
  435. (url (match-string-no-properties 2))
  436. (vars (leo/restclient-find-vars-before-point))
  437. (headers '()))
  438. (forward-line)
  439. (while (cond
  440. ((looking-at leo/restclient-response-hook-regexp)
  441. (when-let (hook-function (leo/restclient-parse-hook (match-string-no-properties 2)
  442. (match-end 2)
  443. (match-string-no-properties 3)))
  444. (push hook-function leo/restclient-curr-request-functions)))
  445. ((and (looking-at leo/restclient-header-regexp) (not (looking-at leo/restclient-empty-line-regexp)))
  446. (setq headers (cons (leo/restclient-replace-all-in-header vars (leo/restclient-make-header)) headers)))
  447. ((looking-at leo/restclient-use-var-regexp)
  448. (setq headers (append headers (leo/restclient-parse-headers (leo/restclient-replace-all-in-string vars (match-string 1)))))))
  449. (forward-line))
  450. (when (looking-at leo/restclient-empty-line-regexp)
  451. (forward-line))
  452. (when leo/restclient-curr-request-functions
  453. (add-hook 'leo/restclient-response-loaded-hook 'leo/restclient-single-request-function))
  454. (let* ((cmax (leo/restclient-current-max))
  455. (entity (leo/restclient-parse-body (buffer-substring (min (point) cmax) cmax) vars))
  456. (url (leo/restclient-replace-all-in-string vars url)))
  457. (apply func method url headers entity args))))))
  458. (defun leo/restclient-copy-curl-command ()
  459. "Formats the request as a curl command and copies the command to the clipboard."
  460. (interactive)
  461. (leo/restclient-http-parse-current-and-do
  462. '(lambda (method url headers entity)
  463. (let ((header-args
  464. (apply 'append
  465. (mapcar (lambda (header)
  466. (list "-H" (format "%s: %s" (car header) (cdr header))))
  467. headers))))
  468. (kill-new (concat "curl "
  469. (mapconcat 'shell-quote-argument
  470. (append '("-i")
  471. header-args
  472. (list (concat "-X" method))
  473. (list url)
  474. (when (> (string-width entity) 0)
  475. (list "-d" entity)))
  476. " "))))
  477. (message "curl command copied to clipboard."))))
  478. (defun leo/restclient-elisp-result-function (args offset)
  479. (goto-char offset)
  480. (lexical-let ((form (macroexpand-all (read (current-buffer)))))
  481. (lambda ()
  482. (eval form))))
  483. (leo/restclient-register-result-func
  484. "run-hook" #'leo/restclient-elisp-result-function
  485. "Call the provided (possibly multi-line) elisp when the result
  486. buffer is formatted. Equivalent to a leo/restclient-response-loaded-hook
  487. that only runs for this request.
  488. eg. -> on-response (message \"my hook called\")" )
  489. ;;;###autoload
  490. (defun leo/restclient-http-send-current (&optional raw stay-in-window)
  491. "Sends current request.
  492. Optional argument RAW don't reformat response if t.
  493. Optional argument STAY-IN-WINDOW do not move focus to response buffer if t."
  494. (interactive)
  495. (leo/restclient-http-parse-current-and-do 'leo/restclient-http-do raw stay-in-window))
  496. ;;;###autoload
  497. (defun leo/restclient-http-send-current-raw ()
  498. "Sends current request and get raw result (no reformatting or syntax highlight of XML, JSON or images)."
  499. (interactive)
  500. (leo/restclient-http-send-current t))
  501. ;;;###autoload
  502. (defun leo/restclient-http-send-current-stay-in-window ()
  503. "Send current request and keep focus in request window."
  504. (interactive)
  505. (leo/restclient-http-send-current nil t))
  506. (defun leo/restclient-jump-next ()
  507. "Jump to next request in buffer."
  508. (interactive)
  509. (let ((last-min nil))
  510. (while (not (eq last-min (goto-char (leo/restclient-current-min))))
  511. (goto-char (leo/restclient-current-min))
  512. (setq last-min (point))))
  513. (goto-char (+ (leo/restclient-current-max) 1))
  514. (goto-char (leo/restclient-current-min)))
  515. (defun leo/restclient-jump-prev ()
  516. "Jump to previous request in buffer."
  517. (interactive)
  518. (let* ((current-min (leo/restclient-current-min))
  519. (end-of-entity
  520. (save-excursion
  521. (progn (goto-char (leo/restclient-current-min))
  522. (while (and (or (looking-at "^\s*\\(#.*\\)?$")
  523. (eq (point) current-min))
  524. (not (eq (point) (point-min))))
  525. (forward-line -1)
  526. (beginning-of-line))
  527. (point)))))
  528. (unless (eq (point-min) end-of-entity)
  529. (goto-char end-of-entity)
  530. (goto-char (leo/restclient-current-min)))))
  531. (defun leo/restclient-mark-current ()
  532. "Mark current request."
  533. (interactive)
  534. (goto-char (leo/restclient-current-min))
  535. (set-mark-command nil)
  536. (goto-char (leo/restclient-current-max))
  537. (backward-char 1)
  538. (setq deactivate-mark nil))
  539. (defun leo/restclient-show-info ()
  540. ;; leo/restclient-info-buffer-name
  541. (interactive)
  542. (let ((vars-at-point (leo/restclient-find-vars-before-point)))
  543. (cl-labels ((non-overidden-vars-at-point ()
  544. (seq-filter (lambda (v)
  545. (null (assoc (car v) leo/restclient-var-overrides)))
  546. vars-at-point))
  547. (sanitize-value-cell (var-value)
  548. (replace-regexp-in-string "\n" "|\n| |"
  549. (replace-regexp-in-string "\|" "\\\\vert{}"
  550. (leo/restclient-replace-all-in-string vars-at-point var-value))))
  551. (var-row (var-name var-value)
  552. (insert "|" var-name "|" (sanitize-value-cell var-value) "|\n"))
  553. (var-table (table-name)
  554. (insert (format "* %s \n|--|\n|Name|Value|\n|---|\n" table-name)))
  555. (var-table-footer ()
  556. (insert "|--|\n\n")))
  557. (with-current-buffer (get-buffer-create leo/restclient-info-buffer-name)
  558. ;; insert our info
  559. (erase-buffer)
  560. (insert "\Leo/Restclient Info\ \n\n")
  561. (var-table "Dynamic Variables")
  562. (dolist (dv leo/restclient-var-overrides)
  563. (var-row (car dv) (cdr dv)))
  564. (var-table-footer)
  565. ;; (insert ":Info:\n Dynamic vars defined by request hooks or with calls to leo/restclient-set-var\n:END:")
  566. (var-table "Vars at current position")
  567. (dolist (dv (non-overidden-vars-at-point))
  568. (var-row (car dv) (cdr dv)))
  569. (var-table-footer)
  570. ;; registered callbacks
  571. (var-table "Registered request hook types")
  572. (dolist (handler-name (delete-dups (mapcar 'car leo/restclient-result-handlers)))
  573. (var-row handler-name (cddr (assoc handler-name leo/restclient-result-handlers))))
  574. (var-table-footer)
  575. (insert "\n\n'q' to exit\n")
  576. (org-mode)
  577. (org-toggle-pretty-entities)
  578. (org-table-iterate-buffer-tables)
  579. (outline-show-all)
  580. (leo/restclient-response-mode)
  581. (goto-char (point-min))))
  582. (switch-to-buffer-other-window leo/restclient-info-buffer-name)))
  583. (defun leo/restclient-narrow-to-current ()
  584. "Narrow to region of current request"
  585. (interactive)
  586. (narrow-to-region (leo/restclient-current-min) (leo/restclient-current-max)))
  587. (defun leo/restclient-toggle-body-visibility ()
  588. (interactive)
  589. ;; If we are not on the HTTP call line, don't do anything
  590. (let ((at-header (save-excursion
  591. (beginning-of-line)
  592. (looking-at leo/restclient-method-url-regexp))))
  593. (when at-header
  594. (save-excursion
  595. (end-of-line)
  596. ;; If the overlays at this point have 'invisible set, toggling
  597. ;; must make the region visible. Else it must hide the region
  598. ;; This part of code is from org-hide-block-toggle method of
  599. ;; Org mode
  600. (let ((overlays (overlays-at (point))))
  601. (if (memq t (mapcar
  602. (lambda (o)
  603. (eq (overlay-get o 'invisible) 'outline))
  604. overlays))
  605. (outline-flag-region (point) (leo/restclient-current-max) nil)
  606. (outline-flag-region (point) (leo/restclient-current-max) t)))) t)))
  607. (defun leo/restclient-toggle-body-visibility-or-indent ()
  608. (interactive)
  609. (unless (leo/restclient-toggle-body-visibility)
  610. (indent-for-tab-command)))
  611. (defconst leo/restclient-mode-keywords
  612. (list (list leo/restclient-method-url-regexp '(1 'leo/restclient-method-face) '(2 'leo/restclient-url-face))
  613. (list leo/restclient-svar-regexp '(1 'leo/restclient-variable-name-face) '(2 'leo/restclient-variable-string-face))
  614. (list leo/restclient-evar-regexp '(1 'leo/restclient-variable-name-face) '(2 'leo/restclient-variable-elisp-face t))
  615. (list leo/restclient-mvar-regexp '(1 'leo/restclient-variable-name-face) '(2 'leo/restclient-variable-multiline-face t))
  616. (list leo/restclient-use-var-regexp '(1 'leo/restclient-variable-usage-face))
  617. (list leo/restclient-file-regexp '(0 'leo/restclient-file-upload-face))
  618. (list leo/restclient-header-regexp '(1 'leo/restclient-header-name-face t) '(2 'leo/restclient-header-value-face t))
  619. (list leo/restclient-response-hook-regexp '(1 ' leo/restclient-request-hook-face t)
  620. '(2 'leo/restclient-request-hook-name-face t)
  621. '(3 'leo/restclient-request-hook-args-face t))))
  622. (defconst leo/restclient-mode-syntax-table
  623. (let ((table (make-syntax-table)))
  624. (modify-syntax-entry ?\# "<" table)
  625. (modify-syntax-entry ?\n ">#" table)
  626. table))
  627. (defvar leo/restclient-mode-map
  628. (let ((map (make-sparse-keymap)))
  629. (define-key map (kbd "C-c C-c") 'leo/restclient-http-send-current)
  630. (define-key map (kbd "C-c C-r") 'leo/restclient-http-send-current-raw)
  631. (define-key map (kbd "C-c C-v") 'leo/restclient-http-send-current-stay-in-window)
  632. (define-key map (kbd "C-c C-n") 'leo/restclient-jump-next)
  633. (define-key map (kbd "C-c C-p") 'leo/restclient-jump-prev)
  634. (define-key map (kbd "C-c C-.") 'leo/restclient-mark-current)
  635. (define-key map (kbd "C-c C-u") 'leo/restclient-copy-curl-command)
  636. (define-key map (kbd "C-c n n") 'leo/restclient-narrow-to-current)
  637. (define-key map (kbd "C-c C-i") 'leo/restclient-show-info)
  638. map)
  639. "Keymap for leo/restclient-mode.")
  640. (define-minor-mode leo/restclient-outline-mode
  641. "Minor mode to allow show/hide of request bodies by TAB."
  642. :init-value nil
  643. :lighter nil
  644. :keymap '(("\t" . leo/restclient-toggle-body-visibility-or-indent)
  645. ("\C-c\C-a" . leo/restclient-toggle-body-visibility-or-indent))
  646. :group 'leo/restclient)
  647. (define-minor-mode leo/restclient-response-mode
  648. "Minor mode to allow additional keybindings in leo/restclient response buffer."
  649. :init-value nil
  650. :lighter nil
  651. :keymap '(("q" . (lambda ()
  652. (interactive)
  653. (quit-window (get-buffer-window (current-buffer))))))
  654. :group 'leo/restclient)
  655. ;;;###autoload
  656. (define-derived-mode leo/restclient-mode fundamental-mode "REST Client"
  657. "Turn on leo/restclient mode."
  658. (set (make-local-variable 'comment-start) "# ")
  659. (set (make-local-variable 'comment-start-skip) "# *")
  660. (set (make-local-variable 'comment-column) 48)
  661. (set (make-local-variable 'font-lock-defaults) '(leo/restclient-mode-keywords))
  662. ;; We use outline-mode's method outline-flag-region to hide/show the
  663. ;; body. As a part of it, it sets 'invisibility text property to
  664. ;; 'outline. To get ellipsis, we need 'outline to be in
  665. ;; buffer-invisibility-spec
  666. (add-to-invisibility-spec '(outline . t)))
  667. (add-hook 'leo/restclient-mode-hook 'leo/restclient-outline-mode)
  668. (provide 'leo/restclient)
  669. ;; (eval-after-load 'helm
  670. ;; '(ignore-errors (require 'leo/restclient-helm)))
  671. ;; (eval-after-load 'jq-mode
  672. ;; '(ignore-errors (require 'leo/restclient-jq)))
  673. (provide 'leo/restclient)
  674. ;;; leo/restclient.el ends here