Levi Olson
3 years ago
No known key found for this signature in database
GPG Key ID: 50264B9D44B55DC5
1 changed files with 0 additions and 791 deletions
Split View
Diff Options
-
+0 -791custom/leo-restclient.el
+ 0
- 791
custom/leo-restclient.el
View File
| @ -1,791 +0,0 @@ | |||
| ;;; 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 | |||