first commit
This commit is contained in:
+952
@@ -0,0 +1,952 @@
|
|||||||
|
;; -*- 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)
|
||||||
@@ -0,0 +1,174 @@
|
|||||||
|
;;; my-org-pukiwiki.el --- Simple Org to PukiWiki exporter -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
(require 'subr-x)
|
||||||
|
|
||||||
|
(defgroup my-org-pukiwiki nil
|
||||||
|
"Simple Org to PukiWiki exporter."
|
||||||
|
:group 'tools)
|
||||||
|
|
||||||
|
(defcustom my-org-pukiwiki-coding-system 'japanese-shift-jis
|
||||||
|
"Output coding system."
|
||||||
|
:type 'coding-system
|
||||||
|
:group 'my-org-pukiwiki)
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--metadata-p (line)
|
||||||
|
(string-match-p
|
||||||
|
"^#\\+\\(TITLE\\|AUTHOR\\|OPTIONS\\|DATE\\|EMAIL\\|LANGUAGE\\|KEYWORDS\\):"
|
||||||
|
line))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--heading (line)
|
||||||
|
(if (string-match "^\\(\\*+\\)[ \t]+\\(.*\\)$" line)
|
||||||
|
(let* ((level (length (match-string 1 line)))
|
||||||
|
(title (match-string 2 line)))
|
||||||
|
(cond
|
||||||
|
((= level 1) (concat "* " title))
|
||||||
|
((= level 2) (concat "** " title))
|
||||||
|
((= level 3) (concat "*** " title))
|
||||||
|
(t (concat "'''" title "'''"))))
|
||||||
|
line))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--list (line)
|
||||||
|
(cond
|
||||||
|
((string-match "^[ \t]*-[ \t]+\\(.*\\)$" line)
|
||||||
|
(concat "-" (match-string 1 line)))
|
||||||
|
((string-match "^[ \t]*[0-9]+\\.[ \t]+\\(.*\\)$" line)
|
||||||
|
(concat "+" (match-string 1 line)))
|
||||||
|
(t line)))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--table-separator-p (line)
|
||||||
|
(string-match-p "^[ \t]*|[-+| \t]+|[ \t]*$" line))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--table (line)
|
||||||
|
(cond
|
||||||
|
((my-org-pukiwiki--table-separator-p line)
|
||||||
|
nil)
|
||||||
|
((string-match-p "^[ \t]*|" line)
|
||||||
|
(let ((s (string-trim line)))
|
||||||
|
(setq s (replace-regexp-in-string "=" "" s))
|
||||||
|
(if (string-match-p "|[ \t]*キー[ \t]*|\\|[ \t]*関数[ \t]*|\\|[ \t]*機能[ \t]*|" s)
|
||||||
|
(concat s "h")
|
||||||
|
s)))
|
||||||
|
(t line)))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--inline (line)
|
||||||
|
(setq line
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"=\\([^=\n]+\\)="
|
||||||
|
"''\\1''"
|
||||||
|
line))
|
||||||
|
(setq line
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"~\\([^~\n]+\\)~"
|
||||||
|
"''\\1''"
|
||||||
|
line))
|
||||||
|
line)
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--link (line)
|
||||||
|
;; [[file:foo.png]]
|
||||||
|
(setq line
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"\\[\\[file:\\([^]]+\\)\\]\\]"
|
||||||
|
"#ref(\\1)"
|
||||||
|
line))
|
||||||
|
;; [[https://example.org][label]]
|
||||||
|
(setq line
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"\\[\\[\\([^]]+\\)\\]\\[\\([^]]+\\)\\]\\]"
|
||||||
|
"[[\\2>\\1]]"
|
||||||
|
line))
|
||||||
|
;; [[https://example.org]]
|
||||||
|
(setq line
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"\\[\\[\\(https?://[^]]+\\)\\]\\]"
|
||||||
|
"[[\\1]]"
|
||||||
|
line))
|
||||||
|
line)
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki--sjis-safe (text)
|
||||||
|
(let ((s text))
|
||||||
|
(setq s (replace-regexp-in-string "–\\|—\\|―" "--" s))
|
||||||
|
(setq s (replace-regexp-in-string "“\\|”" "\"" s))
|
||||||
|
(setq s (replace-regexp-in-string "‘\\|’" "'" s))
|
||||||
|
(setq s (replace-regexp-in-string "…" "..." s))
|
||||||
|
(setq s (replace-regexp-in-string "⏳" "Busy" s))
|
||||||
|
(setq s (replace-regexp-in-string "→" "->" s))
|
||||||
|
(setq s (replace-regexp-in-string "←" "<-" s))
|
||||||
|
(setq s (replace-regexp-in-string "⇒" "=>" s))
|
||||||
|
(setq s (replace-regexp-in-string "├──" "+-" s))
|
||||||
|
(setq s (replace-regexp-in-string "└──" "+-" s))
|
||||||
|
(setq s (replace-regexp-in-string "│" "|" s))
|
||||||
|
s))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki-convert-string (text)
|
||||||
|
"Convert Org TEXT to PukiWiki text."
|
||||||
|
(let ((lines (split-string text "\n"))
|
||||||
|
(out nil)
|
||||||
|
(in-block nil))
|
||||||
|
(dolist (line lines)
|
||||||
|
(cond
|
||||||
|
;; src/example block start
|
||||||
|
((string-match-p "^#\\+begin_\\(src\\|example\\)" line)
|
||||||
|
(setq in-block t))
|
||||||
|
|
||||||
|
;; src/example block end
|
||||||
|
((string-match-p "^#\\+end_\\(src\\|example\\)" line)
|
||||||
|
(setq in-block nil))
|
||||||
|
|
||||||
|
;; preformatted block: leading half-width space
|
||||||
|
(in-block
|
||||||
|
(push (concat " " line) out))
|
||||||
|
|
||||||
|
;; skip Org metadata
|
||||||
|
((my-org-pukiwiki--metadata-p line)
|
||||||
|
nil)
|
||||||
|
|
||||||
|
;; skip caption/name lines
|
||||||
|
((string-match-p "^#\\+\\(CAPTION\\|NAME\\):" line)
|
||||||
|
nil)
|
||||||
|
|
||||||
|
;; normal line
|
||||||
|
(t
|
||||||
|
(setq line (my-org-pukiwiki--heading line))
|
||||||
|
(setq line (my-org-pukiwiki--list line))
|
||||||
|
(setq line (my-org-pukiwiki--table line))
|
||||||
|
(when line
|
||||||
|
(setq line (my-org-pukiwiki--inline line))
|
||||||
|
(setq line (my-org-pukiwiki--link line))
|
||||||
|
(push line out)))))
|
||||||
|
(my-org-pukiwiki--sjis-safe
|
||||||
|
(string-join (nreverse out) "\n"))))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki-export-buffer ()
|
||||||
|
"Convert current Org buffer and show result in *PukiWiki*."
|
||||||
|
(interactive)
|
||||||
|
(let ((text (my-org-pukiwiki-convert-string (buffer-string))))
|
||||||
|
(with-current-buffer (get-buffer-create "*PukiWiki*")
|
||||||
|
(erase-buffer)
|
||||||
|
(insert text)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(pop-to-buffer (current-buffer)))))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki-export-file (&optional file)
|
||||||
|
"Export current Org buffer to a Shift-JIS PukiWiki file."
|
||||||
|
(interactive)
|
||||||
|
(let* ((src (buffer-file-name))
|
||||||
|
(dst (or file
|
||||||
|
(if src
|
||||||
|
(concat (file-name-sans-extension src) ".pukiwiki")
|
||||||
|
"output.pukiwiki")))
|
||||||
|
(text (my-org-pukiwiki-convert-string (buffer-string)))
|
||||||
|
(coding-system-for-write my-org-pukiwiki-coding-system))
|
||||||
|
(with-temp-file dst
|
||||||
|
(insert text))
|
||||||
|
(message "Exported PukiWiki: %s" dst)))
|
||||||
|
|
||||||
|
(defun my-org-pukiwiki-copy-to-clipboard ()
|
||||||
|
"Convert current Org buffer to PukiWiki text and copy it to kill-ring."
|
||||||
|
(interactive)
|
||||||
|
(let ((text (my-org-pukiwiki-convert-string (buffer-string))))
|
||||||
|
(kill-new text)
|
||||||
|
(message "Copied PukiWiki text to clipboard")))
|
||||||
|
|
||||||
|
(provide 'my-org-pukiwiki)
|
||||||
|
|
||||||
|
;;; my-org-pukiwiki.el ends here
|
||||||
@@ -0,0 +1,242 @@
|
|||||||
|
;;; my-org-unfill-aware.el --- Org-aware hard line break remover -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Author: Takahiro Ohkubo / ChatGPT
|
||||||
|
;; Version: 0.1
|
||||||
|
;; Keywords: org, text, clipboard
|
||||||
|
;;
|
||||||
|
;; This file provides Org-aware functions to remove hard line breaks
|
||||||
|
;; from normal paragraphs while preserving Org structures such as
|
||||||
|
;; headings, lists, tables, source/example/export blocks, drawers,
|
||||||
|
;; comments, horizontal rules, and display math lines.
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'subr-x)
|
||||||
|
|
||||||
|
(defgroup my-org-unfill-aware nil
|
||||||
|
"Org-aware hard line break removal."
|
||||||
|
:group 'org
|
||||||
|
:prefix "my-org-unfill-aware-")
|
||||||
|
|
||||||
|
(defcustom my-org-unfill-aware-preserve-list-items t
|
||||||
|
"If non-nil, preserve list item lines as structural lines.
|
||||||
|
Continuation lines after a list item are still treated as normal paragraph
|
||||||
|
text unless they also match a preserved Org structure."
|
||||||
|
:type 'boolean
|
||||||
|
:group 'my-org-unfill-aware)
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--region-or-buffer ()
|
||||||
|
"Return region bounds if active, otherwise whole buffer bounds."
|
||||||
|
(if (use-region-p)
|
||||||
|
(list (region-beginning) (region-end))
|
||||||
|
(list (point-min) (point-max))))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--japanese-p (text)
|
||||||
|
"Return non-nil if TEXT contains Japanese/CJK characters."
|
||||||
|
(string-match-p "[ぁ-んァ-ン一-龯々〆〤ー]" text))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--ascii-normalize-space (s)
|
||||||
|
"Normalize whitespace in ASCII paragraph S."
|
||||||
|
(string-trim
|
||||||
|
(replace-regexp-in-string "[ \t\n]+" " " s)))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--join-lines (lines joiner ascii-p)
|
||||||
|
"Join paragraph LINES using JOINER.
|
||||||
|
If ASCII-P is non-nil, normalize multiple spaces into one."
|
||||||
|
(let ((s (mapconcat #'string-trim lines joiner)))
|
||||||
|
(if ascii-p
|
||||||
|
(my-org-unfill-aware--ascii-normalize-space s)
|
||||||
|
(string-trim s))))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--blank-line-p (line)
|
||||||
|
"Return non-nil if LINE is blank."
|
||||||
|
(string-match-p "\\`[ \t]*\\'" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--heading-p (line)
|
||||||
|
"Return non-nil if LINE is an Org heading."
|
||||||
|
(string-match-p "\\`[ \t]*\\*+\\s-+" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--keyword-p (line)
|
||||||
|
"Return non-nil if LINE is an Org keyword line."
|
||||||
|
(string-match-p "\\`[ \t]*#\\+[-A-Za-z0-9_]+:" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--comment-p (line)
|
||||||
|
"Return non-nil if LINE is an Org comment line."
|
||||||
|
(string-match-p "\\`[ \t]*#\\($\\|[^+]\\)" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--table-p (line)
|
||||||
|
"Return non-nil if LINE is an Org table line."
|
||||||
|
(string-match-p "\\`[ \t]*|" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--hline-p (line)
|
||||||
|
"Return non-nil if LINE is an Org horizontal rule."
|
||||||
|
(string-match-p "\\`[ \t]*-----+[ \t]*\\'" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--drawer-begin-p (line)
|
||||||
|
"Return non-nil if LINE begins an Org drawer."
|
||||||
|
(string-match-p "\\`[ \t]*:[A-Za-z0-9_-]+:[ \t]*\\'" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--drawer-end-p (line)
|
||||||
|
"Return non-nil if LINE ends an Org drawer."
|
||||||
|
(string-match-p "\\`[ \t]*:END:[ \t]*\\'" line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--list-item-p (line)
|
||||||
|
"Return non-nil if LINE looks like an Org list item."
|
||||||
|
(and my-org-unfill-aware-preserve-list-items
|
||||||
|
(string-match-p
|
||||||
|
"\\`[ \t]*\\(?:[-+]\\|[0-9]+[.)]\\|[A-Za-z][.)]\\)\\s-+"
|
||||||
|
line)))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--display-math-p (line)
|
||||||
|
"Return non-nil if LINE looks like display math delimiter/content."
|
||||||
|
(string-match-p
|
||||||
|
"\\`[ \t]*\\(?:\\\\\\[\\|\\\\\\]\\|\\\\begin{\\|\\\\end{\\|\\$\\$\\)"
|
||||||
|
line))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--block-begin-p (line)
|
||||||
|
"Return non-nil if LINE begins an Org block."
|
||||||
|
(string-match-p "\\`[ \t]*#\\+BEGIN_" (upcase line)))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--block-end-p (line)
|
||||||
|
"Return non-nil if LINE ends an Org block."
|
||||||
|
(string-match-p "\\`[ \t]*#\\+END_" (upcase line)))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--structural-line-p (line)
|
||||||
|
"Return non-nil if LINE should not be joined with surrounding text."
|
||||||
|
(or (my-org-unfill-aware--blank-line-p line)
|
||||||
|
(my-org-unfill-aware--heading-p line)
|
||||||
|
(my-org-unfill-aware--keyword-p line)
|
||||||
|
(my-org-unfill-aware--comment-p line)
|
||||||
|
(my-org-unfill-aware--table-p line)
|
||||||
|
(my-org-unfill-aware--hline-p line)
|
||||||
|
(my-org-unfill-aware--drawer-begin-p line)
|
||||||
|
(my-org-unfill-aware--drawer-end-p line)
|
||||||
|
(my-org-unfill-aware--list-item-p line)
|
||||||
|
(my-org-unfill-aware--display-math-p line)))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--process-text (text joiner ascii-p)
|
||||||
|
"Return processed TEXT using JOINER.
|
||||||
|
If ASCII-P is non-nil, normalize spaces in joined paragraphs."
|
||||||
|
(let ((lines (split-string text "\n"))
|
||||||
|
(out nil)
|
||||||
|
(para nil)
|
||||||
|
(in-block nil)
|
||||||
|
(in-drawer nil))
|
||||||
|
(cl-labels
|
||||||
|
((flush-para
|
||||||
|
()
|
||||||
|
(when para
|
||||||
|
(push (my-org-unfill-aware--join-lines
|
||||||
|
(nreverse para) joiner ascii-p)
|
||||||
|
out)
|
||||||
|
(setq para nil))))
|
||||||
|
(dolist (line lines)
|
||||||
|
(cond
|
||||||
|
;; Inside source/example/export/special block: preserve literally.
|
||||||
|
(in-block
|
||||||
|
(flush-para)
|
||||||
|
(push line out)
|
||||||
|
(when (my-org-unfill-aware--block-end-p line)
|
||||||
|
(setq in-block nil)))
|
||||||
|
|
||||||
|
;; Inside drawer/properties: preserve literally.
|
||||||
|
(in-drawer
|
||||||
|
(flush-para)
|
||||||
|
(push line out)
|
||||||
|
(when (my-org-unfill-aware--drawer-end-p line)
|
||||||
|
(setq in-drawer nil)))
|
||||||
|
|
||||||
|
;; Begin block.
|
||||||
|
((my-org-unfill-aware--block-begin-p line)
|
||||||
|
(flush-para)
|
||||||
|
(push line out)
|
||||||
|
(setq in-block t))
|
||||||
|
|
||||||
|
;; Begin drawer.
|
||||||
|
((my-org-unfill-aware--drawer-begin-p line)
|
||||||
|
(flush-para)
|
||||||
|
(push line out)
|
||||||
|
(unless (my-org-unfill-aware--drawer-end-p line)
|
||||||
|
(setq in-drawer t)))
|
||||||
|
|
||||||
|
;; Other structural line.
|
||||||
|
((my-org-unfill-aware--structural-line-p line)
|
||||||
|
(flush-para)
|
||||||
|
(push line out))
|
||||||
|
|
||||||
|
;; Normal paragraph line.
|
||||||
|
(t
|
||||||
|
(push line para))))
|
||||||
|
(flush-para))
|
||||||
|
(mapconcat #'identity (nreverse out) "\n")))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--replace-region (beg end joiner ascii-p)
|
||||||
|
"Replace region BEG END with Org-aware unfilled text."
|
||||||
|
(let ((new-text
|
||||||
|
(my-org-unfill-aware--process-text
|
||||||
|
(buffer-substring-no-properties beg end)
|
||||||
|
joiner ascii-p)))
|
||||||
|
(delete-region beg end)
|
||||||
|
(insert new-text)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun my-org-unfill-aware-ascii (beg end)
|
||||||
|
"Org-aware ASCII mode.
|
||||||
|
Remove hard line breaks in normal paragraphs by replacing them with one space.
|
||||||
|
Org structures are preserved."
|
||||||
|
(interactive (my-org-unfill-aware--region-or-buffer))
|
||||||
|
(my-org-unfill-aware--replace-region beg end " " t))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun my-org-unfill-aware-japanese (beg end)
|
||||||
|
"Org-aware Japanese mode.
|
||||||
|
Remove hard line breaks in normal paragraphs without inserting spaces.
|
||||||
|
Org structures are preserved."
|
||||||
|
(interactive (my-org-unfill-aware--region-or-buffer))
|
||||||
|
(my-org-unfill-aware--replace-region beg end "" nil))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun my-org-unfill-aware-auto (beg end)
|
||||||
|
"Org-aware auto mode.
|
||||||
|
If the selected text contains Japanese/CJK characters, use Japanese mode.
|
||||||
|
Otherwise use ASCII mode."
|
||||||
|
(interactive (my-org-unfill-aware--region-or-buffer))
|
||||||
|
(let ((text (buffer-substring-no-properties beg end)))
|
||||||
|
(if (my-org-unfill-aware--japanese-p text)
|
||||||
|
(my-org-unfill-aware-japanese beg end)
|
||||||
|
(my-org-unfill-aware-ascii beg end))))
|
||||||
|
|
||||||
|
(defun my-org-unfill-aware--copy-only (beg end fn)
|
||||||
|
"Copy processed text from BEG END using FN without modifying current buffer."
|
||||||
|
(let* ((text (buffer-substring-no-properties beg end))
|
||||||
|
(buf (generate-new-buffer " *my-org-unfill-aware-copy*")))
|
||||||
|
(unwind-protect
|
||||||
|
(with-current-buffer buf
|
||||||
|
(insert text)
|
||||||
|
(funcall fn (point-min) (point-max))
|
||||||
|
(kill-new (buffer-string)))
|
||||||
|
(kill-buffer buf))
|
||||||
|
(message "Org-aware unfilled text copied to kill-ring.")))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun my-org-unfill-aware-ascii-copy (beg end)
|
||||||
|
"Org-aware ASCII mode, copy only.
|
||||||
|
Do not modify current buffer."
|
||||||
|
(interactive (my-org-unfill-aware--region-or-buffer))
|
||||||
|
(my-org-unfill-aware--copy-only beg end #'my-org-unfill-aware-ascii))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun my-org-unfill-aware-japanese-copy (beg end)
|
||||||
|
"Org-aware Japanese mode, copy only.
|
||||||
|
Do not modify current buffer."
|
||||||
|
(interactive (my-org-unfill-aware--region-or-buffer))
|
||||||
|
(my-org-unfill-aware--copy-only beg end #'my-org-unfill-aware-japanese))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun my-org-unfill-aware-auto-copy (beg end)
|
||||||
|
"Org-aware auto mode, copy only.
|
||||||
|
Do not modify current buffer."
|
||||||
|
(interactive (my-org-unfill-aware--region-or-buffer))
|
||||||
|
(my-org-unfill-aware--copy-only beg end #'my-org-unfill-aware-auto))
|
||||||
|
|
||||||
|
(provide 'my-org-unfill-aware)
|
||||||
|
;;; my-org-unfill-aware.el ends here
|
||||||
+206
@@ -0,0 +1,206 @@
|
|||||||
|
;;; my-qrcode.el --- QR Code Viewer -*- lexical-binding:t; -*-
|
||||||
|
|
||||||
|
(require 'image-mode)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; configuration
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defvar my-qrcode-buffer-name "*QR Code*")
|
||||||
|
|
||||||
|
(defcustom my-qrcode-frame-pixel-size 500
|
||||||
|
"QR frame size in pixels."
|
||||||
|
:type 'integer)
|
||||||
|
|
||||||
|
(defcustom my-qrcode-frame-left 100
|
||||||
|
"QR frame left position."
|
||||||
|
:type 'integer)
|
||||||
|
|
||||||
|
(defcustom my-qrcode-frame-top 100
|
||||||
|
"QR frame top position."
|
||||||
|
:type 'integer)
|
||||||
|
|
||||||
|
(defvar-local my-qrcode-image-file nil)
|
||||||
|
(defvar-local my-qrcode-scale 1.0)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; redraw
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defun my-qrcode-redraw ()
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(unless my-qrcode-image-file
|
||||||
|
(error "No QR image"))
|
||||||
|
|
||||||
|
(let ((inhibit-read-only t))
|
||||||
|
(erase-buffer)
|
||||||
|
|
||||||
|
(insert-image
|
||||||
|
(create-image
|
||||||
|
my-qrcode-image-file
|
||||||
|
'png
|
||||||
|
nil
|
||||||
|
:scale my-qrcode-scale))
|
||||||
|
|
||||||
|
(goto-char (point-min))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; zoom
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defun my-qrcode-zoom-in ()
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(setq my-qrcode-scale
|
||||||
|
(* my-qrcode-scale 1.25))
|
||||||
|
|
||||||
|
(my-qrcode-redraw)
|
||||||
|
|
||||||
|
(message "QR scale %.2f"
|
||||||
|
my-qrcode-scale))
|
||||||
|
|
||||||
|
(defun my-qrcode-zoom-out ()
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(setq my-qrcode-scale
|
||||||
|
(/ my-qrcode-scale 1.25))
|
||||||
|
|
||||||
|
(my-qrcode-redraw)
|
||||||
|
|
||||||
|
(message "QR scale %.2f"
|
||||||
|
my-qrcode-scale))
|
||||||
|
|
||||||
|
(defun my-qrcode-zoom-reset ()
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(setq my-qrcode-scale 1.0)
|
||||||
|
|
||||||
|
(my-qrcode-redraw)
|
||||||
|
|
||||||
|
(message "QR scale reset"))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; mode
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defvar my-qrcode-mode-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
|
||||||
|
(define-key map (kbd "+")
|
||||||
|
#'my-qrcode-zoom-in)
|
||||||
|
|
||||||
|
(define-key map (kbd "=")
|
||||||
|
#'my-qrcode-zoom-in)
|
||||||
|
|
||||||
|
(define-key map (kbd "-")
|
||||||
|
#'my-qrcode-zoom-out)
|
||||||
|
|
||||||
|
(define-key map (kbd "0")
|
||||||
|
#'my-qrcode-zoom-reset)
|
||||||
|
|
||||||
|
(define-key map (kbd "q")
|
||||||
|
#'quit-window)
|
||||||
|
|
||||||
|
map))
|
||||||
|
|
||||||
|
(define-derived-mode my-qrcode-mode
|
||||||
|
special-mode
|
||||||
|
"QRCode"
|
||||||
|
"QR Code Viewer")
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; region -> qrcode
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defun my-qrcode-from-region (beg end)
|
||||||
|
"Convert region text to QR code."
|
||||||
|
|
||||||
|
(interactive "r")
|
||||||
|
|
||||||
|
(unless (use-region-p)
|
||||||
|
(user-error "Region is not active"))
|
||||||
|
|
||||||
|
(unless (executable-find "qrencode")
|
||||||
|
(user-error "qrencode command not found"))
|
||||||
|
|
||||||
|
(let* ((text
|
||||||
|
(buffer-substring-no-properties beg end))
|
||||||
|
|
||||||
|
(png-file
|
||||||
|
(make-temp-file
|
||||||
|
"qrcode-"
|
||||||
|
nil
|
||||||
|
".png"))
|
||||||
|
|
||||||
|
(coding-system-for-write
|
||||||
|
'utf-8-unix))
|
||||||
|
|
||||||
|
(with-temp-buffer
|
||||||
|
|
||||||
|
(insert text)
|
||||||
|
|
||||||
|
(unless
|
||||||
|
(eq
|
||||||
|
(call-process-region
|
||||||
|
(point-min)
|
||||||
|
(point-max)
|
||||||
|
"qrencode"
|
||||||
|
nil nil nil
|
||||||
|
"-o" png-file
|
||||||
|
"-t" "PNG"
|
||||||
|
"-s" "8"
|
||||||
|
"-m" "2")
|
||||||
|
0)
|
||||||
|
|
||||||
|
(delete-file png-file)
|
||||||
|
|
||||||
|
(error "qrencode failed")))
|
||||||
|
|
||||||
|
(let ((buf
|
||||||
|
(get-buffer-create
|
||||||
|
my-qrcode-buffer-name)))
|
||||||
|
|
||||||
|
(with-current-buffer buf
|
||||||
|
|
||||||
|
(my-qrcode-mode)
|
||||||
|
|
||||||
|
(setq my-qrcode-image-file
|
||||||
|
png-file)
|
||||||
|
|
||||||
|
(setq my-qrcode-scale
|
||||||
|
1.0)
|
||||||
|
|
||||||
|
(my-qrcode-redraw))
|
||||||
|
|
||||||
|
(let ((frame
|
||||||
|
(make-frame
|
||||||
|
`((name . "QR Code")
|
||||||
|
(left . ,my-qrcode-frame-left)
|
||||||
|
(top . ,my-qrcode-frame-top)))))
|
||||||
|
|
||||||
|
;; 正方形サイズ（ピクセル単位）
|
||||||
|
(set-frame-size
|
||||||
|
frame
|
||||||
|
my-qrcode-frame-pixel-size
|
||||||
|
my-qrcode-frame-pixel-size
|
||||||
|
t)
|
||||||
|
|
||||||
|
(set-window-buffer
|
||||||
|
(frame-root-window frame)
|
||||||
|
buf)
|
||||||
|
|
||||||
|
(select-frame-set-input-focus
|
||||||
|
frame)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; key binding example
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; (global-set-key
|
||||||
|
;; (kbd "C-c q")
|
||||||
|
;; #'my-region-to-qrcode)
|
||||||
|
|
||||||
|
(provide 'my-qrcode)
|
||||||
|
|
||||||
|
;;; my-qrcode.el ends here
|
||||||
@@ -0,0 +1,167 @@
|
|||||||
|
\
|
||||||
|
;;; my-replace-zen-to-ascii.el --- Convert fullwidth/superscript/subscript chars to ASCII -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; This library converts selected fullwidth ASCII-like characters,
|
||||||
|
;; Unicode superscript/subscript digits, and common typographic symbols
|
||||||
|
;; into plain ASCII characters.
|
||||||
|
;;
|
||||||
|
;; Main commands:
|
||||||
|
;;
|
||||||
|
;; M-x replace-zen-to-ascii-region
|
||||||
|
;; M-x replace-zen-to-ascii-buffer
|
||||||
|
;; M-x replace-zen-to-ascii-region-copy
|
||||||
|
;; M-x replace-zen-to-ascii-buffer-copy
|
||||||
|
;;
|
||||||
|
;; The original command name `replace-zen-to-ascii-region' is kept
|
||||||
|
;; for compatibility with existing init.el settings.
|
||||||
|
|
||||||
|
(require 'subr-x)
|
||||||
|
|
||||||
|
(defgroup my-replace-zen-to-ascii nil
|
||||||
|
"Convert selected fullwidth and Unicode compatibility characters to ASCII."
|
||||||
|
:group 'editing
|
||||||
|
:prefix "my-replace-zen-to-ascii-")
|
||||||
|
|
||||||
|
(defcustom my-replace-zen-to-ascii-convert-scientific-symbols nil
|
||||||
|
"If non-nil, also convert selected scientific symbols to ASCII.
|
||||||
|
For example, μ/µ -> u, Å/Å -> A, × -> x, ° -> deg.
|
||||||
|
This is disabled by default because these symbols may be meaningful
|
||||||
|
in manuscripts."
|
||||||
|
:type 'boolean
|
||||||
|
:group 'my-replace-zen-to-ascii)
|
||||||
|
|
||||||
|
(defconst my-replace-zen-to-ascii--basic-table
|
||||||
|
'((" " . " ")
|
||||||
|
|
||||||
|
;; Fullwidth digits
|
||||||
|
("０" . "0") ("１" . "1") ("２" . "2") ("３" . "3") ("４" . "4")
|
||||||
|
("５" . "5") ("６" . "6") ("７" . "7") ("８" . "8") ("９" . "9")
|
||||||
|
|
||||||
|
;; Fullwidth uppercase letters
|
||||||
|
("Ａ" . "A") ("Ｂ" . "B") ("Ｃ" . "C") ("Ｄ" . "D") ("Ｅ" . "E")
|
||||||
|
("Ｆ" . "F") ("Ｇ" . "G") ("Ｈ" . "H") ("Ｉ" . "I") ("Ｊ" . "J")
|
||||||
|
("Ｋ" . "K") ("Ｌ" . "L") ("Ｍ" . "M") ("Ｎ" . "N") ("Ｏ" . "O")
|
||||||
|
("Ｐ" . "P") ("Ｑ" . "Q") ("Ｒ" . "R") ("Ｓ" . "S") ("Ｔ" . "T")
|
||||||
|
("Ｕ" . "U") ("Ｖ" . "V") ("Ｗ" . "W") ("Ｘ" . "X") ("Ｙ" . "Y")
|
||||||
|
("Ｚ" . "Z")
|
||||||
|
|
||||||
|
;; Fullwidth lowercase letters
|
||||||
|
("ａ" . "a") ("ｂ" . "b") ("ｃ" . "c") ("ｄ" . "d") ("ｅ" . "e")
|
||||||
|
("ｆ" . "f") ("ｇ" . "g") ("ｈ" . "h") ("ｉ" . "i") ("ｊ" . "j")
|
||||||
|
("ｋ" . "k") ("ｌ" . "l") ("ｍ" . "m") ("ｎ" . "n") ("ｏ" . "o")
|
||||||
|
("ｐ" . "p") ("ｑ" . "q") ("ｒ" . "r") ("ｓ" . "s") ("ｔ" . "t")
|
||||||
|
("ｕ" . "u") ("ｖ" . "v") ("ｗ" . "w") ("ｘ" . "x") ("ｙ" . "y")
|
||||||
|
("ｚ" . "z")
|
||||||
|
|
||||||
|
;; Fullwidth ASCII punctuation
|
||||||
|
("！" . "!") ("＂" . "\"") ("＃" . "#") ("＄" . "$")
|
||||||
|
("％" . "%") ("＆" . "&") ("＇" . "'") ("（" . "(")
|
||||||
|
("）" . ")") ("＊" . "*") ("＋" . "+") ("，" . ",")
|
||||||
|
("－" . "-") ("．" . ".") ("／" . "/") ("：" . ":")
|
||||||
|
("；" . ";") ("＜" . "<") ("＝" . "=") ("＞" . ">")
|
||||||
|
("？" . "?") ("＠" . "@") ("［" . "[") ("＼" . "\\")
|
||||||
|
("］" . "]") ("＾" . "^") ("＿" . "_") ("｀" . "`")
|
||||||
|
("｛" . "{") ("｜" . "|") ("｝" . "}") ("～" . "~")
|
||||||
|
|
||||||
|
;; Curly quotes and common dash/minus variants
|
||||||
|
("“" . "\"") ("”" . "\"")
|
||||||
|
("„" . "\"") ("‟" . "\"")
|
||||||
|
("‘" . "'") ("’" . "'")
|
||||||
|
("‚" . "'") ("‛" . "'")
|
||||||
|
("−" . "-") ("–" . "-") ("—" . "-") ("―" . "-")
|
||||||
|
|
||||||
|
;; Superscript digits
|
||||||
|
("⁰" . "0") ("¹" . "1") ("²" . "2") ("³" . "3") ("⁴" . "4")
|
||||||
|
("⁵" . "5") ("⁶" . "6") ("⁷" . "7") ("⁸" . "8") ("⁹" . "9")
|
||||||
|
|
||||||
|
;; Subscript digits
|
||||||
|
("₀" . "0") ("₁" . "1") ("₂" . "2") ("₃" . "3") ("₄" . "4")
|
||||||
|
("₅" . "5") ("₆" . "6") ("₇" . "7") ("₈" . "8") ("₉" . "9")
|
||||||
|
|
||||||
|
;; Superscript signs and parentheses
|
||||||
|
("⁺" . "+") ("⁻" . "-") ("⁼" . "=")
|
||||||
|
("⁽" . "(") ("⁾" . ")")
|
||||||
|
|
||||||
|
;; Subscript signs and parentheses
|
||||||
|
("₊" . "+") ("₋" . "-") ("₌" . "=")
|
||||||
|
("₍" . "(") ("₎" . ")"))
|
||||||
|
"Basic conversion table.")
|
||||||
|
|
||||||
|
(defconst my-replace-zen-to-ascii--scientific-table
|
||||||
|
'(("μ" . "u")
|
||||||
|
("µ" . "u")
|
||||||
|
("Å" . "A")
|
||||||
|
("Å" . "A")
|
||||||
|
("×" . "x")
|
||||||
|
("°" . " deg"))
|
||||||
|
"Optional scientific-symbol conversion table.")
|
||||||
|
|
||||||
|
(defun my-replace-zen-to-ascii--table ()
|
||||||
|
"Return active conversion table."
|
||||||
|
(if my-replace-zen-to-ascii-convert-scientific-symbols
|
||||||
|
(append my-replace-zen-to-ascii--basic-table
|
||||||
|
my-replace-zen-to-ascii--scientific-table)
|
||||||
|
my-replace-zen-to-ascii--basic-table))
|
||||||
|
|
||||||
|
(defun my-replace-zen-to-ascii--regexp ()
|
||||||
|
"Return regexp for active conversion table."
|
||||||
|
(regexp-opt (mapcar #'car (my-replace-zen-to-ascii--table))))
|
||||||
|
|
||||||
|
(defun my-replace-zen-to-ascii--replace-region (start end)
|
||||||
|
"Convert selected characters in region START END."
|
||||||
|
(let* ((table (my-replace-zen-to-ascii--table))
|
||||||
|
(regexp (regexp-opt (mapcar #'car table))))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char start)
|
||||||
|
(while (re-search-forward regexp end t)
|
||||||
|
(let* ((from (match-string 0))
|
||||||
|
(to (cdr (assoc from table))))
|
||||||
|
(when to
|
||||||
|
(replace-match to t t)))))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun replace-zen-to-ascii-region (start end)
|
||||||
|
"Convert fullwidth ASCII-like and super/subscript characters in region to ASCII."
|
||||||
|
(interactive "r")
|
||||||
|
(my-replace-zen-to-ascii--replace-region start end)
|
||||||
|
(message "Converted selected characters to ASCII."))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun replace-zen-to-ascii-buffer ()
|
||||||
|
"Convert fullwidth ASCII-like and super/subscript characters in the whole buffer."
|
||||||
|
(interactive)
|
||||||
|
(replace-zen-to-ascii-region (point-min) (point-max)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun replace-zen-to-ascii-region-copy (start end)
|
||||||
|
"Copy converted region to kill-ring without modifying current buffer."
|
||||||
|
(interactive "r")
|
||||||
|
(let ((text (buffer-substring-no-properties start end))
|
||||||
|
(buf (generate-new-buffer " *replace-zen-to-ascii-copy*")))
|
||||||
|
(unwind-protect
|
||||||
|
(with-current-buffer buf
|
||||||
|
(insert text)
|
||||||
|
(replace-zen-to-ascii-region (point-min) (point-max))
|
||||||
|
(kill-new (buffer-string)))
|
||||||
|
(kill-buffer buf))
|
||||||
|
(message "Converted text copied to kill-ring.")))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun replace-zen-to-ascii-buffer-copy ()
|
||||||
|
"Copy converted whole buffer to kill-ring without modifying current buffer."
|
||||||
|
(interactive)
|
||||||
|
(replace-zen-to-ascii-region-copy (point-min) (point-max)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun replace-zen-to-ascii-toggle-scientific-symbols ()
|
||||||
|
"Toggle optional scientific-symbol conversion."
|
||||||
|
(interactive)
|
||||||
|
(setq my-replace-zen-to-ascii-convert-scientific-symbols
|
||||||
|
(not my-replace-zen-to-ascii-convert-scientific-symbols))
|
||||||
|
(message "Scientific-symbol conversion: %s"
|
||||||
|
(if my-replace-zen-to-ascii-convert-scientific-symbols
|
||||||
|
"ON"
|
||||||
|
"OFF")))
|
||||||
|
|
||||||
|
(provide 'my-replace-zen-to-ascii)
|
||||||
|
;;; my-replace-zen-to-ascii.el ends here
|
||||||
@@ -0,0 +1,506 @@
|
|||||||
|
;;; my-yatex-review-highlight.el --- Highlight review macros in YaTeX -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Faces
|
||||||
|
;;
|
||||||
|
;; \RA-\RD:
|
||||||
|
;; 第1引数: 文字色 + 背景色 + 太字
|
||||||
|
;; 第2引数: 文字色のみ、背景は変更しない
|
||||||
|
;;
|
||||||
|
;; \TO:
|
||||||
|
;; 第1引数: 赤太字、背景は変更しない
|
||||||
|
;;
|
||||||
|
;; \CA-\CD:
|
||||||
|
;; \CA は \RA と同じ色
|
||||||
|
;; \CB は \RB と同じ色
|
||||||
|
;; \CC は \RC と同じ色
|
||||||
|
;; \CD は \RD と同じ色
|
||||||
|
;;
|
||||||
|
;; {A1} などのラベル部分: label-face
|
||||||
|
;; その後の本文: body-face
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defface my-latex-RA-label-face '((t ())) "Face for first argument of \\RA.")
|
||||||
|
(defface my-latex-RA-body-face '((t ())) "Face for second argument of \\RA.")
|
||||||
|
|
||||||
|
(defface my-latex-RB-label-face '((t ())) "Face for first argument of \\RB.")
|
||||||
|
(defface my-latex-RB-body-face '((t ())) "Face for second argument of \\RB.")
|
||||||
|
|
||||||
|
(defface my-latex-RC-label-face '((t ())) "Face for first argument of \\RC.")
|
||||||
|
(defface my-latex-RC-body-face '((t ())) "Face for second argument of \\RC.")
|
||||||
|
|
||||||
|
(defface my-latex-RD-label-face '((t ())) "Face for first argument of \\RD.")
|
||||||
|
(defface my-latex-RD-body-face '((t ())) "Face for second argument of \\RD.")
|
||||||
|
|
||||||
|
(defface my-latex-TO-body-face '((t ())) "Face for argument of \\TO.")
|
||||||
|
|
||||||
|
|
||||||
|
(defvar my-yatex-review-label-background "gray30"
|
||||||
|
"Background color for review macro label faces.")
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review-set-faces ()
|
||||||
|
"Set review macro faces explicitly."
|
||||||
|
|
||||||
|
;; RA / CA: red
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RA-label-face nil
|
||||||
|
:foreground "tomato"
|
||||||
|
:background my-yatex-review-label-background
|
||||||
|
:weight 'bold)
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RA-body-face nil
|
||||||
|
:foreground "tomato"
|
||||||
|
:background 'unspecified
|
||||||
|
:weight 'unspecified)
|
||||||
|
|
||||||
|
;; RB / CB: light blue
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RB-label-face nil
|
||||||
|
:foreground "DeepSkyBlue"
|
||||||
|
:background my-yatex-review-label-background
|
||||||
|
:weight 'bold)
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RB-body-face nil
|
||||||
|
:foreground "DeepSkyBlue"
|
||||||
|
:background 'unspecified
|
||||||
|
:weight 'unspecified)
|
||||||
|
|
||||||
|
;; RC / CC: green
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RC-label-face nil
|
||||||
|
:foreground "SpringGreen2"
|
||||||
|
:background my-yatex-review-label-background
|
||||||
|
:weight 'bold)
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RC-body-face nil
|
||||||
|
:foreground "SpringGreen2"
|
||||||
|
:background 'unspecified
|
||||||
|
:weight 'unspecified)
|
||||||
|
|
||||||
|
;; RD / CD: purple
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RD-label-face nil
|
||||||
|
:foreground "MediumOrchid1"
|
||||||
|
:background my-yatex-review-label-background
|
||||||
|
:weight 'bold)
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-RD-body-face nil
|
||||||
|
:foreground "MediumOrchid1"
|
||||||
|
:background 'unspecified
|
||||||
|
:weight 'unspecified)
|
||||||
|
|
||||||
|
;; TO: red bold
|
||||||
|
(set-face-attribute
|
||||||
|
'my-latex-TO-body-face nil
|
||||||
|
:foreground "tomato"
|
||||||
|
:background 'unspecified
|
||||||
|
:weight 'bold))
|
||||||
|
|
||||||
|
|
||||||
|
(my-yatex-review-set-faces)
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Variables
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defvar-local my-yatex-review-overlays nil
|
||||||
|
"Overlays used for review macro highlighting.")
|
||||||
|
|
||||||
|
(defvar-local my-yatex-review-highlight-enabled nil
|
||||||
|
"Non-nil means review macro highlighting is enabled.")
|
||||||
|
|
||||||
|
(defvar-local my-yatex-review-refresh-timer nil
|
||||||
|
"Idle timer for automatic review macro highlighting refresh.")
|
||||||
|
|
||||||
|
(defvar-local my-yatex-review-font-lock-removed-p nil
|
||||||
|
"Non-nil means old font-lock review highlighting has already been removed.")
|
||||||
|
|
||||||
|
(defvar my-yatex-review-idle-delay 0.8
|
||||||
|
"Idle delay seconds before automatic review macro highlighting refresh.")
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Remove old font-lock highlighting
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review-remove-old-font-lock ()
|
||||||
|
"Remove old font-lock based review macro highlighting."
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(when (boundp 'my-yatex-review-macro-keywords)
|
||||||
|
(font-lock-remove-keywords
|
||||||
|
nil
|
||||||
|
(symbol-value 'my-yatex-review-macro-keywords)))
|
||||||
|
|
||||||
|
(font-lock-remove-keywords
|
||||||
|
nil
|
||||||
|
'(("\\\\RA{\\([^{}\n]*\\)}{\\([^{}\n]*\\)}"
|
||||||
|
(1 'my-latex-RA-label-face t)
|
||||||
|
(2 'my-latex-RA-body-face t))
|
||||||
|
("\\\\RB{\\([^{}\n]*\\)}{\\([^{}\n]*\\)}"
|
||||||
|
(1 'my-latex-RB-label-face t)
|
||||||
|
(2 'my-latex-RB-body-face t))
|
||||||
|
("\\\\RC{\\([^{}\n]*\\)}{\\([^{}\n]*\\)}"
|
||||||
|
(1 'my-latex-RC-label-face t)
|
||||||
|
(2 'my-latex-RC-body-face t))
|
||||||
|
("\\\\RD{\\([^{}\n]*\\)}{\\([^{}\n]*\\)}"
|
||||||
|
(1 'my-latex-RD-label-face t)
|
||||||
|
(2 'my-latex-RD-body-face t))
|
||||||
|
("\\\\TO{\\([^{}\n]*\\)}"
|
||||||
|
(1 'my-latex-TO-body-face t))))
|
||||||
|
|
||||||
|
;; 重いので refresh のたびには呼ばない
|
||||||
|
(when font-lock-mode
|
||||||
|
(font-lock-flush (point-min) (point-max))
|
||||||
|
(font-lock-ensure (point-min) (point-max)))
|
||||||
|
|
||||||
|
(when (called-interactively-p 'interactive)
|
||||||
|
(message "Old font-lock review highlighting removed")))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Overlay utilities
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review--clear-overlays (&optional thorough)
|
||||||
|
"Clear review macro overlays.
|
||||||
|
|
||||||
|
If THOROUGH is non-nil, also remove untracked overlays with
|
||||||
|
property `my-yatex-review'."
|
||||||
|
(mapc #'delete-overlay my-yatex-review-overlays)
|
||||||
|
(setq my-yatex-review-overlays nil)
|
||||||
|
|
||||||
|
(when thorough
|
||||||
|
(remove-overlays (point-min) (point-max) 'my-yatex-review t)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review--make-overlay (beg end face &optional priority)
|
||||||
|
"Create overlay from BEG to END with FACE.
|
||||||
|
Optional PRIORITY specifies overlay priority."
|
||||||
|
(when (< beg end)
|
||||||
|
(let ((ov (make-overlay beg end)))
|
||||||
|
(overlay-put ov 'face face)
|
||||||
|
(overlay-put ov 'priority (or priority 1000))
|
||||||
|
(overlay-put ov 'my-yatex-review t)
|
||||||
|
(push ov my-yatex-review-overlays))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Brace parser
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review--escaped-p (pos)
|
||||||
|
"Return non-nil if character at POS is escaped by backslashes."
|
||||||
|
(let ((n 0)
|
||||||
|
(p (1- pos)))
|
||||||
|
(while (and (>= p (point-min))
|
||||||
|
(eq (char-after p) ?\\))
|
||||||
|
(setq n (1+ n))
|
||||||
|
(setq p (1- p)))
|
||||||
|
(= (mod n 2) 1)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review--read-brace-arg ()
|
||||||
|
"Read one LaTeX brace argument at point.
|
||||||
|
|
||||||
|
Point may be before spaces/newlines followed by `{`.
|
||||||
|
Return (INNER-BEG INNER-END OUTER-END), or nil."
|
||||||
|
(skip-chars-forward " \t\r\n")
|
||||||
|
(if (not (eq (char-after) ?{))
|
||||||
|
nil
|
||||||
|
(let ((open (point))
|
||||||
|
(depth 0)
|
||||||
|
close)
|
||||||
|
(while (and (not close) (not (eobp)))
|
||||||
|
(let ((ch (char-after)))
|
||||||
|
(cond
|
||||||
|
((and (eq ch ?{)
|
||||||
|
(not (my-yatex-review--escaped-p (point))))
|
||||||
|
(setq depth (1+ depth)))
|
||||||
|
((and (eq ch ?})
|
||||||
|
(not (my-yatex-review--escaped-p (point))))
|
||||||
|
(setq depth (1- depth))
|
||||||
|
(when (= depth 0)
|
||||||
|
(setq close (point)))))
|
||||||
|
(forward-char 1)))
|
||||||
|
(when close
|
||||||
|
;; point is now just after closing brace
|
||||||
|
(list (1+ open) close (point))))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Macro faces
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review--faces-for-macro (macro)
|
||||||
|
"Return label/body faces for \\RA, \\RB, \\RC, or \\RD."
|
||||||
|
(cond
|
||||||
|
((string= macro "RA")
|
||||||
|
'(my-latex-RA-label-face my-latex-RA-body-face))
|
||||||
|
((string= macro "RB")
|
||||||
|
'(my-latex-RB-label-face my-latex-RB-body-face))
|
||||||
|
((string= macro "RC")
|
||||||
|
'(my-latex-RC-label-face my-latex-RC-body-face))
|
||||||
|
((string= macro "RD")
|
||||||
|
'(my-latex-RD-label-face my-latex-RD-body-face))
|
||||||
|
(t nil)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review--faces-for-citem-macro (macro)
|
||||||
|
"Return label/body faces for \\CA, \\CB, \\CC, or \\CD."
|
||||||
|
(cond
|
||||||
|
((string= macro "CA")
|
||||||
|
'(my-latex-RA-label-face my-latex-RA-body-face))
|
||||||
|
((string= macro "CB")
|
||||||
|
'(my-latex-RB-label-face my-latex-RB-body-face))
|
||||||
|
((string= macro "CC")
|
||||||
|
'(my-latex-RC-label-face my-latex-RC-body-face))
|
||||||
|
((string= macro "CD")
|
||||||
|
'(my-latex-RD-label-face my-latex-RD-body-face))
|
||||||
|
(t nil)))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; \CA-\CD item-body highlighting
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defvar my-yatex-review-citem-stop-regexp
|
||||||
|
"^[ \t]*\\(?:\\\\C[OABCD]\\_>\\|\\\\end[ \t\r\n]*{\\(?:enumerate\\|document\\)}\\)"
|
||||||
|
"Regexp that stops highlighting body text after \\CA, \\CB, \\CC, or \\CD.")
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review--highlight-citem-macros ()
|
||||||
|
"Highlight \\CA, \\CB, \\CC, and \\CD item bodies.
|
||||||
|
|
||||||
|
The body is highlighted until the next \\CO, \\CA, \\CB, \\CC,
|
||||||
|
\\CD, \\end{enumerate}, or \\end{document}.
|
||||||
|
|
||||||
|
Return number of highlighted answer macros."
|
||||||
|
(let ((count 0))
|
||||||
|
(goto-char (point-min))
|
||||||
|
|
||||||
|
;; 行頭またはインデント後の \CA, \CB, \CC, \CD を対象にする
|
||||||
|
(while (re-search-forward "^[ \t]*\\\\\\(C[ABCD]\\)\\_>" nil t)
|
||||||
|
(let* ((macro (match-string-no-properties 1))
|
||||||
|
(faces (my-yatex-review--faces-for-citem-macro macro))
|
||||||
|
(label-face (nth 0 faces))
|
||||||
|
(body-face (nth 1 faces)))
|
||||||
|
(let ((arg1 (my-yatex-review--read-brace-arg)))
|
||||||
|
(when arg1
|
||||||
|
(let* ((body-beg (nth 2 arg1))
|
||||||
|
(body-end
|
||||||
|
(save-excursion
|
||||||
|
(goto-char body-beg)
|
||||||
|
(if (re-search-forward
|
||||||
|
my-yatex-review-citem-stop-regexp nil t)
|
||||||
|
(match-beginning 0)
|
||||||
|
(point-max)))))
|
||||||
|
(setq count (1+ count))
|
||||||
|
|
||||||
|
;; \CA{A1} の A1 部分
|
||||||
|
(my-yatex-review--make-overlay
|
||||||
|
(nth 0 arg1) (nth 1 arg1) label-face 1000)
|
||||||
|
|
||||||
|
;; A1 に続く本文部分
|
||||||
|
;; \RA などの局所 overlay より少し低い priority にする
|
||||||
|
(my-yatex-review--make-overlay
|
||||||
|
body-beg body-end body-face 900)
|
||||||
|
|
||||||
|
;; 次の item まで飛ぶ
|
||||||
|
(goto-char body-end))))))
|
||||||
|
|
||||||
|
count))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Main refresh
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review-highlight-refresh ()
|
||||||
|
"Refresh highlighting for \\RA, \\RB, \\RC, \\RD, \\TO, and \\CA-\\CD."
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
;; refresh 時は font-lock 削除や face 再設定をしない。
|
||||||
|
;; それらは enable 時に一度だけ行う。
|
||||||
|
|
||||||
|
(my-yatex-review--clear-overlays)
|
||||||
|
|
||||||
|
(let ((count 0))
|
||||||
|
(save-excursion
|
||||||
|
(save-restriction
|
||||||
|
(widen)
|
||||||
|
|
||||||
|
;; ------------------------------------------------------------
|
||||||
|
;; \RA, \RB, \RC, \RD, \TO
|
||||||
|
;; ------------------------------------------------------------
|
||||||
|
(goto-char (point-min))
|
||||||
|
|
||||||
|
(while (re-search-forward "\\\\\\(R[ABCD]\\|TO\\)\\_>" nil t)
|
||||||
|
(let ((macro (match-string-no-properties 1)))
|
||||||
|
(cond
|
||||||
|
|
||||||
|
;; \RA{label}{body}, \RB{label}{body}, ...
|
||||||
|
((member macro '("RA" "RB" "RC" "RD"))
|
||||||
|
(let* ((faces (my-yatex-review--faces-for-macro macro))
|
||||||
|
(label-face (nth 0 faces))
|
||||||
|
(body-face (nth 1 faces)))
|
||||||
|
(let ((arg1 (my-yatex-review--read-brace-arg)))
|
||||||
|
(when arg1
|
||||||
|
(let ((arg2 (my-yatex-review--read-brace-arg)))
|
||||||
|
(when arg2
|
||||||
|
(setq count (1+ count))
|
||||||
|
|
||||||
|
;; first argument
|
||||||
|
(my-yatex-review--make-overlay
|
||||||
|
(nth 0 arg1) (nth 1 arg1) label-face 1000)
|
||||||
|
|
||||||
|
;; second argument
|
||||||
|
(my-yatex-review--make-overlay
|
||||||
|
(nth 0 arg2) (nth 1 arg2) body-face 1000)))))))
|
||||||
|
|
||||||
|
;; \TO{body}
|
||||||
|
((string= macro "TO")
|
||||||
|
(let ((arg1 (my-yatex-review--read-brace-arg)))
|
||||||
|
(when arg1
|
||||||
|
(setq count (1+ count))
|
||||||
|
(my-yatex-review--make-overlay
|
||||||
|
(nth 0 arg1) (nth 1 arg1)
|
||||||
|
'my-latex-TO-body-face 1000)))))))
|
||||||
|
|
||||||
|
;; ------------------------------------------------------------
|
||||||
|
;; \CA, \CB, \CC, \CD
|
||||||
|
;; ------------------------------------------------------------
|
||||||
|
(setq count
|
||||||
|
(+ count
|
||||||
|
(my-yatex-review--highlight-citem-macros)))))
|
||||||
|
|
||||||
|
(when (called-interactively-p 'interactive)
|
||||||
|
(message "Review macro highlight refreshed: %d macros/items found" count))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Automatic refresh after editing
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review-highlight-refresh-silent ()
|
||||||
|
"Refresh highlighting silently."
|
||||||
|
(cl-letf (((symbol-function 'message)
|
||||||
|
(lambda (&rest _args) nil)))
|
||||||
|
(my-yatex-review-highlight-refresh)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review-schedule-refresh (&rest _args)
|
||||||
|
"Schedule automatic refresh after editing."
|
||||||
|
(when my-yatex-review-highlight-enabled
|
||||||
|
(when my-yatex-review-refresh-timer
|
||||||
|
(cancel-timer my-yatex-review-refresh-timer))
|
||||||
|
(setq my-yatex-review-refresh-timer
|
||||||
|
(run-with-idle-timer
|
||||||
|
my-yatex-review-idle-delay nil
|
||||||
|
(lambda (buf)
|
||||||
|
(when (buffer-live-p buf)
|
||||||
|
(with-current-buffer buf
|
||||||
|
(when my-yatex-review-highlight-enabled
|
||||||
|
(my-yatex-review-highlight-refresh-silent)))))
|
||||||
|
(current-buffer)))))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Enable / disable / toggle
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review-highlight-enable ()
|
||||||
|
"Enable review macro highlighting."
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(my-yatex-review-install-keybindings)
|
||||||
|
(setq my-yatex-review-highlight-enabled t)
|
||||||
|
|
||||||
|
;; 古い font-lock 版の削除は一度だけ行う
|
||||||
|
(unless my-yatex-review-font-lock-removed-p
|
||||||
|
(my-yatex-review-remove-old-font-lock)
|
||||||
|
(setq my-yatex-review-font-lock-removed-p t))
|
||||||
|
|
||||||
|
;; face 設定も enable 時だけで十分
|
||||||
|
(my-yatex-review-set-faces)
|
||||||
|
|
||||||
|
(add-hook 'after-change-functions
|
||||||
|
#'my-yatex-review-schedule-refresh
|
||||||
|
nil t)
|
||||||
|
|
||||||
|
(my-yatex-review-highlight-refresh)
|
||||||
|
(message "Review macro highlight: ON"))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review-highlight-disable ()
|
||||||
|
"Disable review macro highlighting."
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
(setq my-yatex-review-highlight-enabled nil)
|
||||||
|
|
||||||
|
(remove-hook 'after-change-functions
|
||||||
|
#'my-yatex-review-schedule-refresh
|
||||||
|
t)
|
||||||
|
|
||||||
|
(when my-yatex-review-refresh-timer
|
||||||
|
(cancel-timer my-yatex-review-refresh-timer)
|
||||||
|
(setq my-yatex-review-refresh-timer nil))
|
||||||
|
|
||||||
|
;; disable 時は念のため thorough に消す
|
||||||
|
(my-yatex-review--clear-overlays t)
|
||||||
|
|
||||||
|
;; 古い font-lock 版が残っていれば削除
|
||||||
|
(unless my-yatex-review-font-lock-removed-p
|
||||||
|
(my-yatex-review-remove-old-font-lock)
|
||||||
|
(setq my-yatex-review-font-lock-removed-p t))
|
||||||
|
|
||||||
|
(message "Review macro highlight: OFF"))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review-highlight-toggle ()
|
||||||
|
"Toggle review macro highlighting."
|
||||||
|
(interactive)
|
||||||
|
(if (or my-yatex-review-highlight-enabled
|
||||||
|
my-yatex-review-overlays)
|
||||||
|
(my-yatex-review-highlight-disable)
|
||||||
|
(my-yatex-review-highlight-enable)))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Key bindings
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(defun my-yatex-review-install-keybindings ()
|
||||||
|
"Install keybindings for review macro highlighting in current buffer."
|
||||||
|
(interactive)
|
||||||
|
|
||||||
|
;; C-c h : toggle ON/OFF
|
||||||
|
;; C-c r : refresh
|
||||||
|
(local-set-key (kbd "C-c h") #'my-yatex-review-highlight-toggle)
|
||||||
|
(local-set-key (kbd "C-c r") #'my-yatex-review-highlight-refresh)
|
||||||
|
|
||||||
|
(when (called-interactively-p 'interactive)
|
||||||
|
(message "Review macro keybindings installed: C-c h toggle, C-c r refresh")))
|
||||||
|
|
||||||
|
|
||||||
|
(defun my-yatex-review-setup ()
|
||||||
|
"Setup review macro highlighting for current YaTeX buffer."
|
||||||
|
(interactive)
|
||||||
|
(my-yatex-review-install-keybindings)
|
||||||
|
(my-yatex-review-highlight-enable))
|
||||||
|
|
||||||
|
|
||||||
|
;; ============================================================
|
||||||
|
;; Hooks
|
||||||
|
;; ============================================================
|
||||||
|
|
||||||
|
(add-hook 'yatex-mode-hook #'my-yatex-review-setup)
|
||||||
|
(add-hook 'YaTeX-mode-hook #'my-yatex-review-setup)
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'my-yatex-review-highlight)
|
||||||
|
;;; my-yatex-review-highlight.el ends here
|
||||||
Reference in New Issue
Block a user