EmacsのDoctorの操作感を改善する
しむどん
：
2025-03-14
Emacsにはユーザーの心をケアするための doctor.el という機能が同梱されている。もしも作業中に心が疲れてしまったら M-x doctor と入力する。すると *doctor* というバッファが作られ、主治医と対話できるようになる。そして対話の最後に「請求書を送る」と言われる。
doctor.el 自体は本当にシンプルな仕組みで実装されており、そのため現代の他の同様の機能と比較するといくらか見劣りする。しかし僕はこの機能のコンセプトは好きなので、できる限りそれを大切にしたいと考えていた。そのためこれまでにも何度か doctor.el を拡張する形で、入力方法を改善したり、 ChatGPT に対応さたりしていた。しかしその頃からもう2年程経過し、世の中のツールもかなり進化した。そこで doctor.el についてもう一度考えて、拡張を実装し直した。
;;; doctor-quack --- Emacs Doctor Enhancement -*- lexical-binding:t; coding:utf-8 -*-
;; Copyright (C) 2025 TakesxiSximada
;; Author: TakesxiSximada
;; Maintainer: TakesxiSximada
;; Former-Maintainers:
;; TakesxiSximada
;; Homepage: nil
;; Keywords: doctor
;; Repository: nil
;; Version: 2
;; Package-Version: 20250328.0000
;; Package-Requires: nil
;; Date: 2025-03-28
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file is not part of GNU Emacs.
;; 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/>.
;;; Change Log:
;;
;; - Version: 2 (2025-03-28)
;; - Add section separator.
;; - Add doctor-quack-done-hook hook.
;; - Add doctor-quack-output-start-marker marker.
;;
;; - Version: 1 (2025-03-14)
;; - Initially populated.
;;; Commentary:
;; This program extends Emacs' default `doctor.el` to be more in
;; gently cares for your heart.
;;; Code:
(require 'doctor)
(defvar doctor-quack-prompt nil)
(defvar doctor-quack-curl-executable "/opt/homebrew/opt/curl/bin/curl")
(defvar doctor-quack-openai-api-request-stdout-buffer-name "*doctor: curl: OpenAI: stdout*")
(defvar doctor-quack-openai-api-request-body-file nil)
(defvar doctor-quack-openai-api-request-temp-buffer-name "*doctor: curl: OpenAI: tmp*")
(defvar doctor-quack-openai-api-curl-process nil)
(defvar doctor-quack-done-hook nil)
(defun doctor-quack-process-output ()
(interactive)
(with-current-buffer doctor-quack-openai-api-request-stdout-buffer-name
(save-excursion
(goto-char (marker-position doctor-quack-curl-stdout-end-marker))
(catch 'output-process-stop
(while (re-search-forward "^data: " nil t 1)
(if (re-search-forward "\\[DONE\\]" (+ (point) 6) t 1)
(progn
(with-current-buffer "*doctor*"
(goto-char (point-max))
(run-hooks 'doctor-quack-done-hook)
(insert "\n----------------------------------\n"))
(doctor-quack-update-curl-stdout-end-position)
(doctor-quack-update-end-position)
(throw 'output-process-stop 1))
(progn
(let ((obj (condition-case err (json-read-object)
(progn
(warn (format "JSONの解析失敗: 位置: %d"
(marker-position doctor-quack-curl-stdout-end-marker)))
(throw 'output-process-stop 2)))))
(if-let ((content (cdr (assoc 'content (cdr (assoc 'delta (seq-first (cdr (assoc 'choices obj)))))))))
(progn
(with-current-buffer "*doctor*"
(goto-char (point-max))
(insert content)
(doctor-quack-update-end-position))
(doctor-quack-update-curl-stdout-end-position)))))))))))
(defvar doctor-quack-output-process-timer nil
"出力処理の予約用タイマー")
(defun doctor-quack-register-process-output ()
(interactive)
(message "出力処理を予約する")
(when doctor-quack-output-process-timer
(cancel-timer doctor-quack-output-process-timer))
(setq doctor-quack-output-process-timer
(run-with-idle-timer 0.4 nil #'doctor-quack-process-output)))
(defun doctor-quack-read-print ()
(interactive)
(message "プロンプトを作成")
(setq doctor-quack-prompt (string-trim
(buffer-substring-no-properties
(marker-position doctor-quack-output-end-marker)
(point-max))))
(insert (format "\nあなたの入力:\n「%s」\n主治医の回答:\n" doctor-quack-prompt))
(unless doctor-quack-output-start-marker
(setq doctor-quack-output-start-marker (make-marker)))
(with-current-buffer "*doctor*"
(set-marker doctor-quack-output-start-marker (point) (current-buffer)))
(doctor-quack-update-end-position)
(message "ペイロード用ファイルを作成")
(make-directory "~/.cache/openai" t)
(setq doctor-quack-openai-api-request-body-file
(make-temp-file (expand-file-name "~/.cache/openai/chat-completions-") nil ".json"
(json-encode `((stream . t)
(model . "gpt-4o-mini-2024-07-18")
(messages . [
((role . "user")
(content . ,doctor-quack-prompt))
])))))
(message "出力バッファを初期化する")
(with-current-buffer (get-buffer-create doctor-quack-openai-api-request-stdout-buffer-name)
(erase-buffer)
(doctor-quack-update-curl-stdout-end-position))
(message "curlプロセスを起動する")
(setq doctor-quack-openai-api-curl-process
(make-process :name "*doctor: curl: OpenAI*"
:buffer doctor-quack-openai-api-request-stdout-buffer-name
:stderr "*doctor: curl: OpenAI: stderr*"
:command `(,doctor-quack-curl-executable
"--data" ,(format "@%s" doctor-quack-openai-api-request-body-file)
"-K-")
:filter (lambda (process output)
(with-current-buffer (process-buffer process)
(goto-char (point-max))
(insert output)
(doctor-quack-register-process-output)
))
:sentinel (lambda (process event)
(doctor-quack-register-process-output))))
(message "リクエストを送信する")
(with-current-buffer (get-buffer-create doctor-quack-openai-api-request-temp-buffer-name)
(erase-buffer)
(insert (format "url \"%s/v1/chat/completions\"
request \"POST\"
header \"Content-Type: application/json\"
header \"Authorization: Bearer %s\"
" "https://api.openai.com" openai-api-key))
(process-send-region doctor-quack-openai-api-curl-process (point-min) (point-max))
(process-send-eof doctor-quack-openai-api-curl-process))
(message "doctor: send request"))
(defvar doctor-quack-output-start-marker nil
"doctorバッファの開始位置を示すマーカー")
(defvar doctor-quack-output-end-marker nil
"doctorバッファの最終位置を示すマーカー")
(defvar doctor-quack-curl-stdout-end-marker nil
"curlのstdoutの最終位置を示すマーカー")
(defun doctor-quack-update-curl-stdout-end-position ()
"curlのstdoutバッファの最終位置を更新する"
(interactive)
(unless doctor-quack-curl-stdout-end-marker
(setq doctor-quack-curl-stdout-end-marker (make-marker)))
(with-current-buffer (get-buffer-create doctor-quack-openai-api-request-stdout-buffer-name)
(set-marker doctor-quack-curl-stdout-end-marker (point) (current-buffer))))
(defun doctor-quack-update-end-position ()
"doctorバッファの最終位置を更新する"
(interactive)
(unless doctor-quack-output-end-marker
(setq doctor-quack-output-end-marker (make-marker)))
(with-current-buffer "*doctor*"
(set-marker doctor-quack-output-end-marker (point) (current-buffer))))
(defun doctor-quack-setup ()
(message "setup ddoctor")
(goto-char (point-max))
(doctor-quack-update-end-position)
(doctor-quack-update-curl-stdout-end-position)
(message "standby okay!!"))
(add-hook 'doctor-mode-hook #'doctor-quack-setup)
(provide 'doctor-quack)
;;; doctor-quack.el ends heredoctor-quack.el