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