EmacsのHTTPクライアント事情について考える

;;; curl ---  cURL Utility -*- lexical-binding: t -*-

;; Copyright (C) 2024 TakesxiSximada

;; Author: TakesxiSximada <[email protected]>
;; Maintainer: TakesxiSximada  <[email protected]>
;; Version: 3
;; Package-Version: 20240321.0000
;; Package-Requires:
;; Date: 2024-03-21

;; This file is not part of GNU Emacs.

;;; License:

;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU Affero 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
;; Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public
;; License along with this program.  If not, see
;; <https://www.gnu.org/licenses/>.

;;; Code:

(defcustom curl-executable "curl"
  "Path to curl command"
  :group 'curl
  :type 'file)

(defcustom curl-config-buffer-name "*cURL Config*"
  "Name of cURL Config Buffer"
  :group 'curl
  :type 'string)


(defcustom curl-process-buffer-name "*cURL Process*"
  "Name of cURL Process Buffer"
  :group 'curl
  :type 'string)

(defcustom curl-output-buffer-name "*cURL Output*"
  "Name of cURL Output Buffer"
  :group 'curl
  :type 'string)

(defcustom curl-error-buffer-name "*cURL Error*"
  "Name of cURL Error Buffer"
  :group 'curl
  :type 'string)

(defvar curl-config-template
  "# cURL Configuration for Emacs

url %s

request %s

header %s

data %s

")

(defvar curl-process nil)
(defvar curl-process-sentinel nil)
(defvar curl-config-buffer nil)
(defvar curl-process-sentinel-hook nil)

;;;###autoload
(defun curl-create-config ()
  (interactive)
  (with-current-buffer (get-buffer-create curl-config-buffer-name)
    (erase-buffer)
    (insert
     (format curl-config-template
	     (json-encode-string "http://example.com")
	     (json-encode-string "GET")
	     (json-encode-string "Content-Type: application/json")
	     (json-encode-string "{}")))
    (curl-config-mode))
  (display-buffer curl-config-buffer-name))

;;;###autoload
(defun curl-send-request ()
  "Launch curl as a subprocess and send requests by feeding settings into the standard input."
  (interactive)
  (setq curl-config-buffer (get-buffer curl-config-buffer-name))
  (setq curl-output-buffer (get-buffer-create curl-output-buffer-name))
  (setq curl-error-buffer (get-buffer-create curl-error-buffer-name))

  (with-current-buffer curl-output-buffer
    (erase-buffer))

  (with-current-buffer curl-error-buffer
    (erase-buffer))

  (setq curl-process
	(make-process
	 :name "curl"
	 :buffer (get-buffer-create curl-output-buffer-name)
	 :stderr (get-buffer-create curl-error-buffer-name)
	 :command `(,curl-executable "-v" "-K-")
	 :sentinel (lambda (process event)
		     (run-hook-with-args
		      'curl-process-sentinel-hook process event))))

  (process-send-string curl-process
		       (with-current-buffer curl-config-buffer
			 (buffer-string)))
  (process-send-eof curl-process)

  (setq curl-result-output-window (split-window-horizontally))
  (setq curl-result-error-window (split-window-below nil curl-result-output-window))
  (set-window-buffer curl-result-output-window curl-output-buffer-name)
  (set-window-buffer curl-result-error-window curl-error-buffer-name)
  (select-window curl-result-output-window))

(defun curl-edit-config-value ()
  "
'edit-indirect-after-commit-functions
"
  (interactive)
  (unwind-protect
      (progn
	(narrow-to-region (line-beginning-position) (line-end-position))
	(when (re-search-forward "\s*\\\"\\(.*\\)\\\"\s*$" nil t)
	  (edit-indirect-region (match-beginning 1)
				(match-end 1)
				t)))

    (widen)))

(defun curl-send-request-to-buffer ()
  (interactive)
  (process-send-string curl-request-target-process
		       "curl -v -K-\n")
  (process-send-string curl-request-target-process
		       (with-current-buffer curl-config-buffer
			 (buffer-string)))
  (process-send-eof curl-request-target-process)
  (process-send-eof curl-request-target-process))

;;;###autoload
(defun curl-select-process (&optional buf)
  (interactive "bBuffer: ")
  (if-let ((proc (get-buffer-process buf)))
      (setq-local curl-process proc)))

;;;###autoload
(defun curl-start-on-shell ()
  (interactive)
  (process-send-string curl-process "curl -v -K-\n"))

;;;###autoload
(defun curl-start-make-process ()
  (interactive)
  (make-process
   :name "curl"
   :buffer (get-buffer-create curl-output-buffer-name)
   :stderr (get-buffer-create curl-error-buffer-name)
   :command `(,curl-executable "-v" "-K-")))

;;;###autoload
(defun curl-send ()
  (interactive)
  (process-send-string curl-process (buffer-string))
  (process-send-eof curl-process))

;;;###autoload
(defun curl-json-to-data-as-region-kill-new ()
  (interactive)
  (kill-new
   (json-encode-string
    (json-encode
     (json-read-from-string
      (buffer-substring-no-properties
       (region-beginning) (region-end)))))))

(define-derived-mode curl-config-mode fundamental-mode
  :group 'curl)

(define-key curl-config-mode-map (kbd "C-c C-s") #'curl-start-on-shell)
(define-key curl-config-mode-map (kbd "C-c C-p") #'curl-start-make-process)
(define-key curl-config-mode-map (kbd "C-c C-l") #'curl-select-process)
(define-key curl-config-mode-map (kbd "C-c C-c") #'curl-send)

(provide 'curl)
;; curl.el ends here