textra.el

textra.el

;;; Install
;; requestが必要なので M-x package-install request などでインストールしておく
;; init.elなどでロードする
;; (load-file "/path/to/textra.el")
;; キーバインドを設定しておく
;; (global-set-key (kbd "C-c t") 'textra-translate)

;;; Usage
;; 翻訳したい部分をリージョン選択して設定したキーバインド、または M-x textra-translate
;; 翻訳結果がミニバッファに出る。また、同じ内容がクリップボードにコピーされている

(require 'request)

(defvar textra-api-key nil)
(defvar textra-api-secret nil)
(defvar textra-user-name nil)

(defvar textra-confirmation-threshold 3000)
(defvar textra-baseurl "https://mt-auto-minhon-mlt.ucri.jgn-x.jp")
(defvar textra-access-token nil)

(cl-defun textra--confirm-send-long-string (&key retry)
  (let ((send-it-p
         (read-from-minibuffer
          (if retry
              "Please answer with \"yes\" or \"no\". [yes/no]: "
            (format "It's over %S characters, do you really want to send it? [yes/no]: "
                    textra-confirmation-threshold)))))
    (cond ((equal send-it-p "yes") t)
          ((equal send-it-p "no") nil)
          (t (confirm-send-long-string :retry t)))))

(cl-defun textra--get-access-token ()
  (let ((get-access-token-url (concat textra-baseurl "/oauth2/token.php")))
    (request get-access-token-url
      :type "POST"
      :data `(("grant_type" . "client_credentials")
              ("client_id" . ,textra-api-key)
              ("client_secret" . ,textra-api-secret)
              ("urlAccessToken" . ,get-access-token-url))
      :parser 'json-read
      :success #'textra--access-token-callback)))

(cl-defun textra--access-token-callback (&key data &allow-other-keys)
  (setq textra-access-token
        `((access-token . ,(cdr (assoc 'access_token data)))
          (expires-at . ,(+ (float-time)
                            (cdr (assoc 'expires_in data)))))))

(cl-defun textra--translate-internal (text source-lang target-lang success-callback)

  (unless (and textra-api-key textra-api-secret textra-user-name)
    (message "Error: textra not configured. Please set textra-api-key, textra-api-secret, textra-user-name.")
    (cl-return-from textra--translate-internal))

  (when (and (> (length text) textra-confirmation-threshold)
             (not (textra--confirm-send-long-string)))
    (cl-return-from textra--translate-internal))

  (when (or (null textra-access-token)
            ;; expired
            (< (cdr (assoc 'expires-at textra-access-token))
               (float-time)))
    (textra--get-access-token))

  (request (concat textra-baseurl (format "/api/mt/generalNT_%s_%s/" source-lang target-lang))
    :type "POST"
    :data `(("access_token" . ,(cdr (assoc 'access-token textra-access-token)))
            ("key" . ,textra-api-key)
            ("name" . ,textra-user-name)
            ("type" . "json")
            ("text" . ,text))
    :parser 'json-read
    :success success-callback))

(cl-defun textra--output-to-messages (&key data &allow-other-keys)
  (let ((translated-text (cdr (assoc 'text (cdr (assoc 'result (cdr (assoc 'resultset data))))))))
    (kill-new translated-text)
    (message translated-text)))

(defun textra-ej (start end)
  (interactive "r")
  (let ((region (buffer-substring start end)))
    (textra--translate-internal region "en" "ja" #'textra--output-to-messages)))

(defun textra-je (start end)
  (interactive "r")
  (let ((region (buffer-substring start end)))
    (textra--translate-internal region "ja" "en" #'textra--output-to-messages)))

(defun textra--ja-char-p (char)
  (or (<= #x3041 char #x309f) ; hiragana
      (<= #x30a1 char #x30ff) ; katakana
      (<= #x4e01 char #x9faf) ; kanji
      ))

(defun textra--ja-string-p (str)
  (>= (cl-count-if #'textra--ja-char-p str) 3))

(defun textra-translate (start end)
  (interactive "r")

  (let ((region (buffer-substring start end)))
    (if (textra--ja-string-p region)
        (textra--translate-internal region "ja" "en" #'textra--output-to-messages)
      (textra--translate-internal region "en" "ja" #'textra--output-to-messages))))