|
;;; custom/leo-restclient.el -*- lexical-binding: t; -*-
|
|
|
|
;;; leo/restclient.el --- An interactive HTTP client for Emacs
|
|
;;
|
|
;; Public domain.
|
|
|
|
;; Author: Pavel Kurnosov <pashky@gmail.com>
|
|
;; Maintainer: Pavel Kurnosov <pashky@gmail.com>
|
|
;; Created: 01 Apr 2012
|
|
;; Keywords: http
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
;; This file is public domain software. Do what you want.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; This is a tool to manually explore and test HTTP REST
|
|
;; webservices. Runs queries from a plain-text query sheet, displays
|
|
;; results as a pretty-printed XML, JSON and even images.
|
|
|
|
;;; Code:
|
|
;;
|
|
(require 'url)
|
|
(require 'json)
|
|
(require 'outline)
|
|
(eval-when-compile (require 'subr-x))
|
|
(eval-when-compile (require 'cl))
|
|
|
|
(defgroup leo/restclient nil
|
|
"An interactive HTTP client for Emacs."
|
|
:group 'tools)
|
|
|
|
(defcustom leo/restclient-log-request t
|
|
"Log leo/restclient requests to *Messages*."
|
|
:group 'leo/restclient
|
|
:type 'boolean)
|
|
|
|
(defcustom leo/restclient-same-buffer-response t
|
|
"Re-use same buffer for responses or create a new one each time."
|
|
:group 'leo/restclient
|
|
:type 'boolean)
|
|
|
|
(defcustom leo/restclient-same-buffer-response-name "*HTTP Response*"
|
|
"Name for response buffer."
|
|
:group 'leo/restclient
|
|
:type 'string)
|
|
|
|
(defcustom leo/restclient-info-buffer-name "*Leo/Restclient Info*"
|
|
"Name for info buffer."
|
|
:group 'leo/restclient
|
|
:type 'string)
|
|
|
|
(defcustom leo/restclient-inhibit-cookies nil
|
|
"Inhibit leo/restclient from sending cookies implicitly."
|
|
:group 'leo/restclient
|
|
:type 'boolean)
|
|
|
|
(defcustom leo/restclient-content-type-modes '(("text/xml" . xml-mode)
|
|
("text/plain" . text-mode)
|
|
("application/xml" . xml-mode)
|
|
("application/json" . js-mode)
|
|
("image/png" . image-mode)
|
|
("image/jpeg" . image-mode)
|
|
("image/jpg" . image-mode)
|
|
("image/gif" . image-mode)
|
|
("text/html" . html-mode))
|
|
"An association list mapping content types to buffer modes"
|
|
:group 'leo/restclient
|
|
:type '(alist :key-type string :value-type symbol))
|
|
|
|
(defgroup leo/restclient-faces nil
|
|
"Faces used in Leo/Restclient Mode"
|
|
:group 'leo/restclient
|
|
:group 'faces)
|
|
|
|
(defface leo/restclient-variable-name-face
|
|
'((t (:inherit font-lock-preprocessor-face)))
|
|
"Face for variable name."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-variable-string-face
|
|
'((t (:inherit font-lock-string-face)))
|
|
"Face for variable value (string)."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-variable-elisp-face
|
|
'((t (:inherit font-lock-function-name-face)))
|
|
"Face for variable value (Emacs lisp)."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-variable-multiline-face
|
|
'((t (:inherit font-lock-doc-face)))
|
|
"Face for multi-line variable value marker."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-variable-usage-face
|
|
'((t (:inherit leo/restclient-variable-name-face)))
|
|
"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)."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-method-face
|
|
'((t (:inherit font-lock-keyword-face)))
|
|
"Face for HTTP method."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-url-face
|
|
'((t (:inherit font-lock-function-name-face)))
|
|
"Face for variable value (Emacs lisp)."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-file-upload-face
|
|
'((t (:inherit leo/restclient-variable-multiline-face)))
|
|
"Face for highlighting upload file paths."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-header-name-face
|
|
'((t (:inherit font-lock-variable-name-face)))
|
|
"Face for HTTP header name."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-header-value-face
|
|
'((t (:inherit font-lock-string-face)))
|
|
"Face for HTTP header value."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-request-hook-face
|
|
'((t (:inherit font-lock-preprocessor-face)))
|
|
"Face for single request hook indicator."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-request-hook-name-face
|
|
'((t (:inherit font-lock-function-name-face)))
|
|
"Face for single request hook type names."
|
|
:group 'leo/restclient-faces)
|
|
|
|
(defface leo/restclient-request-hook-args-face
|
|
'((t (:inherit font-lock-string-face)))
|
|
"Face for single request hook type arguments."
|
|
:group 'leo/restclient-faces)
|
|
|
|
|
|
(defvar leo/restclient-within-call nil)
|
|
|
|
(defvar leo/restclient-request-time-start nil)
|
|
(defvar leo/restclient-request-time-end nil)
|
|
|
|
(defvar leo/restclient-var-overrides nil
|
|
"An alist of vars that will override any set in the file,
|
|
also where dynamic vars set on callbacks are stored.")
|
|
|
|
(defvar leo/restclient-result-handlers '()
|
|
"A registry of available completion hooks.
|
|
Stored as an alist of name -> (hook-creation-func . description)")
|
|
|
|
(defvar leo/restclient-curr-request-functions nil
|
|
"A list of functions to run once when the next request is loaded")
|
|
|
|
(defvar leo/restclient-response-loaded-hook nil
|
|
"Hook run after response buffer is formatted.")
|
|
|
|
(defvar leo/restclient-http-do-hook nil
|
|
"Hook to run before making request.")
|
|
|
|
(defvar leo/restclient-response-received-hook nil
|
|
"Hook run after data is loaded into response buffer.")
|
|
|
|
(defcustom leo/restclient-vars-max-passes 10
|
|
"Maximum number of recursive variable references. This is to prevent hanging if two variables reference each other directly or indirectly."
|
|
:group 'leo/restclient
|
|
:type 'integer)
|
|
|
|
(defconst leo/restclient-comment-separator "#")
|
|
(defconst leo/restclient-comment-start-regexp (concat "^" leo/restclient-comment-separator))
|
|
(defconst leo/restclient-comment-not-regexp (concat "^[^" leo/restclient-comment-separator "]"))
|
|
(defconst leo/restclient-empty-line-regexp "^\\s-*$")
|
|
|
|
(defconst leo/restclient-method-url-regexp
|
|
"^\\(GET\\|POST\\|DELETE\\|PUT\\|HEAD\\|OPTIONS\\|PATCH\\) \\(.*\\)$")
|
|
|
|
(defconst leo/restclient-header-regexp
|
|
"^\\([^](),/:;@[\\{}= \t]+\\): \\(.*\\)$")
|
|
|
|
(defconst leo/restclient-use-var-regexp
|
|
"^\\(:[^: \n]+\\)$")
|
|
|
|
(defconst leo/restclient-var-regexp
|
|
(concat "^\\(:[^:= ]+\\)[ \t]*\\(:?\\)=[ \t]*\\(<<[ \t]*\n\\(\\(.*\n\\)*?\\)" leo/restclient-comment-separator "\\|\\([^<].*\\)$\\)"))
|
|
|
|
(defconst leo/restclient-svar-regexp
|
|
"^\\(:[^:= ]+\\)[ \t]*=[ \t]*\\(.+?\\)$")
|
|
|
|
(defconst leo/restclient-evar-regexp
|
|
"^\\(:[^: ]+\\)[ \t]*:=[ \t]*\\(.+?\\)$")
|
|
|
|
(defconst leo/restclient-mvar-regexp
|
|
"^\\(:[^: ]+\\)[ \t]*:?=[ \t]*\\(<<\\)[ \t]*$")
|
|
|
|
(defconst leo/restclient-file-regexp
|
|
"^<[ \t]*\\([^<>\n\r]+\\)[ \t]*$")
|
|
|
|
(defconst leo/restclient-content-type-regexp
|
|
"^Content-[Tt]ype: \\(\\w+\\)/\\(?:[^\\+\r\n]*\\+\\)*\\([^;\r\n]+\\)")
|
|
|
|
(defconst leo/restclient-response-hook-regexp
|
|
"^\\(->\\) \\([^[:space:]]+\\) +\\(.*\\)$")
|
|
|
|
;; The following disables the interactive request for user name and
|
|
;; password should an API call encounter a permission-denied response.
|
|
;; This API is meant to be usable without constant asking for username
|
|
;; and password.
|
|
(defadvice url-http-handle-authentication (around leo/restclient-fix)
|
|
(if leo/restclient-within-call
|
|
(setq ad-return-value t)
|
|
ad-do-it))
|
|
(ad-activate 'url-http-handle-authentication)
|
|
|
|
(defadvice url-cache-extract (around leo/restclient-fix-2)
|
|
(unless leo/restclient-within-call
|
|
ad-do-it))
|
|
(ad-activate 'url-cache-extract)
|
|
|
|
(defadvice url-http-user-agent-string (around leo/restclient-fix-3)
|
|
(if leo/restclient-within-call
|
|
(setq ad-return-value nil)
|
|
ad-do-it))
|
|
(ad-activate 'url-http-user-agent-string)
|
|
|
|
(defun leo/restclient-http-do (method url headers entity &rest handle-args)
|
|
"Send ENTITY and HEADERS to URL as a METHOD request."
|
|
(if leo/restclient-log-request
|
|
(message "HTTP %s %s Headers:[%s] Body:[%s]" method url headers entity))
|
|
(let ((url-request-method (encode-coding-string method 'us-ascii))
|
|
(url-request-extra-headers '())
|
|
(url-request-data (encode-coding-string entity 'utf-8))
|
|
(url-mime-charset-string (url-mime-charset-string))
|
|
(url-mime-language-string nil)
|
|
(url-mime-encoding-string nil)
|
|
(url-mime-accept-string nil)
|
|
(url-personal-mail-address nil))
|
|
|
|
(dolist (header headers)
|
|
(let* ((mapped (assoc-string (downcase (car header))
|
|
'(("from" . url-personal-mail-address)
|
|
("accept-encoding" . url-mime-encoding-string)
|
|
("accept-charset" . url-mime-charset-string)
|
|
("accept-language" . url-mime-language-string)
|
|
("accept" . url-mime-accept-string)))))
|
|
|
|
(if mapped
|
|
(set (cdr mapped) (encode-coding-string (cdr header) 'us-ascii))
|
|
(let* ((hkey (encode-coding-string (car header) 'us-ascii))
|
|
(hvalue (encode-coding-string (cdr header) 'us-ascii)))
|
|
(setq url-request-extra-headers (cons (cons hkey hvalue) url-request-extra-headers))))))
|
|
|
|
(setq leo/restclient-within-call t)
|
|
(setq leo/restclient-request-time-start (current-time))
|
|
(run-hooks 'leo/restclient-http-do-hook)
|
|
(url-retrieve url 'leo/restclient-http-handle-response
|
|
(append (list method url (if leo/restclient-same-buffer-response
|
|
leo/restclient-same-buffer-response-name
|
|
(format "*HTTP %s %s*" method url))) handle-args) nil leo/restclient-inhibit-cookies)))
|
|
|
|
(defun leo/restclient-prettify-response (method url)
|
|
(save-excursion
|
|
(let ((start (point)) (guessed-mode) (end-of-headers))
|
|
(while (and (not (looking-at leo/restclient-empty-line-regexp))
|
|
(eq (progn
|
|
(when (looking-at leo/restclient-content-type-regexp)
|
|
(setq guessed-mode
|
|
(cdr (assoc-string (concat
|
|
(match-string-no-properties 1)
|
|
"/"
|
|
(match-string-no-properties 2))
|
|
leo/restclient-content-type-modes
|
|
t))))
|
|
(forward-line)) 0)))
|
|
(setq end-of-headers (point))
|
|
(while (and (looking-at leo/restclient-empty-line-regexp)
|
|
(eq (forward-line) 0)))
|
|
(unless guessed-mode
|
|
(setq guessed-mode
|
|
(or (assoc-default nil
|
|
;; magic mode matches
|
|
'(("<\\?xml " . xml-mode)
|
|
("{\\s-*\"" . js-mode))
|
|
(lambda (re _dummy)
|
|
(looking-at re))) 'js-mode)))
|
|
(let ((headers (buffer-substring-no-properties start end-of-headers)))
|
|
(when guessed-mode
|
|
(delete-region start (point))
|
|
(unless (eq guessed-mode 'image-mode)
|
|
(apply guessed-mode '())
|
|
(if (fboundp 'font-lock-flush)
|
|
(font-lock-flush)
|
|
(with-no-warnings
|
|
(font-lock-fontify-buffer))))
|
|
|
|
(cond
|
|
((eq guessed-mode 'xml-mode)
|
|
(goto-char (point-min))
|
|
(while (search-forward-regexp "\>[ \\t]*\<" nil t)
|
|
(backward-char) (insert "\n"))
|
|
(indent-region (point-min) (point-max)))
|
|
|
|
((eq guessed-mode 'image-mode)
|
|
(let* ((img (buffer-string)))
|
|
(delete-region (point-min) (point-max))
|
|
(fundamental-mode)
|
|
(insert-image (create-image img nil t))))
|
|
|
|
((eq guessed-mode 'js-mode)
|
|
(let ((json-special-chars (remq (assoc ?/ json-special-chars) json-special-chars))
|
|
;; Emacs 27 json.el uses `replace-buffer-contents' for
|
|
;; pretty-printing which is great because it keeps point and
|
|
;; markers intact but can be very slow with huge minimalized
|
|
;; JSON. We don't need that here.
|
|
(json-pretty-print-max-secs 0))
|
|
(ignore-errors (json-pretty-print-buffer)))
|
|
(leo/restclient-prettify-json-unicode)))
|
|
|
|
(goto-char (point-max))
|
|
(or (eq (point) (point-min)) (insert "\n"))
|
|
(let ((hstart (point)))
|
|
(insert method " " url "\n" headers)
|
|
(insert (format "Request duration: %fs\n" (float-time (time-subtract leo/restclient-request-time-end leo/restclient-request-time-start))))
|
|
(unless (member guessed-mode '(image-mode text-mode))
|
|
(comment-region hstart (point)))))))))
|
|
|
|
(defun leo/restclient-prettify-json-unicode ()
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "\\\\[Uu]\\([0-9a-fA-F]\\{4\\}\\)" nil t)
|
|
(replace-match (char-to-string (decode-char 'ucs (string-to-number (match-string 1) 16))) t nil))))
|
|
|
|
(defun leo/restclient-http-handle-response (status method url bufname raw stay-in-window)
|
|
"Switch to the buffer returned by `url-retreive'.
|
|
The buffer contains the raw HTTP response sent by the server."
|
|
(setq leo/restclient-within-call nil)
|
|
(setq leo/restclient-request-time-end (current-time))
|
|
(if (= (point-min) (point-max))
|
|
(signal (car (plist-get status :error)) (cdr (plist-get status :error)))
|
|
(when (buffer-live-p (current-buffer))
|
|
(with-current-buffer (leo/restclient-decode-response
|
|
(current-buffer)
|
|
bufname
|
|
leo/restclient-same-buffer-response)
|
|
(run-hooks 'leo/restclient-response-received-hook)
|
|
(unless raw
|
|
(leo/restclient-prettify-response method url))
|
|
(buffer-enable-undo)
|
|
(leo/restclient-response-mode)
|
|
(run-hooks 'leo/restclient-response-loaded-hook)
|
|
(if stay-in-window
|
|
(display-buffer (current-buffer) t)
|
|
(switch-to-buffer-other-window (current-buffer)))))))
|
|
|
|
(defun leo/restclient-decode-response (raw-http-response-buffer target-buffer-name same-name)
|
|
"Decode the HTTP response using the charset (encoding) specified in the Content-Type header. If no charset is specified, default to UTF-8."
|
|
(let* ((charset-regexp "^Content-Type.*charset=\\([-A-Za-z0-9]+\\)")
|
|
(image? (save-excursion
|
|
(search-forward-regexp "^Content-Type.*[Ii]mage" nil t)))
|
|
(encoding (if (save-excursion
|
|
(search-forward-regexp charset-regexp nil t))
|
|
(intern (downcase (match-string 1)))
|
|
'utf-8)))
|
|
(if image?
|
|
;; Dont' attempt to decode. Instead, just switch to the raw HTTP response buffer and
|
|
;; rename it to target-buffer-name.
|
|
(with-current-buffer raw-http-response-buffer
|
|
;; We have to kill the target buffer if it exists, or `rename-buffer'
|
|
;; will raise an error.
|
|
(when (get-buffer target-buffer-name)
|
|
(kill-buffer target-buffer-name))
|
|
(rename-buffer target-buffer-name)
|
|
raw-http-response-buffer)
|
|
;; Else, switch to the new, empty buffer that will contain the decoded HTTP
|
|
;; response. Set its encoding, copy the content from the unencoded
|
|
;; HTTP response buffer and decode.
|
|
(let ((decoded-http-response-buffer
|
|
(get-buffer-create
|
|
(if same-name target-buffer-name (generate-new-buffer-name target-buffer-name)))))
|
|
(with-current-buffer decoded-http-response-buffer
|
|
(setq buffer-file-coding-system encoding)
|
|
(save-excursion
|
|
(erase-buffer)
|
|
(insert-buffer-substring raw-http-response-buffer))
|
|
(kill-buffer raw-http-response-buffer)
|
|
(condition-case nil
|
|
(decode-coding-region (point-min) (point-max) encoding)
|
|
(error
|
|
(message (concat "Error when trying to decode http response with encoding: "
|
|
(symbol-name encoding)))))
|
|
decoded-http-response-buffer)))))
|
|
|
|
(defun leo/restclient-current-min ()
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(if (looking-at leo/restclient-comment-start-regexp)
|
|
(if (re-search-forward leo/restclient-comment-not-regexp (point-max) t)
|
|
(point-at-bol) (point-max))
|
|
(if (re-search-backward leo/restclient-comment-start-regexp (point-min) t)
|
|
(point-at-bol 2)
|
|
(point-min)))))
|
|
|
|
(defun leo/restclient-current-max ()
|
|
(save-excursion
|
|
(if (re-search-forward leo/restclient-comment-start-regexp (point-max) t)
|
|
(max (- (point-at-bol) 1) 1)
|
|
(progn (goto-char (point-max))
|
|
(if (looking-at "^$") (- (point) 1) (point))))))
|
|
|
|
(defun leo/restclient-replace-all-in-string (replacements string)
|
|
(if replacements
|
|
(let ((current string)
|
|
(pass leo/restclient-vars-max-passes)
|
|
(continue t))
|
|
(while (and continue (> pass 0))
|
|
(setq pass (- pass 1))
|
|
(setq current (replace-regexp-in-string (regexp-opt (mapcar 'car replacements))
|
|
(lambda (key)
|
|
(setq continue t)
|
|
(cdr (assoc key replacements)))
|
|
current t t)))
|
|
current)
|
|
string))
|
|
|
|
(defun leo/restclient-replace-all-in-header (replacements header)
|
|
(cons (car header)
|
|
(leo/restclient-replace-all-in-string replacements (cdr header))))
|
|
|
|
(defun leo/restclient-chop (text)
|
|
(if text (replace-regexp-in-string "\n$" "" text) nil))
|
|
|
|
(defun leo/restclient-find-vars-before-point ()
|
|
(let ((vars nil)
|
|
(bound (point)))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (search-forward-regexp leo/restclient-var-regexp bound t)
|
|
(let ((name (match-string-no-properties 1))
|
|
(should-eval (> (length (match-string 2)) 0))
|
|
(value (or (leo/restclient-chop (match-string-no-properties 4)) (match-string-no-properties 3))))
|
|
(setq vars (cons (cons name (if should-eval (leo/restclient-eval-var value) value)) vars))))
|
|
(append leo/restclient-var-overrides vars))))
|
|
|
|
(defun leo/restclient-eval-var (string)
|
|
(with-output-to-string (princ (eval (read string)))))
|
|
|
|
(defun leo/restclient-make-header (&optional string)
|
|
(cons (match-string-no-properties 1 string)
|
|
(match-string-no-properties 2 string)))
|
|
|
|
(defun leo/restclient-parse-headers (string)
|
|
(let ((start 0)
|
|
(headers '()))
|
|
(while (string-match leo/restclient-header-regexp string start)
|
|
(setq headers (cons (leo/restclient-make-header string) headers)
|
|
start (match-end 0)))
|
|
headers))
|
|
|
|
(defun leo/restclient-read-file (path)
|
|
(with-temp-buffer
|
|
(insert-file-contents path)
|
|
(buffer-string)))
|
|
|
|
(defun leo/restclient-parse-body (entity vars)
|
|
(if (= 0 (or (string-match leo/restclient-file-regexp entity) 1))
|
|
(leo/restclient-read-file (match-string 1 entity))
|
|
(leo/restclient-replace-all-in-string vars entity)))
|
|
|
|
(defun leo/restclient-parse-hook (cb-type args-offset args)
|
|
(if-let ((handler (assoc cb-type leo/restclient-result-handlers)))
|
|
(funcall (cadr handler) args args-offset)
|
|
`(lambda ()
|
|
(message "Unknown leo/restclient hook type %s" ,cb-type))))
|
|
|
|
(defun leo/restclient-register-result-func (name creation-func description)
|
|
(let ((new-cell (cons name (cons creation-func description))))
|
|
(setq leo/restclient-result-handlers (cons new-cell leo/restclient-result-handlers))))
|
|
|
|
(defun leo/restclient-remove-var (var-name)
|
|
(setq leo/restclient-var-overrides (assoc-delete-all var-name leo/restclient-var-overrides)))
|
|
|
|
(defun leo/restclient-set-var (var-name value)
|
|
(leo/restclient-remove-var var-name)
|
|
(setq leo/restclient-var-overrides (cons (cons var-name value) leo/restclient-var-overrides)))
|
|
|
|
(defun leo/restclient-get-var-at-point (var-name buffer-name buffer-pos)
|
|
(message (format "getting var %s form %s at %s" var-name buffer-name buffer-pos))
|
|
(let* ((vars-at-point (save-excursion
|
|
(switch-to-buffer buffer-name)
|
|
(goto-char buffer-pos)
|
|
;; if we're called from a leo/restclient buffer we need to lookup vars before the current hook or evar
|
|
;; outside a leo/restclient buffer only globals are available so moving the point wont matter
|
|
(re-search-backward "^:\\|->" (point-min) t)
|
|
(leo/restclient-find-vars-before-point))))
|
|
(leo/restclient-replace-all-in-string vars-at-point (cdr (assoc var-name vars-at-point)))))
|
|
|
|
(defmacro leo/restclient-get-var (var-name)
|
|
(lexical-let ((buf-name (buffer-name (current-buffer)))
|
|
(buf-point (point)))
|
|
`(leo/restclient-get-var-at-point ,var-name ,buf-name ,buf-point)))
|
|
|
|
(defun leo/restclient-single-request-function ()
|
|
(dolist (f leo/restclient-curr-request-functions)
|
|
(ignore-errors
|
|
(funcall f)))
|
|
(setq leo/restclient-curr-request-functions nil)
|
|
(remove-hook 'leo/restclient-response-loaded-hook 'leo/restclient-single-request-function))
|
|
|
|
|
|
(defun leo/restclient-http-parse-current-and-do (func &rest args)
|
|
(save-excursion
|
|
(goto-char (leo/restclient-current-min))
|
|
(when (re-search-forward leo/restclient-method-url-regexp (point-max) t)
|
|
(let ((method (match-string-no-properties 1))
|
|
(url (match-string-no-properties 2))
|
|
(vars (leo/restclient-find-vars-before-point))
|
|
(headers '()))
|
|
(forward-line)
|
|
(while (cond
|
|
((looking-at leo/restclient-response-hook-regexp)
|
|
(when-let (hook-function (leo/restclient-parse-hook (match-string-no-properties 2)
|
|
(match-end 2)
|
|
(match-string-no-properties 3)))
|
|
(push hook-function leo/restclient-curr-request-functions)))
|
|
((and (looking-at leo/restclient-header-regexp) (not (looking-at leo/restclient-empty-line-regexp)))
|
|
(setq headers (cons (leo/restclient-replace-all-in-header vars (leo/restclient-make-header)) headers)))
|
|
((looking-at leo/restclient-use-var-regexp)
|
|
(setq headers (append headers (leo/restclient-parse-headers (leo/restclient-replace-all-in-string vars (match-string 1)))))))
|
|
(forward-line))
|
|
(when (looking-at leo/restclient-empty-line-regexp)
|
|
(forward-line))
|
|
(when leo/restclient-curr-request-functions
|
|
(add-hook 'leo/restclient-response-loaded-hook 'leo/restclient-single-request-function))
|
|
(let* ((cmax (leo/restclient-current-max))
|
|
(entity (leo/restclient-parse-body (buffer-substring (min (point) cmax) cmax) vars))
|
|
(url (leo/restclient-replace-all-in-string vars url)))
|
|
(apply func method url headers entity args))))))
|
|
|
|
(defun leo/restclient-copy-curl-command ()
|
|
"Formats the request as a curl command and copies the command to the clipboard."
|
|
(interactive)
|
|
(leo/restclient-http-parse-current-and-do
|
|
'(lambda (method url headers entity)
|
|
(let ((header-args
|
|
(apply 'append
|
|
(mapcar (lambda (header)
|
|
(list "-H" (format "%s: %s" (car header) (cdr header))))
|
|
headers))))
|
|
(kill-new (concat "curl "
|
|
(mapconcat 'shell-quote-argument
|
|
(append '("-i")
|
|
header-args
|
|
(list (concat "-X" method))
|
|
(list url)
|
|
(when (> (string-width entity) 0)
|
|
(list "-d" entity)))
|
|
" "))))
|
|
(message "curl command copied to clipboard."))))
|
|
|
|
|
|
(defun leo/restclient-elisp-result-function (args offset)
|
|
(goto-char offset)
|
|
(lexical-let ((form (macroexpand-all (read (current-buffer)))))
|
|
(lambda ()
|
|
(eval form))))
|
|
|
|
(leo/restclient-register-result-func
|
|
"run-hook" #'leo/restclient-elisp-result-function
|
|
"Call the provided (possibly multi-line) elisp when the result
|
|
buffer is formatted. Equivalent to a leo/restclient-response-loaded-hook
|
|
that only runs for this request.
|
|
eg. -> on-response (message \"my hook called\")" )
|
|
|
|
;;;###autoload
|
|
(defun leo/restclient-http-send-current (&optional raw stay-in-window)
|
|
"Sends current request.
|
|
Optional argument RAW don't reformat response if t.
|
|
Optional argument STAY-IN-WINDOW do not move focus to response buffer if t."
|
|
(interactive)
|
|
(leo/restclient-http-parse-current-and-do 'leo/restclient-http-do raw stay-in-window))
|
|
|
|
;;;###autoload
|
|
(defun leo/restclient-http-send-current-raw ()
|
|
"Sends current request and get raw result (no reformatting or syntax highlight of XML, JSON or images)."
|
|
(interactive)
|
|
(leo/restclient-http-send-current t))
|
|
|
|
;;;###autoload
|
|
(defun leo/restclient-http-send-current-stay-in-window ()
|
|
"Send current request and keep focus in request window."
|
|
(interactive)
|
|
(leo/restclient-http-send-current nil t))
|
|
|
|
(defun leo/restclient-jump-next ()
|
|
"Jump to next request in buffer."
|
|
(interactive)
|
|
(let ((last-min nil))
|
|
(while (not (eq last-min (goto-char (leo/restclient-current-min))))
|
|
(goto-char (leo/restclient-current-min))
|
|
(setq last-min (point))))
|
|
(goto-char (+ (leo/restclient-current-max) 1))
|
|
(goto-char (leo/restclient-current-min)))
|
|
|
|
(defun leo/restclient-jump-prev ()
|
|
"Jump to previous request in buffer."
|
|
(interactive)
|
|
(let* ((current-min (leo/restclient-current-min))
|
|
(end-of-entity
|
|
(save-excursion
|
|
(progn (goto-char (leo/restclient-current-min))
|
|
(while (and (or (looking-at "^\s*\\(#.*\\)?$")
|
|
(eq (point) current-min))
|
|
(not (eq (point) (point-min))))
|
|
(forward-line -1)
|
|
(beginning-of-line))
|
|
(point)))))
|
|
(unless (eq (point-min) end-of-entity)
|
|
(goto-char end-of-entity)
|
|
(goto-char (leo/restclient-current-min)))))
|
|
|
|
(defun leo/restclient-mark-current ()
|
|
"Mark current request."
|
|
(interactive)
|
|
(goto-char (leo/restclient-current-min))
|
|
(set-mark-command nil)
|
|
(goto-char (leo/restclient-current-max))
|
|
(backward-char 1)
|
|
(setq deactivate-mark nil))
|
|
|
|
(defun leo/restclient-show-info ()
|
|
;; leo/restclient-info-buffer-name
|
|
(interactive)
|
|
(let ((vars-at-point (leo/restclient-find-vars-before-point)))
|
|
(cl-labels ((non-overidden-vars-at-point ()
|
|
(seq-filter (lambda (v)
|
|
(null (assoc (car v) leo/restclient-var-overrides)))
|
|
vars-at-point))
|
|
(sanitize-value-cell (var-value)
|
|
(replace-regexp-in-string "\n" "|\n| |"
|
|
(replace-regexp-in-string "\|" "\\\\vert{}"
|
|
(leo/restclient-replace-all-in-string vars-at-point var-value))))
|
|
(var-row (var-name var-value)
|
|
(insert "|" var-name "|" (sanitize-value-cell var-value) "|\n"))
|
|
(var-table (table-name)
|
|
(insert (format "* %s \n|--|\n|Name|Value|\n|---|\n" table-name)))
|
|
(var-table-footer ()
|
|
(insert "|--|\n\n")))
|
|
|
|
(with-current-buffer (get-buffer-create leo/restclient-info-buffer-name)
|
|
;; insert our info
|
|
(erase-buffer)
|
|
|
|
(insert "\Leo/Restclient Info\ \n\n")
|
|
|
|
(var-table "Dynamic Variables")
|
|
(dolist (dv leo/restclient-var-overrides)
|
|
(var-row (car dv) (cdr dv)))
|
|
(var-table-footer)
|
|
|
|
;; (insert ":Info:\n Dynamic vars defined by request hooks or with calls to leo/restclient-set-var\n:END:")
|
|
|
|
(var-table "Vars at current position")
|
|
(dolist (dv (non-overidden-vars-at-point))
|
|
(var-row (car dv) (cdr dv)))
|
|
(var-table-footer)
|
|
|
|
|
|
;; registered callbacks
|
|
(var-table "Registered request hook types")
|
|
(dolist (handler-name (delete-dups (mapcar 'car leo/restclient-result-handlers)))
|
|
(var-row handler-name (cddr (assoc handler-name leo/restclient-result-handlers))))
|
|
(var-table-footer)
|
|
|
|
(insert "\n\n'q' to exit\n")
|
|
(org-mode)
|
|
(org-toggle-pretty-entities)
|
|
(org-table-iterate-buffer-tables)
|
|
(outline-show-all)
|
|
(leo/restclient-response-mode)
|
|
(goto-char (point-min))))
|
|
(switch-to-buffer-other-window leo/restclient-info-buffer-name)))
|
|
|
|
(defun leo/restclient-narrow-to-current ()
|
|
"Narrow to region of current request"
|
|
(interactive)
|
|
(narrow-to-region (leo/restclient-current-min) (leo/restclient-current-max)))
|
|
|
|
(defun leo/restclient-toggle-body-visibility ()
|
|
(interactive)
|
|
;; If we are not on the HTTP call line, don't do anything
|
|
(let ((at-header (save-excursion
|
|
(beginning-of-line)
|
|
(looking-at leo/restclient-method-url-regexp))))
|
|
(when at-header
|
|
(save-excursion
|
|
(end-of-line)
|
|
;; If the overlays at this point have 'invisible set, toggling
|
|
;; must make the region visible. Else it must hide the region
|
|
|
|
;; This part of code is from org-hide-block-toggle method of
|
|
;; Org mode
|
|
(let ((overlays (overlays-at (point))))
|
|
(if (memq t (mapcar
|
|
(lambda (o)
|
|
(eq (overlay-get o 'invisible) 'outline))
|
|
overlays))
|
|
(outline-flag-region (point) (leo/restclient-current-max) nil)
|
|
(outline-flag-region (point) (leo/restclient-current-max) t)))) t)))
|
|
|
|
(defun leo/restclient-toggle-body-visibility-or-indent ()
|
|
(interactive)
|
|
(unless (leo/restclient-toggle-body-visibility)
|
|
(indent-for-tab-command)))
|
|
|
|
(defconst leo/restclient-mode-keywords
|
|
(list (list leo/restclient-method-url-regexp '(1 'leo/restclient-method-face) '(2 'leo/restclient-url-face))
|
|
(list leo/restclient-svar-regexp '(1 'leo/restclient-variable-name-face) '(2 'leo/restclient-variable-string-face))
|
|
(list leo/restclient-evar-regexp '(1 'leo/restclient-variable-name-face) '(2 'leo/restclient-variable-elisp-face t))
|
|
(list leo/restclient-mvar-regexp '(1 'leo/restclient-variable-name-face) '(2 'leo/restclient-variable-multiline-face t))
|
|
(list leo/restclient-use-var-regexp '(1 'leo/restclient-variable-usage-face))
|
|
(list leo/restclient-file-regexp '(0 'leo/restclient-file-upload-face))
|
|
(list leo/restclient-header-regexp '(1 'leo/restclient-header-name-face t) '(2 'leo/restclient-header-value-face t))
|
|
(list leo/restclient-response-hook-regexp '(1 ' leo/restclient-request-hook-face t)
|
|
'(2 'leo/restclient-request-hook-name-face t)
|
|
'(3 'leo/restclient-request-hook-args-face t))))
|
|
|
|
(defconst leo/restclient-mode-syntax-table
|
|
(let ((table (make-syntax-table)))
|
|
(modify-syntax-entry ?\# "<" table)
|
|
(modify-syntax-entry ?\n ">#" table)
|
|
table))
|
|
|
|
(defvar leo/restclient-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "C-c C-c") 'leo/restclient-http-send-current)
|
|
(define-key map (kbd "C-c C-r") 'leo/restclient-http-send-current-raw)
|
|
(define-key map (kbd "C-c C-v") 'leo/restclient-http-send-current-stay-in-window)
|
|
(define-key map (kbd "C-c C-n") 'leo/restclient-jump-next)
|
|
(define-key map (kbd "C-c C-p") 'leo/restclient-jump-prev)
|
|
(define-key map (kbd "C-c C-.") 'leo/restclient-mark-current)
|
|
(define-key map (kbd "C-c C-u") 'leo/restclient-copy-curl-command)
|
|
(define-key map (kbd "C-c n n") 'leo/restclient-narrow-to-current)
|
|
(define-key map (kbd "C-c C-i") 'leo/restclient-show-info)
|
|
map)
|
|
"Keymap for leo/restclient-mode.")
|
|
|
|
(define-minor-mode leo/restclient-outline-mode
|
|
"Minor mode to allow show/hide of request bodies by TAB."
|
|
:init-value nil
|
|
:lighter nil
|
|
:keymap '(("\t" . leo/restclient-toggle-body-visibility-or-indent)
|
|
("\C-c\C-a" . leo/restclient-toggle-body-visibility-or-indent))
|
|
:group 'leo/restclient)
|
|
|
|
(define-minor-mode leo/restclient-response-mode
|
|
"Minor mode to allow additional keybindings in leo/restclient response buffer."
|
|
:init-value nil
|
|
:lighter nil
|
|
:keymap '(("q" . (lambda ()
|
|
(interactive)
|
|
(quit-window (get-buffer-window (current-buffer))))))
|
|
:group 'leo/restclient)
|
|
|
|
;;;###autoload
|
|
(define-derived-mode leo/restclient-mode fundamental-mode "REST Client"
|
|
"Turn on leo/restclient mode."
|
|
(set (make-local-variable 'comment-start) "# ")
|
|
(set (make-local-variable 'comment-start-skip) "# *")
|
|
(set (make-local-variable 'comment-column) 48)
|
|
|
|
(set (make-local-variable 'font-lock-defaults) '(leo/restclient-mode-keywords))
|
|
;; We use outline-mode's method outline-flag-region to hide/show the
|
|
;; body. As a part of it, it sets 'invisibility text property to
|
|
;; 'outline. To get ellipsis, we need 'outline to be in
|
|
;; buffer-invisibility-spec
|
|
(add-to-invisibility-spec '(outline . t)))
|
|
|
|
(add-hook 'leo/restclient-mode-hook 'leo/restclient-outline-mode)
|
|
|
|
(provide 'leo/restclient)
|
|
|
|
;; (eval-after-load 'helm
|
|
;; '(ignore-errors (require 'leo/restclient-helm)))
|
|
|
|
;; (eval-after-load 'jq-mode
|
|
;; '(ignore-errors (require 'leo/restclient-jq)))
|
|
|
|
(provide 'leo/restclient)
|
|
;;; leo/restclient.el ends here
|