From 00a581c2ea024312059c63f9ed8f8fb18282ed8a Mon Sep 17 00:00:00 2001 From: Takahiro OHKUBO Date: Fri, 3 Jul 2026 09:04:08 +0900 Subject: [PATCH] first commit --- my-labai.el | 952 +++++++++++++++++++++++++++++++++++ my-org-pukiwiki.el | 174 +++++++ my-org-unfill-aware.el | 242 +++++++++ my-qrcode.el | 206 ++++++++ my-replace-zen-to-ascii.el | 167 ++++++ my-yatex-review-highlight.el | 506 +++++++++++++++++++ 6 files changed, 2247 insertions(+) create mode 100644 my-labai.el create mode 100644 my-org-pukiwiki.el create mode 100644 my-org-unfill-aware.el create mode 100644 my-qrcode.el create mode 100644 my-replace-zen-to-ascii.el create mode 100644 my-yatex-review-highlight.el diff --git a/my-labai.el b/my-labai.el new file mode 100644 index 0000000..02e7e00 --- /dev/null +++ b/my-labai.el @@ -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) diff --git a/my-org-pukiwiki.el b/my-org-pukiwiki.el new file mode 100644 index 0000000..4d7ba38 --- /dev/null +++ b/my-org-pukiwiki.el @@ -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 diff --git a/my-org-unfill-aware.el b/my-org-unfill-aware.el new file mode 100644 index 0000000..1603151 --- /dev/null +++ b/my-org-unfill-aware.el @@ -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 diff --git a/my-qrcode.el b/my-qrcode.el new file mode 100644 index 0000000..c37ccc1 --- /dev/null +++ b/my-qrcode.el @@ -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 diff --git a/my-replace-zen-to-ascii.el b/my-replace-zen-to-ascii.el new file mode 100644 index 0000000..c4f69ec --- /dev/null +++ b/my-replace-zen-to-ascii.el @@ -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 diff --git a/my-yatex-review-highlight.el b/my-yatex-review-highlight.el new file mode 100644 index 0000000..34c2ae8 --- /dev/null +++ b/my-yatex-review-highlight.el @@ -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