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