dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

commit 6fd37faeb4f0ada92bb3d39d26988ca60cf6e019
parent 2cf53465b0deabf5b1db70ba57af31165a2f0fbd
Author: Lukas Henkel <lh@entf.net>
Date:   Wed,  6 Apr 2022 20:46:55 +0200

Replace ob-http with restclient

ob-http is a bit buggy and restclient seems more active too

Diffstat:
Delpa/ob-http-20180707.1448/ob-http-autoloads.el | 33---------------------------------
Delpa/ob-http-20180707.1448/ob-http-mode.el | 66------------------------------------------------------------------
Delpa/ob-http-20180707.1448/ob-http-pkg.el | 11-----------
Delpa/ob-http-20180707.1448/ob-http.el | 287-------------------------------------------------------------------------------
Aelpa/ob-restclient-20220202.1609/ob-restclient-autoloads.el | 28++++++++++++++++++++++++++++
Aelpa/ob-restclient-20220202.1609/ob-restclient-pkg.el | 2++
Aelpa/ob-restclient-20220202.1609/ob-restclient.el | 146+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aelpa/restclient-20220101.1239/restclient-autoloads.el | 40++++++++++++++++++++++++++++++++++++++++
Aelpa/restclient-20220101.1239/restclient-pkg.el | 2++
Aelpa/restclient-20220101.1239/restclient.el | 799+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Minit.el | 7+++++--
Alisp/restclient-capf.el | 104+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
12 files changed, 1126 insertions(+), 399 deletions(-)

diff --git a/elpa/ob-http-20180707.1448/ob-http-autoloads.el b/elpa/ob-http-20180707.1448/ob-http-autoloads.el @@ -1,33 +0,0 @@ -;;; ob-http-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "ob-http" "ob-http.el" (0 0 0 0)) -;;; Generated autoloads from ob-http.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-http" '("ob-http" "org-babel-"))) - -;;;*** - -;;;### (autoloads nil "ob-http-mode" "ob-http-mode.el" (0 0 0 0)) -;;; Generated autoloads from ob-http-mode.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-http-mode" '("ob-http-mode"))) - -;;;*** - -;;;### (autoloads nil nil ("ob-http-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; ob-http-autoloads.el ends here diff --git a/elpa/ob-http-20180707.1448/ob-http-mode.el b/elpa/ob-http-20180707.1448/ob-http-mode.el @@ -1,66 +0,0 @@ -;;; ob-http-mode.el --- syntax highlight for ob-http - -;; Copyright (C) 2015 Feng Zhou - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -(require 's) - -(setq ob-http-mode-keywords - (let* ((ob-http-methods - '(GET POST PUT PATCH DELETE OPTIONS HEAD TRACE CONNECT)) - (ob-http-headers - '(Accept Accept-Charset Accept-Encoding Accept-Language - Accept-Datetime Authorization Cache-Control - Connection Cookie Content-Length Content-MD5 - Content-Type Date Expect From Host If-Match - If-Modified-Since If-None-Match If-Range - If-Unmodified-Since Max-Forwards Origin Pragma - Proxy-Authorization Range Referer TE User-Agent - Upgrade Via Warning)) - (ob-http-methods-regexp - (rx-to-string - `(seq - bol - (? (1+ space)) - (group-n 1 (or ,@(mapcar 'symbol-name ob-http-methods))) - space - (group-n 2 (1+ any)) - eol))) - (ob-http-headers-regexp - (rx-to-string - `(seq - bol - (? (1+ space)) - (group-n 1 (or ,@(mapcar 'symbol-name ob-http-headers))) - ": " - (group-n 2 (1+ any)) - eol))) - (ob-http-custom-headers-regexp - "\\(^X-[^ :]+\\): \\(.*\\)$") - (ob-http-variable-regexp - "\\([^ ?&=\n]+\\)=\\([^&\n]*\\)") - (ob-http-misc-regexp - "\\(&\\|=\\|?\\|{\\|}\\|\\[\\|\\]\\|\\,\\|:\\)")) - `((,ob-http-headers-regexp (1 font-lock-variable-name-face) (2 font-lock-string-face)) - (,ob-http-custom-headers-regexp (1 font-lock-variable-name-face) (2 font-lock-string-face)) - (,ob-http-variable-regexp (1 font-lock-variable-name-face) (2 font-lock-string-face)) - (,ob-http-methods-regexp (1 font-lock-constant-face) (2 font-lock-function-name-face)) - (,ob-http-misc-regexp (1 font-lock-comment-face))))) - -(define-derived-mode ob-http-mode fundamental-mode "ob http" - (set (make-local-variable 'font-lock-defaults) '(ob-http-mode-keywords))) - -(provide 'ob-http-mode) -;;; ob-http-mode.el ends here diff --git a/elpa/ob-http-20180707.1448/ob-http-pkg.el b/elpa/ob-http-20180707.1448/ob-http-pkg.el @@ -1,11 +0,0 @@ -(define-package "ob-http" "20180707.1448" "http request in org-mode babel" - '((s "1.9.0") - (cl-lib "0.5")) - :commit "b1428ea2a63bcb510e7382a1bf5fe82b19c104a7" :authors - '(("ZHOU Feng" . "zf.pascal@gmail.com")) - :maintainer - '("ZHOU Feng" . "zf.pascal@gmail.com") - :url "http://github.com/zweifisch/ob-http") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/ob-http-20180707.1448/ob-http.el b/elpa/ob-http-20180707.1448/ob-http.el @@ -1,287 +0,0 @@ -;;; ob-http.el --- http request in org-mode babel - -;; Copyright (C) 2015 Feng Zhou - -;; Author: ZHOU Feng <zf.pascal@gmail.com> -;; URL: http://github.com/zweifisch/ob-http -;; Version: 0.0.1 -;; Package-Requires: ((s "1.9.0") (cl-lib "0.5")) - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; http request in org-mode babel -;; - -;;; Code: -(require 'ob) -(require 's) -(require 'subr-x) -(require 'json) -(require 'ob-http-mode) -(require 'cl-lib) - -(defconst org-babel-header-args:http - '((pretty . :any) - (proxy . :any) - (noproxy . :any) - (curl . :any) - (cookie . :any) - (schema . :any) - (host . :any) - (port . :any) - (user . :any) - (username . :any) ;; deprecated, use user instead - (password . :any) ;; deprecated - (follow-redirect . :any) - (path-prefix . :any) - (resolve . :any) - (max-time . :any)) - "http header arguments") - -(defgroup ob-http nil - "org-mode blocks for http request" - :group 'org) - -(defcustom ob-http:max-time 10 - "maximum time in seconds that you allow the whole operation to take" - :group 'ob-http - :type 'integer) - -(defcustom ob-http:remove-cr nil - "remove carriage return from header" - :group 'ob-http - :type 'boolean) - -(defcustom ob-http:curl-custom-arguments nil - "List of custom headers that shall be added to each curl request" - :group 'ob-http - :type '(repeat (string :format "%v"))) - -(cl-defstruct ob-http-request method url headers body) -(cl-defstruct ob-http-response headers body headers-map) - -(defun ob-http-parse-request (input) - (let* ((headers-body (ob-http-split-header-body input)) - (headers (s-split-up-to "\\(\r\n\\|[\n\r]\\)" (car headers-body) 1)) - (method-url (split-string (car headers) " "))) - (make-ob-http-request - :method (car method-url) - :url (cadr method-url) - :headers (if (cadr headers) (s-lines (cadr headers))) - :body (cadr headers-body)))) - -(defun ob-http-parse-response (response) - (let* ((headers-body (ob-http-split-header-body response)) - (headers-map (mapcar 'ob-http-parse-header (s-lines (car headers-body))))) - (make-ob-http-response - :headers (car headers-body) - :body (cadr headers-body) - :headers-map headers-map))) - -(defun ob-http-split-header-body (input) - (let ((splited (s-split-up-to "\\(\r\n\\|[\n\r]\\)[ \t]*\\1" input 1))) - (if (and (string-match "^HTTP/\\(1.[0-1]\\|2\\) \\(30\\|100\\)" (car splited)) - (string-match "^HTTP/\\(1.[0-1]\\|2\\)" (cadr splited))) - (ob-http-split-header-body (cadr splited)) - splited))) - -(defun ob-http-parse-header (line) - (let ((key-value (s-split-up-to ": " line 1))) - `(,(s-downcase (car key-value)) . ,(cadr key-value)))) - -(defun ob-http-parse-content-type (content-type) - (when content-type - (cond - ((string-match "json" content-type) 'json) - ((string-match "html" content-type) 'html) - ((string-match "xml" content-type) 'xml)))) - -(defun ob-http-shell-command-to-string (command input) - (with-temp-buffer - (insert input) - (shell-command-on-region (point-min) (point-max) command nil 't) - (buffer-string))) - -(defun ob-http-pretty-json (str) - (if (executable-find "jq") - (ob-http-shell-command-to-string "jq -r ." str) - (with-temp-buffer - (insert str) - (json-pretty-print-buffer) - (buffer-string)))) - -(defun ob-http-pretty-xml (str) - (cond - ((executable-find "xml_pp") (ob-http-shell-command-to-string "xml_pp" str)) - ((executable-find "xmlstarlet") (ob-http-shell-command-to-string "xmlstarlet fo" str)) - (t str))) - -(defun ob-http-pretty-html (str) - (cond - ((executable-find "elinks") (ob-http-shell-command-to-string "elinks -dump" str)) - ((executable-find "tidy") (ob-http-shell-command-to-string "tidy -i -raw -q 2> /dev/null" str)) - ((executable-find "pup") (ob-http-shell-command-to-string "pup -p" str)) - (t str))) - -(defun ob-http-pretty (body content-type) - (if (string= "" body) - body - (cl-case (ob-http-parse-content-type content-type) - (json (ob-http-pretty-json body)) - (xml (ob-http-pretty-xml body)) - (html (ob-http-pretty-html body)) - (otherwise body)))) - -(defun ob-http-pretty-response (response content-type) - (setf (ob-http-response-body response) - (ob-http-pretty (ob-http-response-body response) - (if (member content-type '("yes" nil)) - (ob-http-get-response-header response "content-type") - content-type)))) - -(defun ob-http-select (response path) - (let ((content-type (ob-http-parse-content-type - (ob-http-get-response-header response "content-type"))) - (body (ob-http-response-body response))) - (cond - ((and (eq 'json content-type) (executable-find "jq")) - (ob-http-shell-command-to-string (format "jq -r \"%s\"" path) body)) - ((and (eq 'html content-type) (executable-find "pup")) - (ob-http-shell-command-to-string (format "pup -p \"%s\"" path) body)) - ((and (eq 'xml content-type) (executable-find "xmlstarlet")) - (ob-http-shell-command-to-string (format "xmlstarlet sel -t -c '%s' | xmlstarlet fo -o" path) body)) - (t body)))) - -(defun org-babel-expand-body:http (body params) - (s-format body 'ob-http-aget - (mapcar (lambda (x) (when (eq (car x) :var) (cdr x))) params))) - -(defun ob-http-get-response-header (response header) - (cdr (assoc (s-downcase header) (ob-http-response-headers-map response)))) - -(defun ob-http-remove-carriage-return (response) - (setf (ob-http-response-headers response) - (s-join "\n" (s-lines (ob-http-response-headers response)))) - response) - -(defun ob-http-flatten (l) - (cond - ((null l) nil) - ((atom l) (list l)) - (t - (append (ob-http-flatten (car l)) (ob-http-flatten (cdr l)))))) - -(defun ob-http-aget (key alist) - (assoc-default (intern key) alist)) - -(defun ob-http-construct-url (path params) - (if (s-starts-with? "/" path) - (s-concat - (format "%s://" (or (assoc-default :schema params) "http")) - (assoc-default :host params) - (when (assoc :port params) - (format ":%s" (assoc-default :port params))) - (assoc-default :path-prefix params) - path) - path)) - -(defun ob-http-file (response filename) - (let ((body (ob-http-response-body response))) - (with-temp-file filename - (insert body)))) - -(defun org-babel-execute:http (body params) - (let* ((request (ob-http-parse-request (org-babel-expand-body:http body params))) - (proxy (cdr (assoc :proxy params))) - (noproxy (assoc :noproxy params)) - (follow-redirect (and (assoc :follow-redirect params) (not (string= "no" (cdr (assoc :follow-redirect params)))))) - (pretty (assoc :pretty params)) - (prettify (and pretty (not (string= (cdr pretty) "no")))) - (file (assoc :file params)) - (get-header (cdr (assoc :get-header params))) - (cookie-jar (cdr (assoc :cookie-jar params))) - (cookie (cdr (assoc :cookie params))) - (curl (cdr (assoc :curl params))) - (select (cdr (assoc :select params))) - (resolve (cdr (assoc :resolve params))) - (request-body (ob-http-request-body request)) - (error-output (org-babel-temp-file "curl-error")) - (args (append ob-http:curl-custom-arguments (list "-i" - (when (and proxy (not noproxy)) `("-x" ,proxy)) - (when noproxy '("--noproxy" "*")) - (let ((method (ob-http-request-method request))) - (if (string= "HEAD" method) "-I" `("-X" ,method))) - (when follow-redirect "-L") - (when (and (assoc :username params) (assoc :password params)) - `("--user" ,(s-format "${:username}:${:password}" 'ob-http-aget params))) - (when (assoc :user params) `("--user" ,(cdr (assoc :user params)))) - (mapcar (lambda (x) `("-H" ,x)) (ob-http-request-headers request)) - (when (s-present? request-body) - (let ((tmp (org-babel-temp-file "http-"))) - (with-temp-file tmp (insert request-body)) - `("-d" ,(format "@%s" tmp)))) - (when cookie-jar `("--cookie-jar" ,cookie-jar)) - (when cookie `("--cookie" ,cookie)) - (when resolve (mapcar (lambda (x) `("--resolve" ,x)) (split-string resolve ","))) - (when curl (split-string-and-unquote curl)) - "--max-time" - (int-to-string (or (cdr (assoc :max-time params)) - ob-http:max-time)) - "--globoff" - (ob-http-construct-url (ob-http-request-url request) params))))) - (with-current-buffer (get-buffer-create "*curl commands history*") - (goto-char (point-max)) - (insert "curl " - (string-join (mapcar 'shell-quote-argument (ob-http-flatten args)) " ") - "\n")) - (with-current-buffer (get-buffer-create "*curl output*") - (erase-buffer) - (if (= 0 (apply 'call-process "curl" nil `(t ,error-output) nil (ob-http-flatten args))) - (let ((response (ob-http-parse-response (buffer-string)))) - (when prettify (ob-http-pretty-response response (cdr pretty))) - (when ob-http:remove-cr (ob-http-remove-carriage-return response)) - (cond (get-header (ob-http-get-response-header response get-header)) - (select (ob-http-select response select)) - (prettify (ob-http-response-body response)) - (file (ob-http-file response (cdr file))) - (t (s-join "\n\n" (list (ob-http-response-headers response) (ob-http-response-body response)))))) - (with-output-to-temp-buffer "*curl error*" - (princ (with-temp-buffer - (insert-file-contents-literally error-output) - (s-join "\n" (s-lines (buffer-string))))) - ""))))) - -(defun ob-http-export-expand-variables (&optional backend) - "Scan current buffer for all HTTP source code blocks and expand variables. - -Add this function to `org-export-before-processing-hook' to -enable variable expansion before source block is exported." - (let ((case-fold-search t) elt replacement) - (save-excursion - (goto-char (point-min)) - (while (search-forward-regexp "^[ \t]*#\\+begin_src[ \t]+http" nil 'noerror) - (setq elt (org-element-at-point)) - (when (eq 'src-block (car elt)) - (setq replacement (org-babel-expand-src-block)) - (goto-char (org-element-property :begin elt)) - (delete-region (org-element-property :begin elt) (org-element-property :end elt)) - (insert (org-element-interpret-data (org-element-put-property elt :value replacement)))))))) - -(eval-after-load "org" - '(add-to-list 'org-src-lang-modes '("http" . "ob-http"))) - -(provide 'ob-http) -;;; ob-http.el ends here diff --git a/elpa/ob-restclient-20220202.1609/ob-restclient-autoloads.el b/elpa/ob-restclient-20220202.1609/ob-restclient-autoloads.el @@ -0,0 +1,28 @@ +;;; ob-restclient-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "ob-restclient" "ob-restclient.el" (0 0 0 0)) +;;; Generated autoloads from ob-restclient.el + +(autoload 'org-babel-execute:restclient "ob-restclient" "\ +Execute a block of Restclient code with org-babel. +This function is called by `org-babel-execute-src-block' + +\(fn BODY PARAMS)" nil nil) + +(register-definition-prefixes "ob-restclient" '("org-babel-")) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: +;;; ob-restclient-autoloads.el ends here diff --git a/elpa/ob-restclient-20220202.1609/ob-restclient-pkg.el b/elpa/ob-restclient-20220202.1609/ob-restclient-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from ob-restclient.el -*- no-byte-compile: t -*- +(define-package "ob-restclient" "20220202.1609" "org-babel functions for restclient-mode" '((restclient "0")) :commit "586f1fa07f76aaca13cb3f86945759f4b9fb8db7" :authors '(("Alf Lervåg")) :maintainer '("Alf Lervåg") :keywords '("literate programming" "reproducible research") :url "https://github.com/alf/ob-restclient.el") diff --git a/elpa/ob-restclient-20220202.1609/ob-restclient.el b/elpa/ob-restclient-20220202.1609/ob-restclient.el @@ -0,0 +1,146 @@ +;;; ob-restclient.el --- org-babel functions for restclient-mode + +;; Copyright (C) Alf Lervåg + +;; Author: Alf Lervåg +;; Keywords: literate programming, reproducible research +;; Package-Version: 20220202.1609 +;; Package-Commit: 586f1fa07f76aaca13cb3f86945759f4b9fb8db7 +;; Homepage: https://github.com/alf/ob-restclient.el +;; Version: 0.02 +;; Package-Requires: ((restclient "0")) + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; This is a very simple first iteration at integrating restclient.el +;; and org-mode. + +;;; Requirements: +;; restclient.el + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(require 'restclient) + +(defvar org-babel-default-header-args:restclient + `((:results . "raw")) + "Default arguments for evaluating a restclient block.") + +(defcustom org-babel-restclient--jq-path "jq" + "The path to `jq', for post-processing. Uses the PATH by default") + +;;;###autoload +(defun org-babel-execute:restclient (body params) + "Execute a block of Restclient code with org-babel. +This function is called by `org-babel-execute-src-block'" + (message "executing Restclient source code block") + (with-temp-buffer + (let ((results-buffer (current-buffer)) + (restclient-same-buffer-response t) + (restclient-same-buffer-response-name (buffer-name)) + (display-buffer-alist + (cons + '("\\*temp\\*" display-buffer-no-window (allow-no-window . t)) + display-buffer-alist))) + + (insert (buffer-name)) + (with-temp-buffer + (dolist (p params) + (let ((key (car p)) + (value (cdr p))) + (when (eql key :var) + (insert (format ":%s = <<\n%s\n#\n" (car value) (cdr value)))))) + (insert body) + (goto-char (point-min)) + (delete-trailing-whitespace) + (goto-char (point-min)) + (restclient-http-parse-current-and-do + 'restclient-http-do (org-babel-restclient--raw-payload-p params) t)) + + (while restclient-within-call + (sleep-for 0.05)) + + (goto-char (point-min)) + (when (equal (buffer-name) (buffer-string)) + (error "Restclient encountered an error")) + + (when (or (org-babel-restclient--return-pure-payload-result-p params) + (assq :noheaders params) + (assq :jq params)) + (org-babel-restclient--hide-headers)) + + (when-let* ((jq-header (assoc :jq params)) + (jq-path "jq")) + (shell-command-on-region + (point-min) + (point-max) + (format "%s %s" org-babel-restclient--jq-path + (shell-quote-argument (cdr jq-header))) + (current-buffer) + t)) + + ;; widen if jq but not pure payload + (when (and (assq :jq params) + (not (assq :noheaders params)) + (not (org-babel-restclient--return-pure-payload-result-p params))) + (widen)) + + (when (not (org-babel-restclient--return-pure-payload-result-p params)) + (org-babel-restclient--wrap-result)) + + (buffer-string)))) + +(defun org-babel-restclient--wrap-result () + "Wrap the contents of the buffer in an `org-mode' src block." + (let ((mode-name (substring (symbol-name major-mode) 0 -5))) + (insert (format "#+BEGIN_SRC %s\n" mode-name)) + (goto-char (point-max)) + (insert "#+END_SRC\n"))) + +(defun org-babel-restclient--hide-headers () + "Just return the payload." + (let ((comments-start + (save-excursion + (goto-char (point-max)) + (while (comment-only-p (line-beginning-position) (line-end-position)) + (forward-line -1)) + ;; Include the last line as well + (forward-line) + (point)))) + (narrow-to-region (point-min) comments-start))) + + +(defun org-babel-restclient--return-pure-payload-result-p (params) + "Return `t' if the `:results' key in PARAMS contains `value' or `table'." + (let ((result-type (cdr (assoc :results params)))) + (when result-type + (string-match "value\\|table" result-type)))) + + +(defun org-babel-restclient--raw-payload-p (params) + "Return t if the `:results' key in PARAMS contain `file'." + (let ((result-type (cdr (assoc :results params)))) + (when result-type + (string-match "file" result-type)))) + +(provide 'ob-restclient) +;;; ob-restclient.el ends here diff --git a/elpa/restclient-20220101.1239/restclient-autoloads.el b/elpa/restclient-20220101.1239/restclient-autoloads.el @@ -0,0 +1,40 @@ +;;; restclient-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "restclient" "restclient.el" (0 0 0 0)) +;;; Generated autoloads from restclient.el + +(autoload 'restclient-http-send-current "restclient" "\ +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. + +\(fn &optional RAW STAY-IN-WINDOW)" t nil) + +(autoload 'restclient-http-send-current-raw "restclient" "\ +Sends current request and get raw result (no reformatting or syntax highlight of XML, JSON or images)." t nil) + +(autoload 'restclient-http-send-current-stay-in-window "restclient" "\ +Send current request and keep focus in request window." t nil) + +(autoload 'restclient-mode "restclient" "\ +Turn on restclient mode. + +\(fn)" t nil) + +(register-definition-prefixes "restclient" '("restclient-")) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: +;;; restclient-autoloads.el ends here diff --git a/elpa/restclient-20220101.1239/restclient-pkg.el b/elpa/restclient-20220101.1239/restclient-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from restclient.el -*- no-byte-compile: t -*- +(define-package "restclient" "20220101.1239" "An interactive HTTP client for Emacs" 'nil :commit "9e2cfa86529133eba6c9ef53794be182f15e4c21" :authors '(("Pavel Kurnosov" . "pashky@gmail.com")) :maintainer '("Pavel Kurnosov" . "pashky@gmail.com") :keywords '("http")) diff --git a/elpa/restclient-20220101.1239/restclient.el b/elpa/restclient-20220101.1239/restclient.el @@ -0,0 +1,799 @@ +;;; 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 +;; Package-Version: 20220101.1239 +;; Package-Commit: 9e2cfa86529133eba6c9ef53794be182f15e4c21 + +;; 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 + (if (version< emacs-version "26") + (require 'cl) + (require 'cl-lib))) + +(defgroup restclient nil + "An interactive HTTP client for Emacs." + :group 'tools) + +(defcustom restclient-log-request t + "Log restclient requests to *Messages*." + :group 'restclient + :type 'boolean) + +(defcustom restclient-same-buffer-response t + "Re-use same buffer for responses or create a new one each time." + :group 'restclient + :type 'boolean) + +(defcustom restclient-same-buffer-response-name "*HTTP Response*" + "Name for response buffer." + :group 'restclient + :type 'string) + +(defcustom restclient-info-buffer-name "*Restclient Info*" + "Name for info buffer." + :group 'restclient + :type 'string) + +(defcustom restclient-inhibit-cookies nil + "Inhibit restclient from sending cookies implicitly." + :group 'restclient + :type 'boolean) + +(defcustom 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 'restclient + :type '(alist :key-type string :value-type symbol)) + +(defcustom restclient-response-body-only nil + "When parsing response, only return its body." + :group 'restclient + :type 'boolean) + +(defgroup restclient-faces nil + "Faces used in Restclient Mode" + :group 'restclient + :group 'faces) + +(defface restclient-variable-name-face + '((t (:inherit font-lock-preprocessor-face))) + "Face for variable name." + :group 'restclient-faces) + +(defface restclient-variable-string-face + '((t (:inherit font-lock-string-face))) + "Face for variable value (string)." + :group 'restclient-faces) + +(defface restclient-variable-elisp-face + '((t (:inherit font-lock-function-name-face))) + "Face for variable value (Emacs lisp)." + :group 'restclient-faces) + +(defface restclient-variable-multiline-face + '((t (:inherit font-lock-doc-face))) + "Face for multi-line variable value marker." + :group 'restclient-faces) + +(defface restclient-variable-usage-face + '((t (:inherit 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 'restclient-faces) + +(defface restclient-method-face + '((t (:inherit font-lock-keyword-face))) + "Face for HTTP method." + :group 'restclient-faces) + +(defface restclient-url-face + '((t (:inherit font-lock-function-name-face))) + "Face for variable value (Emacs lisp)." + :group 'restclient-faces) + +(defface restclient-file-upload-face + '((t (:inherit restclient-variable-multiline-face))) + "Face for highlighting upload file paths." + :group 'restclient-faces) + +(defface restclient-header-name-face + '((t (:inherit font-lock-variable-name-face))) + "Face for HTTP header name." + :group 'restclient-faces) + +(defface restclient-header-value-face + '((t (:inherit font-lock-string-face))) + "Face for HTTP header value." + :group 'restclient-faces) + +(defface restclient-request-hook-face + '((t (:inherit font-lock-preprocessor-face))) + "Face for single request hook indicator." + :group 'restclient-faces) + +(defface restclient-request-hook-name-face + '((t (:inherit font-lock-function-name-face))) + "Face for single request hook type names." + :group 'restclient-faces) + +(defface restclient-request-hook-args-face + '((t (:inherit font-lock-string-face))) + "Face for single request hook type arguments." + :group 'restclient-faces) + + +(defvar restclient-within-call nil) + +(defvar restclient-request-time-start nil) +(defvar restclient-request-time-end nil) + +(defvar 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 restclient-result-handlers '() + "A registry of available completion hooks. + Stored as an alist of name -> (hook-creation-func . description)") + +(defvar restclient-curr-request-functions nil + "A list of functions to run once when the next request is loaded") + +(defvar restclient-response-loaded-hook nil + "Hook run after response buffer is formatted.") + +(defvar restclient-http-do-hook nil + "Hook to run before making request.") + +(defvar restclient-response-received-hook nil + "Hook run after data is loaded into response buffer.") + +(defcustom 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 'restclient + :type 'integer) + +(defconst restclient-comment-separator "#") +(defconst restclient-comment-start-regexp (concat "^" restclient-comment-separator)) +(defconst restclient-comment-not-regexp (concat "^[^" restclient-comment-separator "]")) +(defconst restclient-empty-line-regexp "^\\s-*$") + +(defconst restclient-method-url-regexp + "^\\(GET\\|POST\\|DELETE\\|PUT\\|HEAD\\|OPTIONS\\|PATCH\\) \\(.*\\)$") + +(defconst restclient-header-regexp + "^\\([^](),/:;@[\\{}= \t]+\\): \\(.*\\)$") + +(defconst restclient-use-var-regexp + "^\\(:[^: \n]+\\)$") + +(defconst restclient-var-regexp + (concat "^\\(:[^:= ]+\\)[ \t]*\\(:?\\)=[ \t]*\\(<<[ \t]*\n\\(\\(.*\n\\)*?\\)" restclient-comment-separator "\\|\\([^<].*\\)$\\)")) + +(defconst restclient-svar-regexp + "^\\(:[^:= ]+\\)[ \t]*=[ \t]*\\(.+?\\)$") + +(defconst restclient-evar-regexp + "^\\(:[^: ]+\\)[ \t]*:=[ \t]*\\(.+?\\)$") + +(defconst restclient-mvar-regexp + "^\\(:[^: ]+\\)[ \t]*:?=[ \t]*\\(<<\\)[ \t]*$") + +(defconst restclient-file-regexp + "^<[ \t]*\\([^<>\n\r]+\\)[ \t]*$") + +(defconst restclient-content-type-regexp + "^Content-[Tt]ype: \\(\\w+\\)/\\(?:[^\\+\r\n]*\\+\\)*\\([^;\r\n]+\\)") + +(defconst 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 restclient-fix) + (if restclient-within-call + (setq ad-return-value t) + ad-do-it)) +(ad-activate 'url-http-handle-authentication) + +(defadvice url-cache-extract (around restclient-fix-2) + (unless restclient-within-call + ad-do-it)) +(ad-activate 'url-cache-extract) + +(defadvice url-http-user-agent-string (around restclient-fix-3) + (if restclient-within-call + (setq ad-return-value nil) + ad-do-it)) +(ad-activate 'url-http-user-agent-string) + +(defun restclient-http-do (method url headers entity &rest handle-args) + "Send ENTITY and HEADERS to URL as a METHOD request." + (if 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 restclient-within-call t) + (setq restclient-request-time-start (current-time)) + (run-hooks 'restclient-http-do-hook) + (url-retrieve url 'restclient-http-handle-response + (append (list method url (if restclient-same-buffer-response + restclient-same-buffer-response-name + (format "*HTTP %s %s*" method url))) handle-args) nil restclient-inhibit-cookies))) + +(defun restclient-prettify-response (method url) + (save-excursion + (let ((start (point)) (guessed-mode) (end-of-headers)) + (while (and (not (looking-at restclient-empty-line-regexp)) + (eq (progn + (when (looking-at restclient-content-type-regexp) + (setq guessed-mode + (cdr (assoc-string (concat + (match-string-no-properties 1) + "/" + (match-string-no-properties 2)) + restclient-content-type-modes + t)))) + (forward-line)) 0))) + (setq end-of-headers (point)) + (while (and (looking-at 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))) + (restclient-prettify-json-unicode))) + + (goto-char (point-max)) + (or (eq (point) (point-min)) (insert "\n")) + (unless restclient-response-body-only + (let ((hstart (point))) + (insert method " " url "\n" headers) + (insert (format "Request duration: %fs\n" (float-time (time-subtract restclient-request-time-end restclient-request-time-start)))) + (unless (member guessed-mode '(image-mode text-mode)) + (comment-region hstart (point)))))))))) + +(defun 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 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 restclient-within-call nil) + (setq 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 (restclient-decode-response + (current-buffer) + bufname + restclient-same-buffer-response) + (run-hooks 'restclient-response-received-hook) + (unless raw + (restclient-prettify-response method url)) + (buffer-enable-undo) + (restclient-response-mode) + (run-hooks 'restclient-response-loaded-hook) + (if stay-in-window + (display-buffer (current-buffer) t) + (switch-to-buffer-other-window (current-buffer))))))) + +(defun 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 restclient-current-min () + (save-excursion + (beginning-of-line) + (if (looking-at restclient-comment-start-regexp) + (if (re-search-forward restclient-comment-not-regexp (point-max) t) + (point-at-bol) (point-max)) + (if (re-search-backward restclient-comment-start-regexp (point-min) t) + (point-at-bol 2) + (point-min))))) + +(defun restclient-current-max () + (save-excursion + (if (re-search-forward 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 restclient-replace-all-in-string (replacements string) + (if replacements + (let ((current string) + (pass 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 restclient-replace-all-in-header (replacements header) + (cons (car header) + (restclient-replace-all-in-string replacements (cdr header)))) + +(defun restclient-chop (text) + (if text (replace-regexp-in-string "\n$" "" text) nil)) + +(defun restclient-find-vars-before-point () + (let ((vars nil) + (bound (point))) + (save-excursion + (goto-char (point-min)) + (while (search-forward-regexp restclient-var-regexp bound t) + (let ((name (match-string-no-properties 1)) + (should-eval (> (length (match-string 2)) 0)) + (value (or (restclient-chop (match-string-no-properties 4)) (match-string-no-properties 3)))) + (setq vars (cons (cons name (if should-eval (restclient-eval-var value) value)) vars)))) + (append restclient-var-overrides vars)))) + +(defun restclient-eval-var (string) + (with-output-to-string (princ (eval (read string))))) + +(defun restclient-make-header (&optional string) + (cons (match-string-no-properties 1 string) + (match-string-no-properties 2 string))) + +(defun restclient-parse-headers (string) + (let ((start 0) + (headers '())) + (while (string-match restclient-header-regexp string start) + (setq headers (cons (restclient-make-header string) headers) + start (match-end 0))) + headers)) + +(defun restclient-read-file (path) + (with-temp-buffer + (insert-file-contents path) + (buffer-string))) + +(defun restclient-parse-body (entity vars) + (if (= 0 (or (string-match restclient-file-regexp entity) 1)) + (restclient-read-file (match-string 1 entity)) + (restclient-replace-all-in-string vars entity))) + +(defun restclient-parse-hook (cb-type args-offset args) + (if-let ((handler (assoc cb-type restclient-result-handlers))) + (funcall (cadr handler) args args-offset) + `(lambda () + (message "Unknown restclient hook type %s" ,cb-type)))) + +(defun restclient-register-result-func (name creation-func description) + (let ((new-cell (cons name (cons creation-func description)))) + (setq restclient-result-handlers (cons new-cell restclient-result-handlers)))) + +(defun restclient-remove-var (var-name) + (setq restclient-var-overrides (assoc-delete-all var-name restclient-var-overrides))) + +(defun restclient-set-var (var-name value) + (restclient-remove-var var-name) + (setq restclient-var-overrides (cons (cons var-name value) restclient-var-overrides))) + +(defun 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 restclient buffer we need to lookup vars before the current hook or evar + ;; outside a restclient buffer only globals are available so moving the point wont matter + (re-search-backward "^:\\|->" (point-min) t) + (restclient-find-vars-before-point)))) + (restclient-replace-all-in-string vars-at-point (cdr (assoc var-name vars-at-point))))) + +(defmacro restclient-get-var (var-name) + (lexical-let ((buf-name (buffer-name (current-buffer))) + (buf-point (point))) + `(restclient-get-var-at-point ,var-name ,buf-name ,buf-point))) + +(defun restclient-single-request-function () + (dolist (f restclient-curr-request-functions) + (ignore-errors + (funcall f))) + (setq restclient-curr-request-functions nil) + (remove-hook 'restclient-response-loaded-hook 'restclient-single-request-function)) + + +(defun restclient-http-parse-current-and-do (func &rest args) + (save-excursion + (goto-char (restclient-current-min)) + (when (re-search-forward restclient-method-url-regexp (point-max) t) + (let ((method (match-string-no-properties 1)) + (url (string-trim (match-string-no-properties 2))) + (vars (restclient-find-vars-before-point)) + (headers '())) + (forward-line) + (while (cond + ((looking-at restclient-response-hook-regexp) + (when-let (hook-function (restclient-parse-hook (match-string-no-properties 2) + (match-end 2) + (match-string-no-properties 3))) + (push hook-function restclient-curr-request-functions))) + ((and (looking-at restclient-header-regexp) (not (looking-at restclient-empty-line-regexp))) + (setq headers (cons (restclient-replace-all-in-header vars (restclient-make-header)) headers))) + ((looking-at restclient-use-var-regexp) + (setq headers (append headers (restclient-parse-headers (restclient-replace-all-in-string vars (match-string 1))))))) + (forward-line)) + (when (looking-at restclient-empty-line-regexp) + (forward-line)) + (when restclient-curr-request-functions + (add-hook 'restclient-response-loaded-hook 'restclient-single-request-function)) + (let* ((cmax (restclient-current-max)) + (entity (restclient-parse-body (buffer-substring (min (point) cmax) cmax) vars)) + (url (restclient-replace-all-in-string vars url))) + (apply func method url headers entity args)))))) + +(defun restclient-copy-curl-command () + "Formats the request as a curl command and copies the command to the clipboard." + (interactive) + (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 restclient-elisp-result-function (args offset) + (goto-char offset) + (lexical-let ((form (macroexpand-all (read (current-buffer))))) + (lambda () + (eval form)))) + +(restclient-register-result-func + "run-hook" #'restclient-elisp-result-function + "Call the provided (possibly multi-line) elisp when the result + buffer is formatted. Equivalent to a restclient-response-loaded-hook + that only runs for this request. + eg. -> on-response (message \"my hook called\")" ) + +;;;###autoload +(defun 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) + (restclient-http-parse-current-and-do 'restclient-http-do raw stay-in-window)) + +;;;###autoload +(defun restclient-http-send-current-raw () + "Sends current request and get raw result (no reformatting or syntax highlight of XML, JSON or images)." + (interactive) + (restclient-http-send-current t)) + +;;;###autoload +(defun restclient-http-send-current-stay-in-window () + "Send current request and keep focus in request window." + (interactive) + (restclient-http-send-current nil t)) + +(defun restclient-jump-next () + "Jump to next request in buffer." + (interactive) + (let ((last-min nil)) + (while (not (eq last-min (goto-char (restclient-current-min)))) + (goto-char (restclient-current-min)) + (setq last-min (point)))) + (goto-char (+ (restclient-current-max) 1)) + (goto-char (restclient-current-min))) + +(defun restclient-jump-prev () + "Jump to previous request in buffer." + (interactive) + (let* ((current-min (restclient-current-min)) + (end-of-entity + (save-excursion + (progn (goto-char (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 (restclient-current-min))))) + +(defun restclient-mark-current () + "Mark current request." + (interactive) + (goto-char (restclient-current-min)) + (set-mark-command nil) + (goto-char (restclient-current-max)) + (backward-char 1) + (setq deactivate-mark nil)) + +(defun restclient-show-info () + ;; restclient-info-buffer-name + (interactive) + (let ((vars-at-point (restclient-find-vars-before-point))) + (cl-labels ((non-overidden-vars-at-point () + (seq-filter (lambda (v) + (null (assoc (car v) restclient-var-overrides))) + vars-at-point)) + (sanitize-value-cell (var-value) + (replace-regexp-in-string "\n" "|\n| |" + (replace-regexp-in-string "\|" "\\\\vert{}" + (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 restclient-info-buffer-name) + ;; insert our info + (erase-buffer) + + (insert "\Restclient Info\ \n\n") + + (var-table "Dynamic Variables") + (dolist (dv 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 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 restclient-result-handlers))) + (var-row handler-name (cddr (assoc handler-name 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) + (restclient-response-mode) + (goto-char (point-min)))) + (switch-to-buffer-other-window restclient-info-buffer-name))) + +(defun restclient-narrow-to-current () + "Narrow to region of current request" + (interactive) + (narrow-to-region (restclient-current-min) (restclient-current-max))) + +(defun 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 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) (restclient-current-max) nil) + (outline-flag-region (point) (restclient-current-max) t)))) t))) + +(defun restclient-toggle-body-visibility-or-indent () + (interactive) + (unless (restclient-toggle-body-visibility) + (indent-for-tab-command))) + +(defconst restclient-mode-keywords + (list (list restclient-method-url-regexp '(1 'restclient-method-face) '(2 'restclient-url-face)) + (list restclient-svar-regexp '(1 'restclient-variable-name-face) '(2 'restclient-variable-string-face)) + (list restclient-evar-regexp '(1 'restclient-variable-name-face) '(2 'restclient-variable-elisp-face t)) + (list restclient-mvar-regexp '(1 'restclient-variable-name-face) '(2 'restclient-variable-multiline-face t)) + (list restclient-use-var-regexp '(1 'restclient-variable-usage-face)) + (list restclient-file-regexp '(0 'restclient-file-upload-face)) + (list restclient-header-regexp '(1 'restclient-header-name-face t) '(2 'restclient-header-value-face t)) + (list restclient-response-hook-regexp '(1 ' restclient-request-hook-face t) + '(2 'restclient-request-hook-name-face t) + '(3 'restclient-request-hook-args-face t)))) + +(defconst restclient-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\# "<" table) + (modify-syntax-entry ?\n ">#" table) + table)) + +(defvar restclient-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") 'restclient-http-send-current) + (define-key map (kbd "C-c C-r") 'restclient-http-send-current-raw) + (define-key map (kbd "C-c C-v") 'restclient-http-send-current-stay-in-window) + (define-key map (kbd "C-c C-n") 'restclient-jump-next) + (define-key map (kbd "C-c C-p") 'restclient-jump-prev) + (define-key map (kbd "C-c C-.") 'restclient-mark-current) + (define-key map (kbd "C-c C-u") 'restclient-copy-curl-command) + (define-key map (kbd "C-c n n") 'restclient-narrow-to-current) + (define-key map (kbd "C-c C-i") 'restclient-show-info) + map) + "Keymap for restclient-mode.") + +(define-minor-mode restclient-outline-mode + "Minor mode to allow show/hide of request bodies by TAB." + :init-value nil + :lighter nil + :keymap '(("\t" . restclient-toggle-body-visibility-or-indent) + ("\C-c\C-a" . restclient-toggle-body-visibility-or-indent)) + :group 'restclient) + +(define-minor-mode restclient-response-mode + "Minor mode to allow additional keybindings in restclient response buffer." + :init-value nil + :lighter nil + :keymap '(("q" . (lambda () + (interactive) + (quit-window (get-buffer-window (current-buffer)))))) + :group 'restclient) + +;;;###autoload +(define-derived-mode restclient-mode fundamental-mode "REST Client" + "Turn on 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) '(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 'restclient-mode-hook 'restclient-outline-mode) + +(provide 'restclient) + +(eval-after-load 'helm + '(ignore-errors (require 'restclient-helm))) + +(eval-after-load 'jq-mode + '(ignore-errors (require 'restclient-jq))) + +;;; restclient.el ends here diff --git a/init.el b/init.el @@ -16,6 +16,9 @@ (require 'paredit-menu) (require 'iso-transl) +(with-eval-after-load 'restclient + (require 'restclient-capf)) + (setq org-roam-v2-ack t) (setq lh/dir-documents @@ -189,7 +192,7 @@ (lisp . t) (shell . t) (emacs-lisp . t) - (http . t))) + (restclient . t))) '(org-log-done 'time) '(org-log-done-with-time t) '(org-src-window-setup 'other-window) @@ -201,7 +204,7 @@ ("melpa-stable" . "https://stable.melpa.org/packages/") ("melpa" . "https://melpa.org/packages/"))) '(package-selected-packages - '(vterm deadgrep helpful ob-http pdf-tools paredit-menu paredit vertico-posframe vertico corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-roam org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) + '(ob-restclient restclient vterm deadgrep helpful pdf-tools paredit-menu paredit vertico-posframe vertico corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-roam org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) '(pcomplete-ignore-case t t) '(pixel-scroll-precision-mode t) '(read-buffer-completion-ignore-case t) diff --git a/lisp/restclient-capf.el b/lisp/restclient-capf.el @@ -0,0 +1,104 @@ +;; -*- lexical-binding: t; -*- +;; basic capf for restclient +;; only works for first request in buffer + +(defun restclient-capf--load-mimefile () + (let ((filename "/etc/mime.types") + (mimelist)) + (when (file-exists-p filename) + (with-temp-buffer + (insert-file filename) + (goto-char 0) + (while (progn + (line-beginning-position) + (when (search-forward-regexp "[[:space:]]" nil t) + (push (buffer-substring-no-properties (line-beginning-position) (- (point) 1)) mimelist)) + (= 0 (forward-line)))))) + mimelist)) + +(defvar restclient-capf-mime-types + (pcase system-type + ('gnu/linux (restclient-capf--load-mimefile)))) + +(defconst restclient-capf-http-methods + '(GET + HEAD + POST + PUT + DELETE + OPTIONS + TRACE + PATCH)) + +(defconst restclient-capf-http-headers + `(;;; 3. Representations + ;; 3.1. Representation Metadata + ("Content-Type" . ,restclient-capf-mime-types) + ("Content-Encoding") + ("Content-Language") + ("Content-Location") + ;; 3.3. Payload Semantics + ("Content-Length") + ("Trailer") + ("Transfer-Encoding") + ;;; 5. Request Header Fields + ;; 5.1. Controls + ("Cache-Control") + ("Expect") + ("Host") + ("Max-Forwards") + ("Pragma") + ("Range") + ("TE") + ;; 5.2. Conditionals + ("If-Match") + ("If-None-Match") + ("If-Modified-Since") + ("If-Unmodified-Since") + ("If-Range") + ;; 5.3. Content Negotiation + ("Accept" . ,restclient-capf-mime-types) + ("Accept-Charset") + ("Accept-Encoding") + ("Accept-Language") + ;; 5.4. Authentication Credentials + ("Authorization") + ("Proxy-Authorization") + ;; 5.5. Request Context + ("From") + ("Referer") + ("User-Agent"))) + +(defun restclient-completion-at-point () + (let* ((start (save-excursion + (search-backward-regexp "^\\|[[:space:]]") + (skip-chars-forward " " (line-end-position)) + (point))) + (end (point))) + + (list start end + (cond + ((save-excursion + (search-backward-regexp "[\r\n][\r\n]" nil t)) + nil) + ((= (line-beginning-position) 1) + (save-excursion + (when (not (search-backward-regexp "[[:space:]]" nil t)) + restclient-capf-http-methods))) + (t + (save-excursion + (beginning-of-line) + (if (search-forward ":" (line-end-position) t) + (cdr (assoc (string-trim (buffer-substring-no-properties (line-beginning-position) + (- (point) 1))) + restclient-capf-http-headers + (lambda (a b) + (compare-strings a nil nil b nil nil t)))) + (mapcar (lambda (x) (car x)) restclient-capf-http-headers)))))))) + +(defun restclient-capf-register () + (add-hook 'completion-at-point-functions #'restclient-completion-at-point nil t)) + +(add-hook 'restclient-mode-hook #'restclient-capf-register) + +(provide 'restclient-capf)