Files
my-lisp/my-labai.el
T
2026-07-03 09:04:08 +09:00

953 lines
32 KiB
EmacsLisp

;; -*- lexical-binding: t; -*-
(require 'json)
(require 'url)
(require 'subr-x)
(require 'cl-lib)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; configuration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar lab-ai-url
"https://amorphous.tf.chiba-u.jp/lab-ai/chat")
(defvar lab-ai-image-url
"https://amorphous.tf.chiba-u.jp/lab-ai/image")
(defvar lab-ai-image-edit-url
"https://amorphous.tf.chiba-u.jp/lab-ai/image-edit")
(defvar lab-ai-image-size
"1024x1024")
(defvar lab-ai-models
'("gpt-5-mini"
"gpt-5"
"gpt-5.5"))
(defvar lab-ai-model
"gpt-5.5")
(defvar lab-ai-timeout
"600")
(defvar lab-ai-max-attachment-size
(* 50 1024 1024))
(defvar lab-ai-chat-history-max-messages
200)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lab-ai-read-token ()
(with-temp-buffer
(insert-file-contents
(expand-file-name "~/.config/lab-ai/token"))
(string-trim (buffer-string))))
(defun lab-ai--parse-response-buffer (buf)
(with-current-buffer buf
(goto-char (point-min))
(let* ((json-object-type 'alist)
(json-response (json-read))
(answer (cdr (assoc 'answer json-response)))
(detail (cdr (assoc 'detail json-response))))
(cond
(answer answer)
(detail
(error "lab-ai error: %s" detail))
(t
(error "Invalid response: %s" (buffer-string)))))))
(defun lab-ai-request-async
(prompt on-success &optional on-error model attachments)
(let* ((token (lab-ai-read-token))
(payload
(json-encode
`(("prompt" . ,prompt)
("model" . ,(or model lab-ai-model))
("attachments" . ,(vconcat (or attachments nil))))))
(payload-bytes
(encode-coding-string payload 'utf-8-unix))
(buf (generate-new-buffer " *lab-ai-curl*"))
proc)
(setq proc
(make-process
:name "lab-ai-curl"
:buffer buf
:connection-type 'pipe
:command
(list "curl"
"-sS"
"-f"
"--max-time" lab-ai-timeout
"-X" "POST"
lab-ai-url
"-H" "Content-Type: application/json; charset=utf-8"
"-H" (concat "Authorization: Bearer " token)
"--data-binary" "@-")
:noquery t
:sentinel
(lambda (proc _event)
(when (memq (process-status proc) '(exit signal))
(let ((buf (process-buffer proc)))
(unwind-protect
(condition-case err
(if (= (process-exit-status proc) 0)
(funcall
on-success
(lab-ai--parse-response-buffer buf))
(with-current-buffer buf
(error "curl failed (%s): %s"
(process-exit-status proc)
(buffer-string))))
(error
(if on-error
(funcall on-error err)
(message "Lab-AI: error: %s"
(error-message-string err)))))
(when (buffer-live-p buf)
(kill-buffer buf))))))))
(set-process-coding-system proc 'utf-8-unix 'binary)
(message "Lab-AI: payload bytes=%d"
(string-bytes payload-bytes))
(process-send-string proc payload-bytes)
(process-send-eof proc)
proc))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; attachment helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lab-ai--guess-mime-type (file)
(let ((ext (downcase (or (file-name-extension file) ""))))
(cond
((string= ext "png") "image/png")
((member ext '("jpg" "jpeg")) "image/jpeg")
((string= ext "webp") "image/webp")
((string= ext "gif") "image/gif")
((string= ext "pdf") "application/pdf")
(t "application/octet-stream"))))
(defun lab-ai--file-to-base64 (file)
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file)
(base64-encode-string (buffer-string) t)))
; pkg install pngpaste
(defun lab-ai-chat-attach-clipboard-image ()
"Attach image in macOS clipboard as PNG."
(interactive)
(unless (derived-mode-p 'lab-ai-chat-mode)
(user-error "This command is for lab-ai-chat-mode"))
(unless (executable-find "pngpaste")
(user-error "pngpaste not found. Install: sudo port install pngpaste"))
(let* ((file
(expand-file-name
(format-time-string "lab-ai-clipboard-%Y%m%d-%H%M%S.png")
temporary-file-directory))
(status
(call-process "pngpaste" nil nil nil file)))
(unless (= status 0)
(when (file-exists-p file)
(delete-file file))
(user-error "Clipboardに画像がありません"))
(unwind-protect
(let* ((mime "image/png")
(name (file-name-nondirectory file))
(size (file-attribute-size
(file-attributes file))))
(when (> size lab-ai-max-attachment-size)
(user-error "Clipboard image is too large: %.1f MB"
(/ size 1024.0 1024.0)))
(push `(("filename" . ,name)
("mime_type" . ,mime)
("data_base64" . ,(lab-ai--file-to-base64 file)))
lab-ai-chat--attachments)
(goto-char (point-max))
(insert (format "\n[Attached clipboard image: %s]\n" name))
(lab-ai-chat-update-mode-line)
(message "Lab-AI: attached clipboard image %s" name))
(when (file-exists-p file)
(delete-file file)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; region helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lab-ai--bounds ()
(if (use-region-p)
(cons (region-beginning)
(region-end))
(save-excursion
(let (b e)
(backward-paragraph)
(setq b (point))
(forward-paragraph)
(setq e (point))
(cons b e)))))
(defun lab-ai--replace-region (beg end text)
(delete-region beg end)
(goto-char beg)
(insert text))
(defun lab-ai--dwim (system user)
(let* ((bnds (lab-ai--bounds))
(beg (copy-marker (car bnds)))
(end (copy-marker (cdr bnds) t))
(origin-buffer (current-buffer))
(txt (buffer-substring-no-properties beg end))
(prompt
(concat system "\n\n"
user "\n\n"
txt)))
(message "Lab-AI: sending request... model=%s" lab-ai-model)
(lab-ai-request-async
prompt
(lambda (answer)
(when (buffer-live-p origin-buffer)
(with-current-buffer origin-buffer
(save-excursion
(lab-ai--replace-region beg end answer))
(message "Lab-AI: done. model=%s" lab-ai-model))))
(lambda (err)
(message "Lab-AI: error: %s"
(error-message-string err))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; translation/editing commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lab-ai--japanese-p (text)
"Return non-nil if TEXT contains Japanese characters."
(string-match-p "[ぁ-んァ-ン一-龥]" text))
(defun lab-ai-translate-dwim ()
"Translate region automatically."
(interactive)
(let* ((bnds (lab-ai--bounds))
(txt (buffer-substring-no-properties
(car bnds)
(cdr bnds))))
(cond
((string-empty-p (string-trim txt))
(user-error "No text"))
((lab-ai--japanese-p txt)
(message "Lab-AI: JA -> EN")
(lab-ai-ja->en-academic))
(t
(message "Lab-AI: EN -> JA")
(lab-ai-en->ja)))))
(defun lab-ai--dwim (system user)
(let* ((bnds (lab-ai--bounds))
(beg (copy-marker (car bnds)))
(end (copy-marker (cdr bnds) t))
(origin-buffer (current-buffer))
(txt (buffer-substring-no-properties beg end))
(prompt
(concat system "\n\n"
user "\n\n"
txt)))
(message "Lab-AI: sending request... model=%s" lab-ai-model)
(lab-ai-request-async
prompt
(lambda (answer)
(when (buffer-live-p origin-buffer)
(with-current-buffer origin-buffer
(save-excursion
(if buffer-read-only
(progn
(kill-new answer)
(message "Lab-AI: done. Result copied to kill-ring."))
(lab-ai--replace-region beg end answer)
(message "Lab-AI: done. model=%s" lab-ai-model))))))
(lambda (err)
(message "Lab-AI: error: %s"
(error-message-string err))))))
(defun lab-ai-ja->en-academic ()
(interactive)
(lab-ai--dwim
"You are a professional translator specializing in academic writing."
"Translate the following Japanese into natural academic English. Output only the translation. Do not modify LaTeX or mathematics."))
(defun lab-ai-ja->ja-academic ()
(interactive)
(lab-ai--dwim
"あなたは熟練した科学技術文章の校正者です。"
"次の日本語を自然で読みやすい科学技術文章に校正してください。LaTeXと数式は変更しないでください。"))
(defun lab-ai-en->ja ()
(interactive)
(lab-ai--dwim
"あなたは優秀な翻訳者です。"
"次の英語を自然な日本語に翻訳してください。LaTeXと数式は変更しないでください。"))
(defun lab-ai-en->en ()
(interactive)
(lab-ai--dwim
"You are a professional academic editor."
"Polish the following English for clarity and readability. Keep LaTeX and mathematics unchanged."))
(defun lab-ai-python-code ()
(interactive)
(lab-ai--dwim
"You are an expert Python programmer."
"次の説明または未完成コードをもとに、Pythonコードを生成・修正してください。
出力はPythonコードのみ。説明文やMarkdownの```は付けないでください。
既存コードの意図を保ち、必要なら簡潔なコメントを入れてください。
1行はスペースを入れて80文字未満にすることを厳守してください。"))
(defun lab-ai-mail ()
(interactive)
(lab-ai--dwim
"あなたは優秀な秘書です。"
"次のメール文を自然で読みやすく校正してください。"))
(defun lab-ai-bullets->paper-ja ()
(interactive)
(lab-ai--dwim
"あなたは材料科学・計算化学分野の論文執筆に精通した研究者です。"
"次の実験結果またはシミュレーション結果の箇条書きをもとに、科学技術論文の本文として自然な日本語の文章にしてください。
結果を過度に誇張せず、因果関係が不明な点は断定しないでください。
LaTeX、化学式、数式、図表番号は変更しないでください。
出力は本文のみとし、説明や箇条書きは付けないでください。"))
(defun lab-ai-prompt ()
(interactive)
(let ((instruction
(read-string "Prompt: ")))
(lab-ai--dwim
"You are a helpful assistant."
instruction)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; latex preview in lab-ai-chat
;; English/math only version with file cache
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local lab-ai-chat--latex-overlays nil)
(defvar lab-ai-cache-dir
(expand-file-name
"cache/lab-ai"
user-emacs-directory))
(defvar lab-ai-image-dir
(expand-file-name
"images"
lab-ai-cache-dir))
(unless (file-directory-p lab-ai-image-dir)
(make-directory lab-ai-image-dir t))
(defvar lab-ai-chat-latex-preview-dir
(expand-file-name
"latex"
lab-ai-cache-dir))
(unless (file-directory-p lab-ai-chat-latex-preview-dir)
(make-directory lab-ai-chat-latex-preview-dir t))
(defvar lab-ai-chat-latex-preview-dpi 120)
(defvar lab-ai-chat-latex-scale 1.0)
(defun lab-ai-chat--call-process-to-file (program outfile &rest args)
"Run PROGRAM with ARGS and save output to OUTFILE without leaving buffers."
(with-temp-buffer
(let ((status
(apply #'call-process
program nil (current-buffer) nil args)))
(write-region (point-min) (point-max) outfile nil 'silent)
status)))
(defun lab-ai-chat-clear-latex-preview ()
(interactive)
(mapc #'delete-overlay lab-ai-chat--latex-overlays)
(setq lab-ai-chat--latex-overlays nil)
(message "Lab-AI: latex previews cleared"))
(defun lab-ai-chat-clear-latex-cache ()
(interactive)
(when (file-directory-p lab-ai-chat-latex-preview-dir)
(delete-directory lab-ai-chat-latex-preview-dir t))
(make-directory lab-ai-chat-latex-preview-dir t)
(message "Lab-AI: latex cache cleared"))
(defun lab-ai-chat--latex-cache-key (latex)
(secure-hash
'sha1
(format "%s\nDPI=%s"
latex
lab-ai-chat-latex-preview-dpi)))
(defun lab-ai-chat--latex-to-png (latex)
(let* ((key (lab-ai-chat--latex-cache-key latex))
(png (expand-file-name
(concat key ".png")
lab-ai-chat-latex-preview-dir)))
(if (file-exists-p png)
png
(let* ((dir (expand-file-name
key
lab-ai-chat-latex-preview-dir))
(_dummy (make-directory dir t))
(tex (expand-file-name "eq.tex" dir))
(dvi (expand-file-name "eq.dvi" dir))
(log (expand-file-name "latex.log" dir))
(dvipng-log (expand-file-name "dvipng.log" dir))
(default-directory dir))
(with-temp-file tex
(insert
"\\documentclass{article}\n"
"\\usepackage[paperwidth=16cm,paperheight=3cm,margin=2mm]{geometry}\n"
"\\usepackage{amsmath,amssymb}\n"
"\\usepackage[version=4]{mhchem}\n"
"\\usepackage{xcolor}\n"
"\\pagestyle{empty}\n"
"\\begin{document}\n"
"\\color{white}\n"
latex
"\n\\end{document}\n"))
(unless (= 0
(lab-ai-chat--call-process-to-file
"latex" log
"-interaction=nonstopmode"
"eq.tex"))
(error "latex failed. See %s" log))
(unless (file-exists-p dvi)
(error "DVI was not generated. See %s" log))
(unless (= 0
(lab-ai-chat--call-process-to-file
"dvipng" dvipng-log
"-T" "tight"
"-D" (number-to-string
lab-ai-chat-latex-preview-dpi)
"-bg" "Transparent"
"-fg" "White"
"-o" png
dvi))
(error "dvipng failed. See %s" dvipng-log))
(unless (file-exists-p png)
(error "PNG was not generated. See %s" dvipng-log))
png))))
(defun lab-ai-chat--preview-region (beg end latex)
(condition-case err
(let* ((png (lab-ai-chat--latex-to-png latex))
(img (create-image
png 'png nil
:scale lab-ai-chat-latex-scale
:ascent 'center))
(ov (make-overlay beg end)))
(overlay-put ov 'display img)
(overlay-put ov 'lab-ai-latex-preview t)
(push ov lab-ai-chat--latex-overlays))
(error
(message "Lab-AI latex preview error: %s"
(error-message-string err)))))
(defun lab-ai-chat--preview-display-math ()
;; \[ ... \]
(goto-char (point-min))
(while (search-forward "\\[" nil t)
(let ((beg (match-beginning 0)))
(when (search-forward "\\]" nil t)
(let ((end (match-end 0)))
(lab-ai-chat--preview-region
beg end
(buffer-substring-no-properties beg end)))))))
(defun lab-ai-chat-preview-latex ()
"Preview LaTeX equations in *Lab-AI* buffer.
Run again to clear previews."
(interactive)
(if lab-ai-chat--latex-overlays
(lab-ai-chat-clear-latex-preview)
(save-excursion
;; \[ ... \]
(lab-ai-chat--preview-display-math)
;; $$ ... $$
(goto-char (point-min))
(while (re-search-forward
"\\$\\$\\(.\\|\n\\)*?\\$\\$"
nil t)
(lab-ai-chat--preview-region
(match-beginning 0)
(match-end 0)
(match-string-no-properties 0)))
;; \( ... \)
(goto-char (point-min))
(while (re-search-forward
"\\\\(\\(.\\|\n\\)*?\\\\)"
nil t)
(lab-ai-chat--preview-region
(match-beginning 0)
(match-end 0)
(match-string-no-properties 0))))
(message "Lab-AI: latex previews created")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; chat mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar lab-ai-chat-buffer "*Lab-AI*")
(defvar-local lab-ai-chat--busy nil)
(defvar-local lab-ai-chat--timer nil)
(defvar-local lab-ai-chat--start-time nil)
(defvar-local lab-ai-chat--status-marker nil)
(defvar-local lab-ai-chat-mode-line "")
(defvar-local lab-ai-chat--attachments nil)
(defvar-local lab-ai-chat--messages nil)
(defvar lab-ai-chat-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c")
#'lab-ai-chat-send)
(define-key map (kbd "C-c C-a")
#'lab-ai-chat-attach-file)
(define-key map (kbd "C-c C-v")
#'lab-ai-chat-attach-clipboard-image)
(define-key map (kbd "C-c C-l")
#'lab-ai-chat-preview-latex)
(define-key map (kbd "C-c C-k")
#'lab-ai-chat-clear-attachments)
(define-key map (kbd "C-c C-h")
#'lab-ai-chat-clear-history)
map))
(defun lab-ai-chat--format-time (sec)
(if (< sec 60)
(format "%ds" sec)
(format "%d:%02d" (/ sec 60) (% sec 60))))
(defun lab-ai-chat--attachment-count ()
(length lab-ai-chat--attachments))
(defun lab-ai-chat--add-message (role content)
(setq lab-ai-chat--messages
(append lab-ai-chat--messages
(list `((role . ,role)
(content . ,content))))))
(defun lab-ai-chat--make-history-prompt (current-prompt)
(let* ((msgs
(last lab-ai-chat--messages
lab-ai-chat-history-max-messages))
(history
(mapconcat
(lambda (m)
(format "%s:\n%s"
(cdr (assoc 'role m))
(cdr (assoc 'content m))))
msgs
"\n\n")))
(if (string-empty-p history)
current-prompt
(concat
"以下はこれまでの会話履歴です。"
"文脈を踏まえて最後のUserに答えてください。\n\n"
history
"\n\nUser:\n"
current-prompt))))
(defun lab-ai-chat--current-input ()
(save-excursion
(goto-char (point-max))
(unless (re-search-backward "^You:[ \t]*$" nil t)
(user-error "No You: prompt found"))
(forward-line 1)
(string-trim
(buffer-substring-no-properties
(point)
(point-max)))))
(defun lab-ai-chat-clear-history ()
(interactive)
(setq lab-ai-chat--messages nil)
(message "Lab-AI: chat history cleared"))
(defun lab-ai-chat-update-mode-line ()
(setq lab-ai-chat-mode-line
(let ((att (lab-ai-chat--attachment-count))
(hist (length lab-ai-chat--messages)))
(cond
((and lab-ai-chat--busy
(numberp lab-ai-chat--start-time))
(format " LabAI[%s] ⏳ %s Attach:%d Hist:%d"
lab-ai-model
(lab-ai-chat--format-time
(truncate
(- (float-time)
lab-ai-chat--start-time)))
att hist))
(t
(format " LabAI[%s] Attach:%d Hist:%d"
lab-ai-model att hist)))))
(force-mode-line-update))
(define-derived-mode lab-ai-chat-mode
text-mode
"Lab-AI"
"Simple chat buffer for Lab-AI."
(setq-local mode-line-format
(append mode-line-format
'((:eval lab-ai-chat-mode-line))))
(lab-ai-chat-update-mode-line))
(defun lab-ai-chat-attach-file ()
(interactive)
(let* ((file (read-file-name "Attach image/PDF: "))
(mime (lab-ai--guess-mime-type file))
(name (file-name-nondirectory file))
(size (file-attribute-size
(file-attributes file))))
(unless (or (string-prefix-p "image/" mime)
(string= mime "application/pdf"))
(user-error "Unsupported file type: %s" mime))
(when (> size lab-ai-max-attachment-size)
(user-error "File is too large: %.1f MB"
(/ size 1024.0 1024.0)))
(push `(("filename" . ,name)
("mime_type" . ,mime)
("data_base64" . ,(lab-ai--file-to-base64 file)))
lab-ai-chat--attachments)
(goto-char (point-max))
(insert (format "\n[Attached file: %s (%s)]\n" name mime))
(lab-ai-chat-update-mode-line)
(message "Lab-AI: attached file %s" name)))
(defun lab-ai-chat-clear-attachments ()
(interactive)
(setq lab-ai-chat--attachments nil)
(lab-ai-chat-update-mode-line)
(message "Lab-AI: attachments cleared"))
(defun lab-ai-chat-update-status (buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and lab-ai-chat--busy
lab-ai-chat--status-marker
lab-ai-chat--start-time)
(let* ((sec
(truncate
(- (float-time)
lab-ai-chat--start-time)))
(text
(format "⏳ %s %s"
lab-ai-model
(lab-ai-chat--format-time sec))))
(save-excursion
(goto-char lab-ai-chat--status-marker)
(delete-region
(line-beginning-position)
(line-end-position))
(insert text))
(lab-ai-chat-update-mode-line))))))
(defun lab-ai-chat--start-timer ()
(setq lab-ai-chat--start-time (float-time))
(setq lab-ai-chat--status-marker
(copy-marker
(save-excursion
(forward-line -1)
(line-beginning-position))))
(lab-ai-chat-update-mode-line)
(setq lab-ai-chat--timer
(run-at-time
1 1
#'lab-ai-chat-update-status
(current-buffer))))
(defun lab-ai-chat--stop-timer ()
(when lab-ai-chat--timer
(cancel-timer lab-ai-chat--timer)
(setq lab-ai-chat--timer nil))
(setq lab-ai-chat--start-time nil)
(lab-ai-chat-update-mode-line))
(defun lab-ai-chat ()
(interactive)
(switch-to-buffer
(get-buffer-create
lab-ai-chat-buffer))
(unless (derived-mode-p
'lab-ai-chat-mode)
(lab-ai-chat-mode))
(lab-ai-chat-update-mode-line)
(goto-char (point-max))
(when (= (point-max) 1)
(insert
(format "Lab-AI Chat (%s)\n\n" lab-ai-model))
(insert "[Chat]\n")
(insert "C-c C-c Send prompt\n")
(insert "C-c C-a Attach image/PDF file\n")
(insert "C-c C-v Attach clipboard image\n")
(insert "C-c C-k Clear attachments\n")
(insert "C-c C-h Clear history\n")
(insert "C-c C-m Switch model\n")
(insert "C-c C-l Toggle LaTeX preview\n\n")
(insert "[Image Generation]\n")
(insert "M-x lab-ai-image\n\n")
(insert "[Image Editing]\n")
(insert "M-x lab-ai-image-edit\n\n")
(insert "You:\n")))
(defun lab-ai-chat-send ()
(interactive)
(when lab-ai-chat--busy
(user-error "Lab-AI is already running"))
(let* ((chat-buffer (current-buffer))
(user-prompt (lab-ai-chat--current-input))
(prompt (lab-ai-chat--make-history-prompt user-prompt))
(attachments (reverse lab-ai-chat--attachments)))
(when (string-empty-p user-prompt)
(user-error "Prompt is empty"))
(setq lab-ai-chat--busy t)
(goto-char (point-max))
(insert "\n\n⏳ ")
(insert lab-ai-model)
(insert " 0s")
(when attachments
(insert
(format " / attachments=%d"
(length attachments))))
(insert "\n")
(lab-ai-chat--start-timer)
(lab-ai-chat-update-mode-line)
(message "Lab-AI: sending request... model=%s chars=%d attachments=%d history=%d"
lab-ai-model
(length user-prompt)
(length attachments)
(length lab-ai-chat--messages))
(lab-ai-request-async
prompt
(lambda (answer)
(when (buffer-live-p chat-buffer)
(with-current-buffer chat-buffer
(lab-ai-chat--stop-timer)
(setq lab-ai-chat--busy nil)
(setq lab-ai-chat--attachments nil)
(lab-ai-chat--add-message "User" user-prompt)
(lab-ai-chat--add-message "Assistant" answer)
(lab-ai-chat-update-mode-line)
(goto-char (point-max))
(insert "\nAssistant:\n")
(insert answer)
(insert "\n\nYou:\n")
(message "Lab-AI: done. model=%s history=%d"
lab-ai-model
(length lab-ai-chat--messages)))))
(lambda (err)
(when (buffer-live-p chat-buffer)
(with-current-buffer chat-buffer
(lab-ai-chat--stop-timer)
(setq lab-ai-chat--busy nil)
(setq lab-ai-chat--attachments nil)
(lab-ai-chat-update-mode-line)
(goto-char (point-max))
(insert
(format "\n--- error: %s ---\n"
(error-message-string err)))))
(message "Lab-AI: error: %s"
(error-message-string err)))
lab-ai-model
attachments)))
(defun lab-ai--parse-image-response-buffer (buf)
(with-current-buffer buf
(goto-char (point-min))
(let* ((json-object-type 'alist)
(json-response (json-read))
(image-base64 (cdr (assoc 'image_base64 json-response)))
(detail (cdr (assoc 'detail json-response))))
(cond
(image-base64 image-base64)
(detail
(error "lab-ai image error: %s" detail))
(t
(error "Invalid image response: %s"
(buffer-string)))))))
(defun lab-ai-image-request-async
(url payload on-success &optional on-error)
(let* ((token (lab-ai-read-token))
(payload-json (json-encode payload))
(payload-bytes
(encode-coding-string payload-json 'utf-8-unix))
(buf (generate-new-buffer " *lab-ai-image-curl*"))
proc)
(setq proc
(make-process
:name "lab-ai-image-curl"
:buffer buf
:connection-type 'pipe
:command
(list "curl"
"-sS"
"-f"
"--max-time" lab-ai-timeout
"-X" "POST"
url
"-H" "Content-Type: application/json; charset=utf-8"
"-H" (concat "Authorization: Bearer " token)
"--data-binary" "@-")
:noquery t
:sentinel
(lambda (proc _event)
(when (memq (process-status proc) '(exit signal))
(let ((buf (process-buffer proc)))
(unwind-protect
(condition-case err
(if (= (process-exit-status proc) 0)
(funcall
on-success
(lab-ai--parse-image-response-buffer buf))
(with-current-buffer buf
(error "curl failed (%s): %s"
(process-exit-status proc)
(buffer-string))))
(error
(if on-error
(funcall on-error err)
(message "Lab-AI image: error: %s"
(error-message-string err)))))
(when (buffer-live-p buf)
(kill-buffer buf))))))))
(set-process-coding-system proc 'utf-8-unix 'binary)
(process-send-string proc payload-bytes)
(process-send-eof proc)
proc))
(defun lab-ai--save-image-base64 (image-base64)
(unless (file-directory-p lab-ai-image-dir)
(make-directory lab-ai-image-dir t))
(let ((file
(expand-file-name
(format-time-string "lab-ai-image-%Y%m%d-%H%M%S.png")
lab-ai-image-dir)))
(with-temp-buffer
(set-buffer-multibyte nil)
(insert image-base64)
(base64-decode-region (point-min) (point-max))
(write-region (point-min) (point-max) file nil 'silent))
file))
(defun lab-ai--open-image-file (file)
(find-file file)
(image-mode)
(message "Lab-AI image saved: %s" file))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lab-ai-image ()
"Generate an image using Lab-AI Gateway."
(interactive)
(let ((prompt (read-string "Image prompt: ")))
(when (string-empty-p (string-trim prompt))
(user-error "Prompt is empty"))
(message "Lab-AI image: generating...")
(lab-ai-image-request-async
lab-ai-image-url
`(("prompt" . ,prompt)
("size" . ,lab-ai-image-size))
(lambda (image-base64)
(let ((file (lab-ai--save-image-base64 image-base64)))
(lab-ai--open-image-file file)))
(lambda (err)
(message "Lab-AI image: error: %s"
(error-message-string err))))))
(defun lab-ai-image-edit ()
"Edit an image file using Lab-AI Gateway."
(interactive)
(let* ((file (read-file-name "Image file to edit: "))
(mime (lab-ai--guess-mime-type file))
(prompt (read-string "Edit instruction: "))
(name (file-name-nondirectory file)))
(unless (member mime '("image/png" "image/jpeg" "image/webp"))
(user-error "Unsupported image type for editing: %s" mime))
(when (string-empty-p (string-trim prompt))
(user-error "Prompt is empty"))
(message "Lab-AI image-edit: sending %s..." name)
(lab-ai-image-request-async
lab-ai-image-edit-url
`(("prompt" . ,prompt)
("filename" . ,name)
("mime_type" . ,mime)
("data_base64" . ,(lab-ai--file-to-base64 file))
("size" . ,lab-ai-image-size))
(lambda (image-base64)
(let ((out (lab-ai--save-image-base64 image-base64)))
(lab-ai--open-image-file out)))
(lambda (err)
(message "Lab-AI image-edit: error: %s"
(error-message-string err))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; misc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lab-ai-switch-model ()
(interactive)
(setq lab-ai-model
(completing-read
"Model: "
lab-ai-models
nil t
lab-ai-model))
(when (get-buffer lab-ai-chat-buffer)
(with-current-buffer lab-ai-chat-buffer
(lab-ai-chat-update-mode-line)))
(message "lab-ai model => %s" lab-ai-model))
(defun lab-ai-show-model ()
(interactive)
(message "Lab-AI model: %s" lab-ai-model))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keys
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-prefix-command 'lab-ai-map)
(global-unset-key (kbd "C-c r"))
(global-set-key (kbd "C-c r") 'lab-ai-map)
(global-set-key (kbd "C-x t") #'lab-ai-translate-dwim)
(define-key lab-ai-map (kbd "a") #'lab-ai-ja->en-academic)
(define-key lab-ai-map (kbd "j") #'lab-ai-ja->ja-academic)
(define-key lab-ai-map (kbd "e") #'lab-ai-en->en)
(define-key lab-ai-map (kbd "t") #'lab-ai-en->ja)
(define-key lab-ai-map (kbd "m") #'lab-ai-mail)
(define-key lab-ai-map (kbd "i") #'lab-ai-prompt)
(define-key lab-ai-map (kbd "p") #'lab-ai-python-code)
(define-key lab-ai-map (kbd "s") #'lab-ai-switch-model)
(define-key lab-ai-map (kbd "c") #'lab-ai-chat)
(define-key lab-ai-map (kbd "b") #'lab-ai-bullets->paper-ja)
(define-key lab-ai-map (kbd "M") #'lab-ai-show-model)
(define-key lab-ai-map (kbd "g") #'lab-ai-image)
(define-key lab-ai-map (kbd "G") #'lab-ai-image-edit)
(message "lab-ai loaded: model=%s" lab-ai-model)