From 1fc25938f0af89dcc7e1ea51dde9f62f5ce9e70b Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Sun, 25 Dec 2022 15:14:14 +0100 Subject: [PATCH] add go-translate Signed-off-by: Andreas Gerler --- bba.org | 17 + .../go-translate-autoloads.el | 99 +++ .../go-translate-pkg.el | 12 + .../go-translate.el | 90 +++ elpa/go-translate-20221211.1327/gts-core.el | 667 ++++++++++++++++++ .../gts-engine-bing.el | 155 ++++ .../gts-engine-deepl.el | 127 ++++ .../gts-engine-google-rpc.el | 207 ++++++ .../gts-engine-google.el | 424 +++++++++++ .../gts-engine-stardict.el | 60 ++ .../gts-engine-youdao.el | 58 ++ elpa/go-translate-20221211.1327/gts-faces.el | 124 ++++ .../gts-implements.el | 647 +++++++++++++++++ 13 files changed, 2687 insertions(+) create mode 100644 elpa/go-translate-20221211.1327/go-translate-autoloads.el create mode 100644 elpa/go-translate-20221211.1327/go-translate-pkg.el create mode 100644 elpa/go-translate-20221211.1327/go-translate.el create mode 100644 elpa/go-translate-20221211.1327/gts-core.el create mode 100644 elpa/go-translate-20221211.1327/gts-engine-bing.el create mode 100644 elpa/go-translate-20221211.1327/gts-engine-deepl.el create mode 100644 elpa/go-translate-20221211.1327/gts-engine-google-rpc.el create mode 100644 elpa/go-translate-20221211.1327/gts-engine-google.el create mode 100644 elpa/go-translate-20221211.1327/gts-engine-stardict.el create mode 100644 elpa/go-translate-20221211.1327/gts-engine-youdao.el create mode 100644 elpa/go-translate-20221211.1327/gts-faces.el create mode 100644 elpa/go-translate-20221211.1327/gts-implements.el diff --git a/bba.org b/bba.org index b7200bb9..e7ed8ff8 100644 --- a/bba.org +++ b/bba.org @@ -875,6 +875,23 @@ Use our default socket files (setq tramp-ssh-controlmaster-options "-o ControlMaster=auto -o ControlPath='~/.ssh/sockets/ssh.%%C' -o ControlPersist=600")) #+END_SRC +* translate +[2022-12-25 Sun 15:02] + +#+begin_src emacs-lisp + (require 'go-translate) + + (setq gts-translate-list '(("en" "de"))) + + ;; (setq gts-default-translator (gts-translator :engines (gts-bing-engine))) + + (setq gts-default-translator + (gts-translator + :picker (gts-prompt-picker) + :engines (list (gts-bing-engine) (gts-google-engine)) + :render (gts-buffer-render))) +#+end_src + * [[http://www.twmode.sourceforge.net/][twitter]] #+BEGIN_SRC emacs-lisp diff --git a/elpa/go-translate-20221211.1327/go-translate-autoloads.el b/elpa/go-translate-20221211.1327/go-translate-autoloads.el new file mode 100644 index 00000000..358b41e7 --- /dev/null +++ b/elpa/go-translate-20221211.1327/go-translate-autoloads.el @@ -0,0 +1,99 @@ +;;; go-translate-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "go-translate" "go-translate.el" (0 0 0 0)) +;;; Generated autoloads from go-translate.el + +(autoload 'gts-do-translate "go-translate" "\ +Do the translate" t nil) + +(register-definition-prefixes "go-translate" '("gts-default-translator")) + +;;;*** + +;;;### (autoloads nil "gts-core" "gts-core.el" (0 0 0 0)) +;;; Generated autoloads from gts-core.el + +(register-definition-prefixes "gts-core" '("gts-")) + +;;;*** + +;;;### (autoloads nil "gts-engine-bing" "gts-engine-bing.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from gts-engine-bing.el + +(register-definition-prefixes "gts-engine-bing" '("gts-bing-")) + +;;;*** + +;;;### (autoloads nil "gts-engine-deepl" "gts-engine-deepl.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from gts-engine-deepl.el + +(register-definition-prefixes "gts-engine-deepl" '("gts-deepl-")) + +;;;*** + +;;;### (autoloads nil "gts-engine-google" "gts-engine-google.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from gts-engine-google.el + +(register-definition-prefixes "gts-engine-google" '("gts-google-")) + +;;;*** + +;;;### (autoloads nil "gts-engine-google-rpc" "gts-engine-google-rpc.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from gts-engine-google-rpc.el + +(register-definition-prefixes "gts-engine-google-rpc" '("gts-google-rpc-")) + +;;;*** + +;;;### (autoloads nil "gts-engine-stardict" "gts-engine-stardict.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from gts-engine-stardict.el + +(register-definition-prefixes "gts-engine-stardict" '("gts-stardict-")) + +;;;*** + +;;;### (autoloads nil "gts-engine-youdao" "gts-engine-youdao.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from gts-engine-youdao.el + +(register-definition-prefixes "gts-engine-youdao" '("gts-youdao-dict-e")) + +;;;*** + +;;;### (autoloads nil "gts-faces" "gts-faces.el" (0 0 0 0)) +;;; Generated autoloads from gts-faces.el + +(register-definition-prefixes "gts-faces" '("gts-p")) + +;;;*** + +;;;### (autoloads nil "gts-implements" "gts-implements.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from gts-implements.el + +(register-definition-prefixes "gts-implements" '("gts-")) + +;;;*** + +;;;### (autoloads nil nil ("go-translate-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; go-translate-autoloads.el ends here diff --git a/elpa/go-translate-20221211.1327/go-translate-pkg.el b/elpa/go-translate-20221211.1327/go-translate-pkg.el new file mode 100644 index 00000000..19c19eaf --- /dev/null +++ b/elpa/go-translate-20221211.1327/go-translate-pkg.el @@ -0,0 +1,12 @@ +(define-package "go-translate" "20221211.1327" "Translation framework supports multiple engines such as Google/Bing/DeepL" + '((emacs "27.1")) + :commit "65d5139f202320b71e6b8b03d752d02b7c0b8c6f" :authors + '(("lorniu" . "lorniu@gmail.com")) + :maintainer + '("lorniu" . "lorniu@gmail.com") + :keywords + '("convenience") + :url "https://github.com/lorniu/go-translate") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/go-translate-20221211.1327/go-translate.el b/elpa/go-translate-20221211.1327/go-translate.el new file mode 100644 index 00000000..100ef599 --- /dev/null +++ b/elpa/go-translate-20221211.1327/go-translate.el @@ -0,0 +1,90 @@ +;;; go-translate.el --- Translation framework supports multiple engines such as Google/Bing/DeepL -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu + +;; Author: lorniu +;; URL: https://github.com/lorniu/go-translate +;; Package-Requires: ((emacs "27.1")) +;; Keywords: convenience +;; SPDX-License-Identifier: MIT +;; Version: 2.0 + +;;; Commentary: + +;; To be the most powerful translator on Emacs. Supports multiple translation engines such as Google, Bing, deepL. + +;; First, Install it via MELPA or download from github. Make sure this is on your `load-path'. + +;; Then, add following lines to your `.emacs': + +;; (require 'go-translate) +;; (setq gts-translate-list '(("en" "zh"))) +;; (setq gts-default-translator +;; (gts-translator +;; :picker (gts-prompt-picker) +;; :engines (list (gts-google-engine) (gts-google-rpc-engine)) +;; :render (gts-buffer-render))) + +;; And start your translate with command `gts-do-translate'. + +;;; Code: + +(require 'gts-core) +(require 'gts-implements) +(require 'gts-engine-bing) +(require 'gts-engine-google) +(require 'gts-engine-google-rpc) +(require 'gts-engine-deepl) +(require 'gts-engine-stardict) +(require 'gts-engine-youdao) + + +;;; Commands + +(defvar gts-default-translator + (gts-translator :picker + (gts-prompt-picker) + ;;(gts-noprompt-picker) + ;;(gts-noprompt-picker :texter (gts-whole-buffer-texter)) + + :engines + (list + (gts-bing-engine) + (gts-google-engine :parser (gts-google-summary-parser)) + (gts-google-rpc-engine) + + ;;(gts-google-engine) + ;;(gts-google-rpc-engine) + ;;(gts-deepl-engine :auth-key "2e20bade-88e9-02f3-169f-ab3c445d7984:fx" :pro nil) + + ;;(gts-google-engine :parser (gts-google-summary-parser)) + ;;(gts-google-engine :parser (gts-google-parser)) + ;;(gts-google-rpc-engine :parser (gts-google-rpc-summary-parser)) + ) + + :render + (gts-buffer-render) + + ;;(gts-posframe-pop-render) + ;;(gts-posframe-pop-render :backcolor "#333333" :forecolor "#ffffff") + + ;;(gts-posframe-pin-render) + ;;(gts-posframe-pin-render :position (cons 1200 20)) + ;;(gts-posframe-pin-render :width 80 :height 25 :position (cons 1000 20) :forecolor "#ffffff" :backcolor "#111111") + + ;;(gts-kill-ring-render) + + :splitter nil + ;; (gts-paragraph-splitter) + )) + +;;;###autoload +(defun gts-do-translate () + "Do the translate" + (interactive) + (gts-translate gts-default-translator)) + + +(provide 'go-translate) + +;;; go-translate.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-core.el b/elpa/go-translate-20221211.1327/gts-core.el new file mode 100644 index 00000000..69f25f0f --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-core.el @@ -0,0 +1,667 @@ +;;; gts-core.el --- Translate engines and utils -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; The core components and utils of the translator + +;;; Code: + +(require 'cl-lib) +(require 'subr-x) +(require 'eieio) + +(defgroup go-translate nil + "Translate Framework for Emacs, asynchronous and flexible." + :group 'external + :prefix 'gts-) + +(defvar gts-debug-p nil) + + +;;; Utils + +(defun gts-aref-for (vector &rest ns) + "Recursively find the element in VECTOR. NS is indexes, as the path." + (while ns + (setq vector (aref vector (pop ns)))) + vector) + +(defun gts-format-params (data) + "Format alist DATA to k=v style string." + (cond ((null data) nil) + ((stringp data) data) + (t (mapconcat (lambda (arg) + (format "%s=%s" + (url-hexify-string (format "%s" (car arg))) + (url-hexify-string (format "%s" (cdr arg))))) + data "&")))) + +(defun gts-ensure-list (object) + "Return OBJECT as a list." + (if (listp object) object (list object))) + +(defun gts-ensure-plain (o) + "Return O or the result of its execution." + (if (functionp o) (funcall o) o)) + + +;;; Components + +;; logger/http-client/cacher + +(defclass gts-logger () () + "Used to log the messages." + :abstract t) + +(defclass gts-http-client () () + "Used to send a request." + :abstract t) + +(defclass gts-cacher () + ((caches :initform nil)) ; (key . (str . timestamp)) + "Used to cache the translate results." + :abstract t) + +;; translator/task + +(defclass gts-translator () + ((picker :initarg :picker :documentation "`gts-picker' object or a function return it" :initform nil) + (engines :initarg :engines :documentation "a list of `gts-engine' objects or a function return them" :initform nil) + (render :initarg :render :documentation "`gts-render' object or a function return it" :initform nil) + (splitter :initarg :splitter :documentation "`gts-splitter' object or a function return it" :initform nil) + + (text :initarg :text :documentation "Text to be translated") + (sptext :initarg :sptext :documentation "List of strings splitted according `gts-splitter'") + (path :initarg :path :documentation "From/To language cons") + + (plan-cnt :initform 0 :documentation "count of tasks in a translation") + (task-queue :initform nil :documentation "translation tasks.") + (state :initform 0 :documentation "Inner state of the translator: +0: new translator without any tasks, +1: tasks add finished, but not running, +2: prepare render finished, and begin to running, +3: all tasks running finished, +4: rendered done, all over.") + (version :initform nil :documentation "Used to distinguish between different translations"))) + +(defclass gts-task () + ((id :initform (gensym)) + + (text :initarg :text :documentation "Text that sent to engines. It maybe contains delimiters") + (from :initarg :from) + (to :initarg :to) + + (raw :initform nil :documentation "raw result responsed by the http-client") + (parsed :initform nil :initarg :parsed :documentation "result parsed by parser, string or list") + (err :initform nil :initarg :err :documentation "error info") + (meta :initform nil :initarg :meta :documentation "extra info passed from parser to render. tbeg/tend") + + (engine :initarg :engine :initform nil) + (render :initarg :render :initform nil) + (translator :initarg :translator :initform nil))) + +;; picker/texter + +(defclass gts-picker () + ((single :initarg :single :initform nil) + (texter :initarg :texter)) + "Used to pick the translation source text and from/to lang." + :abstract t) + +(defclass gts-texter () () + "Used to get the initial translation text. +Current word under cursor? Selection region? Whole line? Whole buffer? Others? +You can implements your rules.") + +;; splitter + +(defclass gts-splitter () () + "Used to split the translation text by pragraph or other rules." + :abstract t) + +;; engine/parser + +(defclass gts-engine () + ((tag :initarg :tag :documentation "Used to display as name") + (parser :initarg :parser :documentation "Used to parse the response result")) + :abstract t) + +(defclass gts-parser () + ((tag :initarg :tag :initform nil))) + +;; render + +(defclass gts-render () ()) + +;; generic methods + +(cl-defgeneric gts-translate (translator-or-engine &rest args) + "Start a translation for TRANSLATOR-OR-ENGINE. +ARGS should be text/path or task/callback.") + +;; silence byte-compiler +(eieio-declare-slots task-queue text from to) + + +;;; Logger + +(cl-defgeneric gts-log (logger tag message) + "Used to record the messages.") + +(defvar gts-default-logger nil "The default logger.") + +(defmacro gts-do-log (tag &rest messages) + (declare (indent 1)) + `(when gts-debug-p + (if gts-default-logger + (cl-loop with ms = nil + for message in (list ,@messages) + if message do (cl-loop for m in (split-string message "\n") do (push m ms)) + finally (cl-loop + for m in (nreverse ms) + do (gts-log gts-default-logger (format "%s" ,tag) m))) + (error "Make sure `gts-default-logger' is available. eg:\n + (setq gts-default-logger (gts-buffer-logger))\n\n\n")))) + + +;;; Cacher + +(defcustom gts-cache-enable t + "Enable the cacher if this is t." + :type 'boolean + :group 'go-translate) + +(defcustom gts-cache-expired-factor (* 30 60) + "Cache alive time based on this. +Make word live longer time than sentence." + :type 'integer + :group 'go-translate) + +(defvar gts-default-cacher nil "The default cacher.") + +(cl-defgeneric gts-cache-get (cacher task) + "Get item for TASK from CACHER.") + +(cl-defgeneric gts-cache-set (cacher task result) + "Add RESULT fro TASK to CACHER.") + +(cl-defmethod gts-cache-key ((_ gts-cacher) task) + (with-slots (text from to engine) task + (sha1 (format "%s-%s-%s-%s" + text from to + (eieio-object-class-name engine))))) + +(cl-defmethod gts-clear-expired ((cacher gts-cacher)) + (with-slots (caches expired) cacher + (cl-delete-if (lambda (c) (> (time-to-seconds) (cddr c))) caches))) + +(cl-defmethod gts-clear-all ((cacher gts-cacher)) + (oset cacher caches nil)) + + +;;; Http Client + +(cl-defgeneric gts-request (http-client url &key done fail data headers) + "Use HTTP-CLIENT to request a URL with DATA. +When success execute CALLBACK, or execute ERRORBACK." + (:method (&rest _) (user-error "Method `gts-request' is not implement"))) + +(defvar gts-default-http-client nil + "The default http client used to send a request.") + +(cl-defun gts-do-request (url &key done fail data headers) + "Helper for `gts-request'. +DONE is a callback based on the responsed result buffer. +FAIL is the callback for any error occured in request or parse." + (if (and gts-default-http-client + (eieio-object-p gts-default-http-client) + (object-of-class-p gts-default-http-client 'gts-http-client)) + (let ((tag (format "%s" (eieio-object-class-name gts-default-http-client))) + (data (gts-format-params data))) + (gts-do-log tag + (format "Start! (%s)" url) + (if headers (format " HEADER: %s" headers)) + (if data (format " DATA: %s" data))) + (gts-request gts-default-http-client url + :headers headers + :data data + :done (lambda () + (gts-do-log tag (format "DONE! (%s)" url)) + (condition-case err + (funcall done) + (error + (gts-do-log tag (format "FAIL in callback! (%s) %s" url err)) + (funcall fail err)))) + :fail (lambda (status) + (gts-do-log tag (format "FAIL! (%s) %s" url status)) + (funcall fail status)))) + (funcall fail "Make sure `gts-default-http-client' is available. eg:\n + (setq gts-default-http-client (gts-url-http-client))\n\n\n"))) + + +;;; Picker/Texter + +(cl-defgeneric gts-pick (picker) + "Get the source text and translate from/to path from PICKER.") + +(cl-defgeneric gts-path (picker text) + "Use to get the translation path for TEXT from PICKER.") + +(cl-defgeneric gts-next-path (picker text path &optional backwardp) + "Get the next available path.") + +(cl-defgeneric gts-text (texter) + "Get the init translation source text via TEXTER.") + +(defcustom gts-translate-list nil + "Setup your translate languages. Just like: + +Single: + + (setq gts-translate-list \\='((\"en\" \"zh\"))) + +Or multiple: + + (setq gts-translate-list \\='((\"en\" \"zh\") (\"en\" \"fr\"))) + +The picker will give the translate from/to pair according this." + :type 'alist + :group 'go-translate) + +(defcustom gts-picker-lang-match-alist + (list + (cons "en" "^[-a-zA-Z0-9,.;_ ]+$") + (cons "zh" "\\cc") + (cons "ja" (lambda (text) (string-match-p "\\cj" text))) + (cons "ru" "\\cy")) + "Setup language match rules. + +Used to pick the right language for current translate text. + +Key should be the language, value should be a regexp string or function." + :type 'alist + :group 'go-translate) + +(defvar gts-picker-last-path nil) + +(defun gts-picker-lang-matcher (lang) + "Judge source, sure case, yes:no:unknown. +choose path, from main, then extra path match." + (let ((p (cdr (cl-find-if + (lambda (item) (string-match-p (format "^%s$" (car item)) lang)) + gts-picker-lang-match-alist)))) + (if (stringp p) (lambda (text) (string-match-p p text)) p))) + +(cl-defmethod gts-all-paths ((picker gts-picker)) + (when (or (null gts-translate-list) (not (consp (car gts-translate-list)))) + (user-error "Please make sure you set the avaiable `gts-translate-list'. eg:\n + (setq gts-translate-list '((\"en\" \"zh\") (\"en\" \"ja\"))\n\n")) + (let (paths) + (when gts-picker-last-path + (cl-pushnew gts-picker-last-path paths)) + (cl-loop with candidates = (if (oref picker single) + (list (car gts-translate-list)) + gts-translate-list) + for (lang1 . lang2) in candidates + for lang2 = (if (consp lang2) (car lang2) lang2) + do (progn + (cl-pushnew (cons lang1 lang2) paths :test 'equal) + (cl-pushnew (cons lang2 lang1) paths :test 'equal))) + (reverse paths))) + +(cl-defmethod gts-matched-paths ((picker gts-picker) text) + (when text + (let ((paths (gts-all-paths picker)) + (text (with-temp-buffer ; clear punctuations + (insert text) + (goto-char (point-min)) + (while (re-search-forward "\\s.\\|\n" nil t) (replace-match "")) + (buffer-string)))) + (cl-loop for path in paths + for matcher = (gts-picker-lang-matcher (car path)) + when (and matcher (funcall matcher text)) + collect path)))) + +(cl-defmethod gts-path ((picker gts-picker) text) + "Get translate path according TEXT using PICKER." + (let ((paths (gts-matched-paths picker text))) + (if paths (car paths) + (or gts-picker-last-path + (car (gts-all-paths picker)))))) + +(cl-defmethod gts-next-path ((picker gts-picker) text path &optional backwardp) + (let (candidates idx) + (cl-loop for path in (append (gts-matched-paths picker text) (gts-all-paths picker)) + do (cl-pushnew path candidates :test 'equal)) + (setq candidates (reverse candidates)) + (setq idx (cl-position path candidates :test 'equal)) + (if backwardp + (elt candidates (if (= 0 idx) (- (length candidates) 1) (- idx 1))) + (elt candidates (if (= (+ 1 idx) (length candidates)) 0 (+ 1 idx)))))) + + +;;; Splitter + +(cl-defgeneric gts-split (gts-splitter text) + "Split TEXT to several parts. +Return list of string, or nil if split failed.") + + +;;; Engine/Parser + +(cl-defmethod gts-translate ((engine gts-engine) _task _callback) + "Translate and update TASK with parsed result using ENGINE. +The CALLBACK should contain the render logic." + (user-error "Method `gts-translate' of %s is not implement" (eieio-object-class-name engine))) + +(cl-defmethod gts-translate :around ((engine gts-engine) task callback) + "Add cache and log support." + (with-slots (id render translator) task + (if-let ((render-name (eieio-object-class-name render)) + (engine-name (eieio-object-class-name engine)) + (cache (gts-cache-get gts-default-cacher task))) + ;; try cache + (let ((engines (gts-get translator 'engines))) + (gts-update-raw task cache) + (gts-parse (oref engine parser) task) + (if (cdr engines) (gts-me-out render task) + (gts-out render task)) + (gts-do-log 'render (format "%s: done with cache!" id))) + ;; request from engine + (gts-do-log 'engine (format "%s: starting %s..." id engine-name)) + (cl-call-next-method engine task + (lambda () + (gts-do-log 'engine (format "%s: %s done!" id engine-name)) + (funcall callback) + ;; refresh cache + (with-slots (err raw parsed) task + (unless err + (gts-cache-set gts-default-cacher task raw)))))))) + +(cl-defgeneric gts-with-token (engine done fail) + (:documentation "Get token for ENGINE, if success then DONE is called.") + (declare (indent 1))) + +(cl-defgeneric gts-tts (engine text lang) + "TTS, speak TEXT with LANG." + (:method ((e gts-engine) &rest _) + (user-error "No TTS service found on engine `%s'" (oref e tag)))) + +(cl-defgeneric gts-parse (parser task) + (:documentation "Parse the raw result and update the parsed result into TASK.") + (:method ((_o gts-parser) task) + ;; do nothing + (gts-update-parsed task (oref task raw)))) + + +;;; Render + +(cl-defgeneric gts-pre (render translator) + (:documentation "Pre-render before request success. +Do some preparation for the gts-out.") + (:method :after ((render gts-render) _) + (gts-do-log 'render (format "prepare render with %s finished" (eieio-object-class-name render)))) + (:method ((_o gts-render) (_t gts-translator)) ())) + +(cl-defgeneric gts-out (render task) + (:documentation "Render the TASK, default output to *Messages*.") + (:method :after ((render gts-render) task) + (gts-do-log 'render (format "%s: %s finished" (oref task id) (eieio-object-class-name render)))) + (:method ((_ gts-render) task) + (with-slots (err parsed) task + (when (and (not err) (listp parsed)) + (setq parsed (string-join parsed "\n\f\n"))) + (setq parsed (string-trim (format "%s" (or err parsed)))) + (setq parsed (propertize parsed 'face 'font-lock-keyword-face)) + (message "-+-G-+-T-+-S-+-") + (message parsed )))) + +(cl-defgeneric gts-me-pre (render translator) + (:documentation "Pre-render for TRANSLATOR. +It used only when multiple engines exists. +Default dispatch to gts-pre when first pre-render.") + (:method :after ((render gts-render) _) + (gts-do-log 'render (format "me prepare render with %s finished" (eieio-object-class-name render)))) + (:method ((render gts-render) translator) + (with-slots (task-queue state) translator + (when (= state 1) + (gts-pre render translator) + (setf state 2))))) + +(cl-defgeneric gts-me-out (render task) + (:documentation "Render TASK with RENDER. +It used only when multiple engines exists. +Default dispatch to gts-out with all results concated.") + (:method :after ((render gts-render) task) + (gts-do-log 'render (format "%s: %s finished" (oref task id) (eieio-object-class-name render)))) + (:method ((render gts-render) task) + (let ((translator (oref task translator)) results) + ;; show only when all tasks finished. + (when (= (oref translator state) 3) + (dolist (task (oref translator task-queue)) + (with-slots (err parsed engine) task + (when (and (not err) (listp parsed)) + (setq parsed (string-join parsed "\f"))) + (push (cons (format "[%s]" (oref engine tag)) (or err parsed)) results))) + (setq results (nreverse results)) + (let* ((newlinep (cl-find-if (lambda (r) (string-match-p "\n" (cdr r))) results)) + (concated (mapconcat (lambda (r) + (if newlinep + (concat (propertize (concat (car r) "\n") 'face 'gts-pop-posframe-me-header-2-face) + (format "\n%s" (cdr r))) + (concat (propertize (format "%-7s" (car r)) 'face 'gts-pop-posframe-me-header-face) + (format " %s" (cdr r))))) + results + (if newlinep "\n\n" "\n")))) + (oset translator state 4) + (gts-out render (gts-task :parsed concated :translator translator))))))) + + +;;; TTS + +(defcustom gts-tts-speaker (or (executable-find "mpv") + (executable-find "mplayer")) + "The program to use to speak the translation. + +On Windows, if it is not found, will fallback to use `powershell` +to do the job. Although it is not perfect, it seems to work." + :type 'string + :group 'go-translate) + +(defcustom gts-tts-try-speak-locally t + "If t then will fallback to locally TTS service when engine's TTS failed. +For example, it will use powershell on Windows to speak the word +when this is set to t." + :type 'boolean + :group 'go-translate) + +(defvar gts-tts-playing-process nil) + +(defun gts-tts-speak-buffer-data () + "Speak the current buffer's data." + (gts-tts-try-interrupt-playing-process) + (let ((proc (make-process :name (format "gts-tts-process-%s" (+ 1000 (random 1000))) + :command (append (split-string gts-tts-speaker) (list "-")) + :buffer nil + :noquery t + :connection-type 'pipe))) + (setq gts-tts-playing-process proc) + (process-send-region proc (point-min) (point-max)) + (if (process-live-p proc) (process-send-eof proc)))) + +(defun gts-tts-try-interrupt-playing-process () + (when (and gts-tts-playing-process (process-live-p gts-tts-playing-process)) + (ignore-errors (kill-process gts-tts-playing-process)) + (setq gts-tts-playing-process nil))) + +(defun gts-do-tts (text lang &optional engine) + "Speak TEXT in LANG with possible tts service by ENGINE. +If engine failed, then try locally TTS if `gts-tts-try-speak-locally' is set." + (condition-case err + (if engine + (if gts-tts-speaker + (gts-tts engine text lang) + (user-error "No mpv/mplayer found")) + (user-error "No engine TTS service provided")) + (error (if gts-tts-try-speak-locally + (cond ((executable-find "powershell") + (let ((cmd (format "$w = New-Object -ComObject SAPI.SpVoice; $w.speak(\\\"%s\\\")" text))) + (shell-command (format "powershell -Command \"& {%s}\"" + (encode-coding-string + (replace-regexp-in-string "\n" " " cmd) + (keyboard-coding-system)))))) + (t (message "[TTS] %s" (cadr err)))))))) + + +;;; Translator + +(defvar gts-text-delimiter "34587612321123") + +(defvar gts-current-command nil "The command invoked by `gts-translate'.") + +(cl-defmethod initialize-instance :after ((this gts-translator) &rest _) + (unless (gts-ensure-plain (oref this render)) + (oset this render (gts-render))) + (unless (gts-ensure-plain (oref this picker)) + (oset this picker (gts-noprompt-picker)))) + +(cl-defmethod gts-get ((this gts-translator) &rest slots) + "Return the normalized value of SLOTS in THIS translator." + (cl-loop for slot in slots + for value = + (cl-flet ((ensure (v) (or v (user-error "No %s found in current translator" slot)))) + (pcase slot + ((or 'picker 'render) (ensure (gts-ensure-plain (slot-value this slot)))) + ('splitter (gts-ensure-plain (slot-value this slot))) + ('engines (ensure (gts-ensure-list (gts-ensure-plain (slot-value this slot))))) + (_ (slot-value this slot)))) + collect value into values + finally (return (if (cadr slots) (apply #'cl-values values) (car values))))) + +(cl-defmethod gts-init ((this gts-translator) text path) + "Init all status and tasks in THIS translator." + ;; input + (unless (and text path) + (let ((input (gts-pick (gts-get this 'picker)))) + (setq text (cl-nth-value 0 input)) + (setq path (cl-nth-value 1 input)))) + (oset this text text) + (oset this path path) + (setq gts-picker-last-path path) + (gts-do-log 'translator (format "\nBegin to translate %s" path)) + (gts-do-log 'text text) + (cl-multiple-value-bind (splitter engines render) (gts-get this 'splitter 'engines 'render 'version) + ;; reset + (oset this state 0) + (oset this task-queue nil) + (oset this plan-cnt (length engines)) + (oset this version (time-to-seconds)) + ;; tasks + (let ((splitted (if splitter (gts-split splitter text)))) + (oset this sptext splitted) + (cl-loop for engine in engines + for task = (gts-task :translator this + :engine engine + :render render + :from (car path) :to (cdr path) + :text (if splitted (string-join splitted (concat "\n" gts-text-delimiter "\n")) text)) + do (gts-add-task this task)) + (gts-do-log 'text (format "splitted? %s!" (if splitted "Yes" "No")))))) + +(cl-defmethod gts-add-task ((this gts-translator) task) + "Add a new TASK to THIS translator." + (with-slots (id engine render) task + (with-slots (text path plan-cnt task-queue state) this + (when (= state 0) + (setf task-queue (append task-queue (list task))) + (gts-do-log 'translator + (format "- add task %s: (%s/%s)" id + (eieio-object-class-name engine) (eieio-object-class-name render)))) + (when (and (= state 0) (= (length task-queue) plan-cnt)) + (setf state 1))))) + +(cl-defmethod gts-done-tasks ((this gts-translator)) + "Return the finished tasks in THIS translator." + (with-slots (task-queue) this + (cl-remove-if-not + (lambda (task) (or (oref task err) (oref task raw))) task-queue))) + +(defun gts-update-raw (task resp &optional error) + "Update non-parsed RESP result to TASK. +If ERROR is not nil, then update task with failure." + (declare (indent 1)) + (with-slots (id raw err translator) task + (with-slots (task-queue plan-cnt state) translator + (setf raw resp) + (setf err error) + (when (and (= state 2) (= plan-cnt (length (gts-done-tasks translator)))) + (setf state 3)) + (gts-do-log 'translator (format "%s: **responsed** %s" id (or error "success!")))))) + +(defun gts-update-parsed (task result &optional metadata filter) + "Update TASK with parsed RESULT, update METADATA if exists. +FILTER the parsed result if necessary, it's a function take parsed result as argument." + (declare (indent 1)) + (with-slots (id raw parsed err meta translator) task + (if raw + (condition-case er + (let ((r (if (or (listp result) (not (gts-get translator 'sptext))) + result + (gts-do-log 'translator + (format "%s: result contains delimiter, so split to list" id)) + (split-string result gts-text-delimiter nil "[ \t\n\r]+")))) + (setf parsed (if filter (funcall filter r) r)) + (if metadata (setf meta metadata))) + (error (setf err er))) + (gts-update-raw task t "Mybe Null Response")))) + +(defun gts-render-fail (task error) + "Directly render the ERROR message and finish the TASK." + (declare (indent 1)) + (gts-do-log 'translator (format "error? %s" error)) + (if task + (with-slots (translator render) task + (let ((engines (gts-get translator 'engines))) + (gts-update-raw task nil error) + (if (cdr engines) + (gts-me-out render task) + (gts-out render task)))) + (signal 'error error))) + +(cl-defmethod gts-translate ((this gts-translator) &optional text path) + "Fire a translation for THIS translator instance. +When TEXT and PATH is nil then pick them via `gts-pick'." + ;; record this, so can fixup issue in posframe-pop etc. Weird? + (setq gts-current-command this-command) + ;; initialize + (gts-init this text path) + (cl-multiple-value-bind (engines render tasks text path) + (gts-get this 'engines 'render 'task-queue 'text 'path) + (let ((buf (current-buffer))) + ;; single engine + (if (not (cdr engines)) + (let ((task (car tasks))) + (gts-pre render this) + (gts-translate (car engines) task + (lambda () + (with-current-buffer buf + (gts-out render task))))) + ;; multiple engines + (gts-me-pre render this) + (dolist (task tasks) + (condition-case er + (gts-translate (oref task engine) task + (lambda () + (with-current-buffer buf + (gts-me-out render task)))) + (error + (gts-render-fail task er)))) + (gts-me-out render (gts-task :text text :from (car path) :to (cdr path) :translator this)))))) + + +(provide 'gts-core) + +;;; gts-core.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-engine-bing.el b/elpa/go-translate-20221211.1327/gts-engine-bing.el new file mode 100644 index 00000000..27a13602 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-engine-bing.el @@ -0,0 +1,155 @@ +;;; gts-engine-bing.el --- Microsoft Translate -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; https://bing.com/translator + +;;; Code: + +(require 'gts-implements) + +(defclass gts-bing-parser (gts-parser) ()) + +(defclass gts-bing-engine (gts-engine) + ((tag :initform "Bing") + (base-url :initform "https://www.bing.com") + (sub-url :initform "/ttranslatev3") + + (tld-url :initform nil) + (ig :initform nil) + (key :initform nil) + (token :initform nil) + (last-time :initform nil) + (expired-time :initform (* 30 60)) + + (ttsk-url :initform "/tfetspktok") + (tts-url :initform "https://%s.tts.speech.microsoft.com/cognitiveservices/v1") + (tts-tpl :initform "%s") + + (parser :initform (gts-bing-parser)))) + + +;;; Engine + +(defvar gts-bing-extra-langs-mapping '(("zh" . "zh-Hans"))) + +(defvar gts-bing-token-maybe-invalid nil) + +(cl-defmethod gts-get-lang ((_ gts-bing-engine) lang) + (or (cdr-safe (assoc lang gts-bing-extra-langs-mapping)) lang)) + +(cl-defmethod gts-token-available-p ((engine gts-bing-engine)) + (with-slots (token key ig last-time expired-time) engine + (and token key ig last-time + (not gts-bing-token-maybe-invalid) + (< (- (time-to-seconds) last-time) expired-time)))) + +(cl-defmethod gts-with-token ((engine gts-bing-engine) done fail) + (with-slots (token key ig base-url) engine + (if (gts-token-available-p engine) + (funcall done) + (gts-do-request (concat base-url "/translator") + :done + (lambda () + (let (key token ig tld) + (re-search-forward "curUrl=.*/\\([a-z]+\\.bing.com\\)") + (setq tld (match-string 1)) + (re-search-forward "\"ig\":\"\\([^\"]+\\).*params_RichTranslateHelper = \\[\\([0-9]+\\),\"\\([^\"]+\\)") + (setq ig (match-string 1) key (match-string 2) token (match-string 3)) + (oset engine ig ig) + (oset engine key key) + (oset engine token token) + (oset engine last-time (time-to-seconds)) + (oset engine tld-url (concat "https://" tld)) + (setq gts-bing-token-maybe-invalid nil) + (gts-do-log 'bing (format "url: %s\nkey: %s\ntoken: %s\nig: %s" tld key token ig)) + (funcall done))) + :fail fail)))) + +(cl-defmethod gts-translate ((engine gts-bing-engine) task rendercb) + (gts-with-token engine + (lambda () + (with-slots (text from to raw) task + (with-slots (tld-url sub-url token key ig parser) engine + (gts-do-request (format "%s%s?isVertical=1&IG=%s&IID=translator.5022.1" tld-url sub-url ig) + :headers `(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8")) + :data `(("fromLang" . ,(gts-get-lang engine from)) + ("to" . ,(gts-get-lang engine to)) + ("text" . ,text) + ("key" . ,key) + ("token" . ,token)) + :done (lambda () + (gts-update-raw task (buffer-string)) + (gts-parse parser task) + (funcall rendercb)) + :fail (lambda (err) + (gts-render-fail task + (cond ((ignore-errors (= (caddar err) 429)) + "[429] Too many requests! Please retry later") + (t err)))))))) + (lambda (err) + (gts-render-fail task + (format "Error occurred when request for token.\n\n%s" err))))) + + +;;; TTS + +(defvar gts-bing-tts-langs-mapping '(("zh" . ("zh-CN" . "zh-CN-XiaoxiaoNeural")) + ("en" . ("en-US" . "en-US-AriaNeural")) + ("fr" . ("fr-CA" . "fr-CA-SylvieNeural")) + ("de" . ("de-DE" . "de-DE-KatjaNeural")))) + +(cl-defmethod gts-tts-payload ((engine gts-bing-engine) lang text) + (with-slots (tts-tpl) engine + (let (l n (mt (assoc lang gts-bing-tts-langs-mapping))) + (if mt (setq l (cadr mt) n (cddr mt)) + (user-error "Add the mapping of your language into `gts-bing-tts-langs-mapping' :)")) + (format tts-tpl l l n (encode-coding-string text 'utf-8))))) + +(cl-defmethod gts-tts ((engine gts-bing-engine) text lang) + (gts-with-token engine + (lambda () + (with-slots (tld-url sub-url token key ig parser ttsk-url tts-url tts-tpl) engine + (gts-do-request (format "%s%s?isVertical=1&IG=%s&IID=translator.5022.2" tld-url ttsk-url ig) + :headers '(("content-type" . "application/x-www-form-urlencoded")) + :data `(("token" . ,token) ("key" . ,key)) + :done (lambda () + (let* ((json (json-read)) + (token (cdr (assoc 'token json))) + (region (cdr (assoc 'region json)))) + (gts-do-log 'bing-tts (format "token: %s\nregion: %s" token region)) + (gts-do-request (format tts-url region) + :data (gts-tts-payload engine lang text) + :headers `(("content-type" . "application/ssml+xml") + ("authorization" . ,(format "Bearer %s" token)) + ("x-microsoft-outputformat" . "audio-16khz-32kbitrate-mono-mp3")) + :done (lambda () + (gts-tts-speak-buffer-data)) + :fail (lambda (_) + (user-error "[BING-TTS] error when play sound"))))) + :fail (lambda (err) (user-error "%s" err))))) + (lambda (_) (user-error "Failed to get token")))) + + +;;; Parser + +(cl-defmethod gts-parse ((_ gts-bing-parser) task) + (with-temp-buffer + (set-buffer-multibyte t) + (insert (oref task raw)) + (decode-coding-region (point-min) (point-max) 'utf-8) + (gts-do-log 'bing (string-trim (buffer-string))) + (goto-char (point-min)) + (if-let* ((json (json-read)) + (result (ignore-errors (cdr (assoc 'text (aref (cdr (assoc 'translations (aref json 0))) 0)))))) + (gts-update-parsed task result) + (setq gts-bing-token-maybe-invalid t) ; refresh token when error occurred + (gts-update-raw task nil (buffer-string))))) + + +(provide 'gts-engine-bing) + +;;; gts-engine-bing.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-engine-deepl.el b/elpa/go-translate-20221211.1327/gts-engine-deepl.el new file mode 100644 index 00000000..9b1bdfc2 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-engine-deepl.el @@ -0,0 +1,127 @@ +;;; gts-engine-deepl.el --- Translate Engine for DeepL -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; https://www.deepl.com + +;;; Code: + +(require 'gts-implements) + + +;;; Components + +(defclass gts-deepl-parser (gts-parser) ()) + +(defclass gts-deepl-engine (gts-engine) + ((tag :initform "DeepL") + (pro :initform nil :initarg :pro :documentation "If your key is PRO version") + (free-url :initform "https://api-free.deepl.com") + (pro-url :initform "https://api.deepl.com") + (sub-url :initform "/v2/translate") + (auth-key :initform nil :initarg :auth-key) + (parser :initform (gts-deepl-parser)))) + +(cl-defmethod initialize-instance :after ((engine gts-deepl-engine) &rest _) + (unless (oref engine auth-key) + (user-error "You should provide a auth-key when instance gts-deepl-engine"))) + + +;;; Utils + +(defcustom gts-deepl-fill-enable t + "Controller wheather try to improve the input and output. +Default behavior is removing excess linebreaks in input for better +translation effect, and filling the output for better reading experience. +You can override the behaviors by :around the method `gts-deepl-fill-input' +or `gts-deepl-fill-output'." + :type 'boolean + :group 'go-translate) + +(cl-defmethod gts-deepl-fill-input (text) + "Improve the input TEXT for better translation effect. +Mainly remove excess linebreaks. I want to skip unfill on comments and codes, +but don't know how to implement easily. To make it better later, maybe." + (if gts-deepl-fill-enable + (with-temp-buffer + (insert text) + (let ((fill-column (point-max))) + (fill-region (point-min) (point-max))) + (buffer-string)) + text)) + +(cl-defmethod gts-deepl-fill-output (text) + "Improve the output TEXT for better reading experience. +Mainly fill the text to suitable length." + (if gts-deepl-fill-enable + (with-temp-buffer + (insert text) + (fill-region (point-min) (point-max)) + (buffer-string)) + text)) + + +;;; Engine + +(defvar gts-deepl-langs-mapping '(("en" . "EN") + ("zh" . "ZH") + ("de" . "DE") ; German + ("fr" . "FR") ; French + ("it" . "IT") ; Italian + ("ja" . "JA") ; Japanese + ("es" . "ES") ; Spanish + ("nl" . "NL") ; Dutch + ("pl" . "PL") ; Polish + ("pt" . "PT") ; Portuguese (all Portuguese varieties mixed) + ("ru" . "RU") ; Russian + )) + +(cl-defmethod gts-get-lang ((_ gts-deepl-engine) lang) + (let ((mapping (assoc lang gts-deepl-langs-mapping))) + (if mapping (cdr mapping) + (user-error + "Language %s is not supported by DeepL.\nSupported list: %s" + lang (mapconcat #'car gts-deepl-langs-mapping ", "))))) + +(cl-defmethod gts-gen-url ((engine gts-deepl-engine)) + (with-slots (free-url pro-url sub-url pro) engine + (format "%s%s" (if pro pro-url free-url) sub-url))) + +(cl-defmethod gts-translate ((engine gts-deepl-engine) task rendercb) + (with-slots (text from to) task + (with-slots (auth-key parser) engine + (gts-do-request (gts-gen-url engine) + :headers `(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8") + ("Authorization" . ,(concat "DeepL-Auth-Key " auth-key))) + :data `(("text" . ,(gts-deepl-fill-input text)) + ("source_lang" . ,(gts-get-lang engine from)) + ("target_lang" . ,(gts-get-lang engine to))) + :done (lambda () + (gts-update-raw task (buffer-string)) + (gts-parse parser task) + (funcall rendercb)) + :fail (lambda (err) + (gts-render-fail task + (if (ignore-errors (= (caddar err) 403)) + "[403] http error, make sure your auth_key is correct" + err))))))) + + +;;; Parser + +(cl-defmethod gts-parse ((_ gts-deepl-parser) task) + (let* ((json (json-read-from-string (oref task raw))) + (str (mapconcat (lambda (r) (cdr (cadr r))) (cdar json) "\n")) + (filter (lambda (parsed) + (cl-loop for p in (gts-ensure-list parsed) + collect (gts-deepl-fill-output p) into ps + finally (return (if (cdr ps) ps (car ps))))))) + (gts-update-parsed task (decode-coding-string str 'utf-8) nil filter))) + + +(provide 'gts-engine-deepl) + +;;; gts-engine-deepl.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-engine-google-rpc.el b/elpa/go-translate-20221211.1327/gts-engine-google-rpc.el new file mode 100644 index 00000000..8c784c48 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-engine-google-rpc.el @@ -0,0 +1,207 @@ +;;; gts-engine-google-rpc.el --- Google translation with rpc api -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; http://translate.google.com, new RPC API + +;;; Code: + +(require 'gts-engine-google) + +(defcustom gts-google-rpc-base-url "https://translate.google.com" + "The base url of Google translate used by google-rpc engine. +you can customize it according to your country region." + :type 'string + :group 'go-translate) + + +;;; Components + +(defclass gts-google-rpc-parser (gts-google-parser) + ((tag :initform "Detail"))) + +(defclass gts-google-rpc-summary-parser (gts-google-summary-parser gts-google-rpc-parser) + ((tag :initform "Summary"))) + +(defclass gts-google-rpc-engine (gts-engine) + ((tag :initform "Google/RPC") + (sub-url :initform "/_/TranslateWebserverUi/data/batchexecute") + (parser :initform (gts-google-rpc-parser)) + + (rpc-translate :initform "MkEWBc") + (rpc-tts :initform "jQ1olc") + (rpc-sid :initform "FdrFJe") + (rpc-bl :initform "cfb2h"))) + + +;;; Engine + +(defvar gts-google-rpc-request-headers '(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8"))) + +(cl-defmethod gts-with-token ((engine gts-google-rpc-engine) done fail) + (with-slots (sub-url rpc-sid rpc-bl) engine + (gts-do-request gts-google-rpc-base-url + :done + (lambda () + (let* ((f-sid (progn + (re-search-forward (format "\"%s\":\"\\([^\"]*\\)\"" rpc-sid)) + (match-string 1))) + (bl (progn (re-search-forward (format "\"%s\":\"\\([^\"]*\\)\"" rpc-bl)) + (match-string 1))) + (url-tpl (lambda (rpcid lang) + (format "%s%s?%s" gts-google-rpc-base-url sub-url + (gts-format-params + `(("rpcids" . ,rpcid) + ("f.sid" . ,f-sid) + ("bl" . ,bl) + ("hl" . ,lang) + ("soc-app" . 1) + ("soc-platform" . 1) + ("soc-device" . 1) + ("_reqid" . ,(+ 1000 (random 9000))) + ("rt" . "c"))))))) + (funcall done url-tpl))) + :fail fail))) + +(cl-defmethod gts-translate ((engine gts-google-rpc-engine) task rendercb) + (gts-with-token engine + (lambda (url-tpl) + (with-slots (text from to) task + (with-slots (rpc-translate parser) engine + (gts-do-request (funcall url-tpl rpc-translate to) + :headers gts-google-rpc-request-headers + :data (format + "f.req=%s&" + (url-hexify-string + (let ((outer [[[rpcid inner nil "generic"]]]) + (inner [[text from to t][nil]])) + (setf (aref (aref inner 0) 0) text) + (setf (aref (aref inner 0) 1) from) + (setf (aref (aref inner 0) 2) to) + (setf (aref (aref (aref outer 0) 0) 0) rpc-translate) + (setf (aref (aref (aref outer 0) 0) 1) (json-encode inner)) + (json-encode outer)))) + :done (lambda () + (gts-update-raw task (buffer-string)) + (gts-parse parser task) + (funcall rendercb)) + :fail (lambda (err) + (gts-render-fail task err)))))) + (lambda (err) + (gts-render-fail task + (format "Error occurred when request for token.\n\n%s" err))))) + +(cl-defmethod gts-tts ((engine gts-google-rpc-engine) text lang) + (gts-with-token engine + (lambda (url-tpl) + (with-slots (rpc-tts) engine + (gts-do-request (funcall url-tpl rpc-tts "en-US") + :headers gts-google-rpc-request-headers + :data (format + "f.req=%s&" + (url-hexify-string + (let ((outer [[[rpcid inner nil "generic"]]]) + (inner [text lang nil nil])) + (setf (aref inner 0) text) + (setf (aref inner 1) lang) + (setf (aref (aref (aref outer 0) 0) 0) rpc-tts) + (setf (aref (aref (aref outer 0) 0) 1) (json-encode inner)) + (json-encode outer)))) + :done (lambda () + (let (beg end json code) + (re-search-forward "^[0-9]+$") + (setq beg (point)) + (re-search-forward "^\\([0-9]+\\)$") + (setq end (- (point) (length (match-string 1)))) + (setq json (json-read-from-string (string-trim (buffer-substring-no-properties beg end)))) + (when (string= (gts-aref-for json 0 0) "wrb.fr") + (setq code (aref (json-read-from-string (gts-aref-for json 0 2)) 0)) + (erase-buffer) + (insert code) + (base64-decode-region (point-min) (point-max)) + (gts-tts-speak-buffer-data)))) + :fail (lambda (err) (user-error "Error when TTS. %s" err))))) + (lambda (_) (user-error "Error occurred when request for token")))) + + +;;; Parser + +(cl-defmethod gts-resp-to-json ((_ gts-google-rpc-parser) resp) + "Convert the buffer RESP into JSON format." + (condition-case err + (with-temp-buffer + (let (beg end str json) + (insert resp) + (goto-char (point-min)) + (re-search-forward "^[0-9]+$") + (setq beg (point)) + (re-search-forward "^\\([0-9]+\\)$") + (setq end (- (point) (length (match-string 1)))) + (setq str + (decode-coding-string + (string-trim (buffer-substring-no-properties beg end)) + 'utf-8)) + (setq json (json-read-from-string str)) + (if (string= (aref (aref json 0) 0) "wrb.fr") + (let ((json-str (aref (aref json 0) 2))) + (json-read-from-string json-str)) + (error "No results found")))) + (error (user-error "Result conversion error (%s)" err)))) + +(cl-defmethod gts-result--brief ((_ gts-google-rpc-parser) json) + "Get the translation text from JSON." + (mapconcat + (lambda (item) + (if (ignore-errors (aref item 2)) + (format " %s" (aref item 0)) + (aref item 0))) + (gts-aref-for json 1 0 0 5) + "")) + +(cl-defmethod gts-result--sphonetic ((_ gts-google-rpc-parser) json) + "Get the text phonetic from JSON." + (gts-aref-for json 0 0)) + +(cl-defmethod gts-result--tphonetic ((_ gts-google-rpc-parser) json) + "Get the translation phonetic from JSON." + (gts-aref-for json 1 0 0 1)) + +(cl-defmethod gts-result--details ((_ gts-google-rpc-parser) json) + "Get the details from JSON. +Result style: ((noun (a (x y z))) (verb (b (m n o))))." + (cl-loop with dts = (ignore-errors (gts-aref-for json 3 5 0)) + for i across dts + collect + (cons + (aref i 0) + (cl-loop for j across (aref i 1) + collect + (cons + (aref j 0) + (cl-loop for k across (aref j 2) collect k)))))) + +(cl-defmethod gts-result--definitions ((_ gts-google-rpc-parser) json) + "Get the definitions from JSON. +Result style: ((noun (a b)) (verb (c d)))." + (cl-loop with defs = (ignore-errors (gts-aref-for json 3 1 0)) + for i across defs + collect + (cons + (aref i 0) + (cl-loop for j across (aref i 1) + collect + (cons (aref j 0) + (ignore-errors (aref j 1))))))) + +(cl-defmethod gts-result--suggestion ((_ gts-google-rpc-parser) json) + "Get the suggestion from JSON." + (ignore-errors + (replace-regexp-in-string "\\|\\|\\|" "" (gts-aref-for json 0 1 0 0 1)))) + + +(provide 'gts-engine-google-rpc) + +;;; gts-engine-google-rpc.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-engine-google.el b/elpa/go-translate-20221211.1327/gts-engine-google.el new file mode 100644 index 00000000..2ac39ba5 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-engine-google.el @@ -0,0 +1,424 @@ +;;; gts-engine-google.el --- Google translate module -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; http://translate.google.com + +;;; Code: + +(require 'gts-implements) + + +;;; Components + +(defclass gts-google-parser (gts-parser) + ((tag :initform "Detail"))) + +(defclass gts-google-summary-parser (gts-google-parser) + ((tag :initform "Summary"))) + +(defclass gts-google-engine (gts-engine) + ((tag :initform "Google") + (base-url :initform "http://translate.googleapis.com") + (sub-url :initform "/translate_a/single") + (token :initform (cons 430675 2721866130) :initarg token) ; hard code + (token-time :initform t) + (token-expired-time :initform (* 30 60)) + (parser :initform (gts-google-parser)))) + + +;;; Engine + +(defvar gts-google-request-headers '(("Connection" . "Keep-Alive"))) + +(cl-defmethod gts-gen-url ((engine gts-google-engine) text from to) + "Generate the url with TEXT, FROM and TO. Return a (url text from to) list." + (format "%s%s?%s" + (oref engine base-url) + (oref engine sub-url) + (mapconcat (lambda (p) + (format "%s=%s" (url-hexify-string (car p)) (url-hexify-string (cdr p)))) + `(("client" . "gtx") + ("ie" . "UTF-8") + ("oe" . "UTF-8") + ("dt" . "bd") + ("dt" . "ex") + ("dt" . "ld") + ("dt" . "md") + ("dt" . "qc") + ("dt" . "rw") + ("dt" . "rm") + ("dt" . "ss") + ("dt" . "t") + ("dt" . "at") + ("pc" . "1") + ("otf" . "1") + ("srcrom" . "1") + ("ssel" . "0") + ("tsel" . "0") + ("hl" . ,to) + ("sl" . ,from) + ("tl" . ,to) + ("q" . ,text) + ("tk" . ,(gts-google-tkk (oref engine token) text))) + "&"))) + +(cl-defmethod gts-token-available-p ((engine gts-google-engine)) + (with-slots (token token-time token-expired-time) engine + (and token + (or (eq token-time t) + (and token-time + (<= (float-time (time-subtract (current-time) token-time)) + token-expired-time)))))) + +(cl-defmethod gts-with-token ((engine gts-google-engine) done fail) + (with-slots (token token-time base-url) engine + (if (gts-token-available-p engine) + (funcall done) + (gts-do-request base-url + :headers gts-google-request-headers + :done (lambda () + (let ((tk (progn + (re-search-forward ",tkk:'\\([0-9]+\\)\\.\\([0-9]+\\)") + (cons (string-to-number (match-string 1)) + (string-to-number (match-string 2)))))) + (setf token tk) + (setf token-time (current-time)) + (funcall done))) + :fail fail)))) + +(cl-defmethod gts-translate ((engine gts-google-engine) task rendercb) + (gts-with-token engine + (lambda () + (with-slots (text from to) task + (gts-do-request (gts-gen-url engine text from to) + :headers gts-google-request-headers + :done (lambda () + (gts-update-raw task (buffer-string)) + (gts-parse (oref engine parser) task) + (funcall rendercb)) + :fail (lambda (err) + (gts-render-fail task err))))) + (lambda (err) + (gts-render-fail task + (format "Error when fetching Token-Key, check your network and proxy, or retry later\n\n%s" err))))) + +;; tts + +(cl-defmethod gts-tts-gen-urls ((engine gts-google-engine) text lang) + "Generate the tts urls for TEXT to LANGUAGE." + (cl-loop with texts = (gts-tts-text-splitter engine text) + for total = (length texts) + for index from 0 + for piece in texts + collect + (let ((params `(("ie" . "UTF-8") + ("client" . "gtx") + ("prev" . "input") + ("q" . ,text) + ("tl" . ,lang) + ("total" . ,(number-to-string total)) + ("idx" . ,(number-to-string index)) + ("textlen" . ,(number-to-string (length piece))) + ("tk" . ,(gts-google-tkk (oref engine token) piece))))) + (format "%s/translate_tts?%s" + (oref engine base-url) + (mapconcat (lambda (p) + (format "%s=%s" + (url-hexify-string (car p)) + (url-hexify-string (cdr p)))) + params "&"))))) + +(cl-defmethod gts-tts-text-splitter ((_ gts-google-engine) text) + "Split TEXT by maxlen at applicable point for translating. +Code from `google-translate', maybe improve it someday." + (let (result (maxlen 200)) + (if (or (null maxlen) (<= maxlen 0)) + (push text result) + ;; split long text? + (with-temp-buffer + (save-excursion (insert text)) + ;; strategy to split at applicable point + ;; 1) fill-region remaining text by maxlen + ;; 2) find end of sentence, end of punctuation, word boundary + ;; 3) consume from remaining text between start and (2) + ;; 4) repeat + (let ((fill-column (* maxlen 3)) + (sentence-end-double-space nil) + (pos (point-min))) + (while (< pos (point-max)) + (save-restriction + (narrow-to-region pos (point-max)) + (fill-region pos (point-max)) + (let ((limit (+ pos maxlen))) + (if (>= limit (point-max)) + (setq limit (point-max)) + (goto-char limit) + ;; try to split at end of sentence + (if (> (backward-sentence) pos) + (setq limit (point)) + ;; try to split at end of punctuation + (goto-char limit) + (if (re-search-backward "[,、]" pos t) + (setq limit (1+ (point))) ; include punctuation + (goto-char limit) + ;; try to split at word boundary + (forward-word-strictly -1) + (when (> (point) pos) + (setq limit (point)))))) + (push (buffer-substring-no-properties pos limit) result) + (goto-char limit) + (setq pos limit))))))) + (reverse result))) + +(cl-defmethod gts-tts ((engine gts-google-engine) text lang) + (let ((urls (gts-tts-gen-urls engine text lang)) + (speaker (split-string gts-tts-speaker))) + (with-temp-message "Speaking..." + (gts-tts-try-interrupt-playing-process) + (apply #'call-process (car speaker) nil nil nil (append (cdr speaker) urls))))) + + +;;; Parser + +;; detail-mode, use as default + +(cl-defmethod gts-parse ((parser gts-google-parser) task) + (let* ((json (gts-resp-to-json parser (oref task raw))) + (brief (gts-result--brief parser json)) + (sphonetic (gts-result--sphonetic parser json)) + (tphonetic (gts-result--tphonetic parser json)) + (details (gts-result--details parser json)) + (definitions (gts-result--definitions parser json)) + (suggestion (gts-result--suggestion parser json)) + (suggestionp (> (length suggestion) 0)) tbeg tend) + (cl-flet ((phonetic (ph) + (if (and (or definitions definitions) (> (length ph) 0)) + (propertize (format " [%s]" ph) 'face 'gts-google-buffer-phonetic-face) + "")) + (headline (line) + (propertize (format "[%s]\n" line) 'face 'gts-google-buffer-headline-face))) + (with-temp-buffer + ;; suggestion + (when suggestionp + (insert (propertize "Do you mean:" 'face 'gts-google-buffer-suggestion-desc-face) " " + (propertize suggestion 'face 'gts-google-buffer-suggestion-text-face) "?\n\n")) + ;; phonetic & translate + (if (or details definitions) + (progn + (insert (if suggestionp suggestion (oref (oref task translator) text))) + (insert (phonetic sphonetic) " ") + (setq tbeg (point)) + (insert (propertize brief 'face 'gts-google-buffer-brief-result-face)) + (setq tend (point)) + (insert (phonetic tphonetic) "\n\n")) + (insert brief)) + ;; details + (when details + (insert (headline "Details")) + (cl-loop for (label . items) in details + unless (= 0 (length label)) + do (insert (format "\n%s:\n" label)) + do (cl-loop with index = 0 + for trans in items + do (insert + (format "%2d. " (cl-incf index)) + (car trans) + " (" (mapconcat #'identity (cdr trans) ", ") ")" + "\n"))) + (insert "\n")) + ;; definitions + (when definitions + (insert (headline "Definitions")) + (cl-loop for (label . items) in definitions + unless (= 0 (length label)) + do (insert (format "\n%s:\n" label)) + do (cl-loop with index = 0 + for (exp . eg) in items + do (insert (format "%2d. " (cl-incf index)) exp) + when (> (length eg) 0) + do (insert + "\n > " + (propertize (or eg "") 'face 'gts-google-buffer-detail-demo-face)) + do (insert "\n")))) + ;; at last, fill and return + (gts-update-parsed task (buffer-string) (list :tbeg tbeg :tend tend)))))) + +;; summary-mode + +(cl-defmethod gts-parse ((parser gts-google-summary-parser) task) + (let* ((json (gts-resp-to-json parser (oref task raw))) + (result (string-trim (gts-result--brief parser json)))) + (gts-update-parsed task result (list :tbeg 1 :tend (+ 1 (length result)))))) + +;; Extract results from response + +(cl-defmethod gts-resp-to-json ((_ gts-google-parser) resp) + "Convert the buffer RESP into JSON." + (condition-case err + (json-read-from-string (decode-coding-string resp 'utf-8)) + (error (user-error "Result conversion error: %s" err)))) + +(cl-defmethod gts-result--brief ((_ gts-google-parser) json) + "Get the translation text from JSON." + (mapconcat (lambda (item) (aref item 0)) (aref json 0) "")) + +(cl-defmethod gts-result--sphonetic ((_ gts-google-parser) json) + "Get the text phonetic from JSON." + (mapconcat (lambda (item) (if (> (length item) 3) (aref item 3) "")) (aref json 0) "")) + +(cl-defmethod gts-result--tphonetic ((_ gts-google-parser) json) + "Get the translation phonetic from JSON." + (mapconcat (lambda (item) (if (> (length item) 2) (aref item 2) "")) (aref json 0) "")) + +(cl-defmethod gts-result--details ((_ gts-google-parser) json) + "Get the details from JSON. +Result style: ((noun (a (x y z))) (verb (b (m n o))))." + (cl-loop for i across (aref json 1) + collect + (cons + (aref i 0) + (cl-loop for j across (aref i 2) + collect + (cons + (aref j 0) + (cl-loop for k across (aref j 1) collect k)))))) + +(cl-defmethod gts-result--definitions ((_ gts-google-parser) json) + "Get the definitions from JSON. +Result style: ((noun (a b)) (verb (c d)))." + (cl-loop with defs = (ignore-errors (aref json 12)) + for i across defs + collect + (cons + (aref i 0) + (cl-loop for j across (aref i 1) + collect + (cons + (aref j 0) + (ignore-errors (aref j 2))))))) + +(cl-defmethod gts-result--suggestion ((_ gts-google-parser) json) + "Get the suggestion from JSON." + (let ((info (aref json 7))) (unless (seq-empty-p info) (aref info 1)))) + + +;;; Token Key algorithm (deprecated) + +;; This algorithm is from `google-translate' project. +;; https://github.com/atykhonov/google-translate/blob/master/google-translate-tk.el + +(defvar gts-google-token--bit-v-len 32) + +(defun gts-google-token--bit-v-2comp (v) + "Return the two's complement of V." + (let* ((vc (vconcat v)) + (len (length vc))) + ;; Complement of v + (cl-loop for i from 0 below len do + (aset vc i (logxor (aref vc i) 1))) + ;; vc = complement of v + 1 + (cl-loop for i downfrom (1- len) to 0 + do (aset vc i (logxor (aref vc i) 1)) + when (> (aref vc i) 0) return nil) + vc)) + +(defun gts-google-token--number-to-bit-v (n) + "Return a bit vector from N." + (if (< n 0) (gts-google-token--bit-v-2comp + (gts-google-token--number-to-bit-v (abs n))) + (let ((v (make-vector gts-google-token--bit-v-len 0))) + (cl-loop for i downfrom (1- gts-google-token--bit-v-len) to 0 + with q + when (< n 1) return nil do + (setq q (ffloor (* n 0.5))) + (aset v i (floor (- n (* 2.0 q)))) + (setq n q)) + v))) + +(defun gts-google-token--bit-v-to-number (v) + "Return a floating-point number from V." + (if (and (> (aref v 0) 0) + ;; Exclude [1 0 ... 0] + (cl-loop for i from 1 below gts-google-token--bit-v-len + thereis (> (aref v i) 0))) + (- (gts-google-token--bit-v-to-number (gts-google-token--bit-v-2comp v))) + (funcall (if (> (aref v 0) 0) #'- #'+) + (cl-reduce (lambda (acc e) (+ (* acc 2.0) e)) + v :initial-value 0.0)))) + +(defun gts-google-token--logfn (fn n1 n2) + "Helper function for logical FN with N1 and N2." + (let ((v1 (gts-google-token--number-to-bit-v n1)) + (v2 (gts-google-token--number-to-bit-v n2)) + (v (make-vector gts-google-token--bit-v-len 0))) + (cl-loop for i from 0 below gts-google-token--bit-v-len do + (aset v i (funcall fn (aref v1 i) (aref v2 i)))) + (gts-google-token--bit-v-to-number v))) + +(defun gts-google-token--logand (n1 n2) + "Return a floating-point number from N1 and N2." + (gts-google-token--logfn #'logand n1 n2)) + +(defun gts-google-token--logxor (n1 n2) + "Return a floating-point number from N1 and N2." + (gts-google-token--logfn #'logxor n1 n2)) + +(defun gts-google-token--lsh (n d) + "Return a floating-point number. +Shift the bits in N to the left or rihgt D places. +D is an integer." + (let ((v (gts-google-token--number-to-bit-v n)) + (v-result (make-vector gts-google-token--bit-v-len 0))) + (if (< d 0) + ;; Shift Right Logical + (cl-loop for i from (abs d) below gts-google-token--bit-v-len + for j from 0 do + (aset v-result i (aref v j))) + ;; Shift Left Logical + (cl-loop for i from d below gts-google-token--bit-v-len + for j from 0 do + (aset v-result j (aref v i)))) + (gts-google-token--bit-v-to-number v-result))) + +(defun gts-google-token--gen-rl (a b) + "Gen rl from A and B." + (cl-loop for c from 0 below (- (length b) 2) by 3 + for d = (aref b (+ c 2)) do + (setq d (if (>= d ?a) (- d 87) (- d ?0))) + (setq d (if (= (aref b (1+ c)) ?+) + (gts-google-token--lsh a (- d)) + (gts-google-token--lsh a d))) + (setq a (if (= (aref b c) ?+) + (gts-google-token--logand (+ a d) 4294967295.0) + (gts-google-token--logxor a d)))) + a) + +(defun gts-google-tkk (token text) + "Calculate the Token for search TEXT. + +It will use the tkk from Google translate page." + (let* ((b (car token)) + (d1 (cdr token)) + (ub "+-3^+b+-f") + (vb "+-a^+6") + (a (cl-loop for c across (encode-coding-string text 'utf-8) + for rr = (gts-google-token--gen-rl (+ (or rr b) c) vb) + finally (return rr)))) + (setq a (gts-google-token--gen-rl a ub)) + (setq a (gts-google-token--logxor a d1)) + (if (< a 0) (setq a (+ (gts-google-token--logand a 2147483647.0) 2147483648.0))) + (setq a (ffloor (mod a 1e6))) + (format "%s.%s" + (car (split-string (number-to-string a) "\\.")) + (car (split-string (number-to-string + (gts-google-token--logxor a b)) + "\\."))))) + + +(provide 'gts-engine-google) + +;;; gts-engine-google.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-engine-stardict.el b/elpa/go-translate-20221211.1327/gts-engine-stardict.el new file mode 100644 index 00000000..772a4b2b --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-engine-stardict.el @@ -0,0 +1,60 @@ +;;; gts-engine-stardict.el --- StarDict -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; Engine for sdcv (StarDict Console Version). +;; +;; sdcv is an offline translate software. It can be used when no network. +;; +;; Make sure sdcv is installed on your system: +;; +;; sudo pacman -S sdcv +;; +;; Then download dictionary data to ~/.stardict/dic or /usr/share/stardict/dic: +;; +;; # For example from http://download.huzheng.org: +;; +;; mkdir -p ~/.stardict/dic +;; cd ~/.stardict/dic +;; wget http://download.huzheng.org/zh_CN/stardict-langdao-ce-gb-2.4.2.tar.bz2 +;; wget http://download.huzheng.org/zh_CN/stardict-langdao-ce-gb-2.4.2.tar.bz2 +;; tar xvf stardict-langdao-ec-gb-2.4.2.tar.bz2 +;; tar xvf stardict-langdao-ce-gb-2.4.2.tar.bz2 +;; sdcv -l +;; +;; TODO: Provide more options and a better parser. + +;;; Code: + +(require 'gts-implements) + +(defclass gts-stardict-engine (gts-engine) + ((tag :initform "StarDict") + (parser :initform (gts-parser)))) + +(defcustom gts-stardict-program "sdcv" + "Executable command of sdcv (StarDict Console Version)." + :type 'string + :group 'go-translate) + +(cl-defmethod gts-translate ((engine gts-stardict-engine) task rendercb) + (let* ((text (oref task text)) + (parser (oref engine parser)) + (result (with-temp-buffer + (require 'ansi-color) + (apply #'call-process gts-stardict-program nil t nil + (list "--non-interactive" "--color" text)) ;--json-output + (if (string-equal (buffer-substring 1 16) "Nothing similar") + "No translation result found, sorry :(" + (ansi-color-apply (buffer-string)))))) + (gts-update-raw task result) + (gts-parse parser task) + (funcall rendercb))) + + +(provide 'gts-engine-stardict) + +;;; gts-engine-stardict.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-engine-youdao.el b/elpa/go-translate-20221211.1327/gts-engine-youdao.el new file mode 100644 index 00000000..594d3452 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-engine-youdao.el @@ -0,0 +1,58 @@ +;;; gts-engine-youdao.el --- YouDao Dict -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; 有道词典 (dict.youdao.com), A chinese translation website. +;; +;; This engine is only for chinese user. +;; > 此引擎仅供中文翻译使用 +;; +;; Simply implement using EWW to do the parsing job for now. I am too lazy to parse and extract the html results. +;; > 懒得去解析、组装 html，所以暂时直接借用 eww 的解析结果 +;; > 权作应急使用，*也许* 以后会增加更完善的 parser 方案 + +;;; Code: + +(require 'gts-implements) + +(defclass gts-youdao-dict-eww-parser (gts-parser) + ((tag :initform "EWW"))) + +(defclass gts-youdao-dict-engine (gts-engine) + ((tag :initform "有道词典") + (url :initform "https://dict.youdao.com/result?word=%s&lang=%s") + (parser :initform (gts-youdao-dict-eww-parser)))) + +(cl-defmethod gts-translate ((engine gts-youdao-dict-engine) task rendercb) + (with-slots (text from to meta) task + (with-slots (url parser) engine + (let* ((lang (cond ((string-equal from "zh") to) + ((string-equal to "zh") from) + (t (user-error "只支持中文跟其他语言之间的翻译")))) + (url (format url (url-hexify-string text) (url-hexify-string lang)))) + (setf meta (list :url url)) + (gts-do-request url + :done (lambda () + (gts-update-raw task (buffer-string)) ; html format response + (gts-parse parser task) + (funcall rendercb)) + :fail (lambda (err) + (gts-render-fail task err))))))) + +(cl-defmethod gts-parse ((_ gts-youdao-dict-eww-parser) task) + (with-slots (raw meta) task + (with-temp-buffer + (let ((buf (current-buffer))) + (with-temp-buffer + (require 'eww) + (insert "Content-type: text/html; charset=utf-8\n\n" raw) + (eww-render nil (plist-get meta :url) nil buf)) + (gts-update-parsed task (buffer-string) meta))))) + + +(provide 'gts-engine-youdao) + +;;; gts-engine-youdao.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-faces.el b/elpa/go-translate-20221211.1327/gts-faces.el new file mode 100644 index 00000000..107b4ed9 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-faces.el @@ -0,0 +1,124 @@ +;;; gts-faces.el --- Face definitions -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; The faces and colors. + +;;; Code: + +(require 'gts-core) + +(defgroup go-translate-faces nil + "The faces for this framework." + :group 'go-translate) + + +;;; Common + +(defface gts-logger-buffer-tag-face '((t :inherit font-lock-comment-face)) + "Used in the logger buffer tag keyword." + :group 'go-translate-faces) + +(defface gts-logger-buffer-timestamp-face '((t :foreground "grey")) + "Used in the logger buffer timestamp keyword." + :group 'go-translate-faces) + +(defface gts-render-buffer-header-line-lang-face '((t :inherit font-lock-keyword-face)) + "Used in the buffer's header-line-format, from/to." + :group 'go-translate-faces) + +(defface gts-render-buffer-header-line-desc-face '((t :inherit font-lock-variable-name-face)) + "Used in the buffer's header-line-format, description." + :group 'go-translate-faces) + +(defface gts-render-buffer-error-face '((t :inherit font-lock-warning-face)) + "Used in the buffer's error text." + :group 'go-translate-faces) + +(defface gts-render-buffer-source-face '((t :inherit font-lock-string-face)) + "Used in the buffer's source." + :group 'go-translate-faces) + +(defface gts-render-buffer-me-header-backgroud-face '((t :background "slategray" :foreground "white" :extend t)) + "Used in the buffer's multiple engine separator." + :group 'go-translate-faces) + + +;;; Google Buffer Render + +(defface gts-google-buffer-headline-face '((t :inherit font-lock-function-name-face :weight bold)) + "Propertize the headline in buffer rendering." + :group 'go-translate-faces) + +(defface gts-google-buffer-phonetic-face '((t :inherit font-lock-string-face :slant normal)) + "Propertize the phonetic in buffer rendering." + :group 'go-translate-faces) + +(defface gts-google-buffer-suggestion-desc-face '((t :inherit font-lock-warning-face)) + "Propertize the suggestion description in buffer rendering." + :group 'go-translate-faces) + +(defface gts-google-buffer-suggestion-text-face '((t :slant italic :underline t)) + "Propertize the phonetic text in buffer rendering." + :group 'go-translate-faces) + +(defface gts-google-buffer-brief-result-face '((t :weight bold)) + "Propertize the brief result in buffer rendering." + :group 'go-translate-faces) + +(defface gts-google-buffer-source-face '((t :inherit font-lock-string-face)) + "Propertize the source in buffer rendering." + :group 'go-translate-faces) + +(defface gts-google-buffer-detail-demo-face '((t :inherit font-lock-doc-face)) + "Propertize the detail demo in buffer rendering." + :group 'go-translate-faces) + + +;;; Posframe Render + +(defcustom gts-pop-posframe-forecolor "white" + "Default foreground color of pop posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gts-pop-posframe-backcolor "black" + "Default background color of pop posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gts-pin-posframe-forecolor nil + "Default foreground color of pin posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gts-pin-posframe-backcolor nil + "Default background color of pin posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gts-pin-posframe-bdcolor "#000000" + "Default border color of pin posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gts-pin-posframe-fringe-color nil + "Used in the posframe pip buffer fringe color." + :type 'string + :group 'go-translate-faces) + +(defface gts-pop-posframe-me-header-face '((t :foreground "grey")) + "Used in the posframe pop buffer engine header." + :group 'go-translate-faces) + +(defface gts-pop-posframe-me-header-2-face '((t (:foreground "#666666" :underline t :extend t))) + "Used in the posframe pop buffer engine header." + :group 'go-translate-faces) + + +(provide 'gts-faces) + +;;; gts-faces.el ends here diff --git a/elpa/go-translate-20221211.1327/gts-implements.el b/elpa/go-translate-20221211.1327/gts-implements.el new file mode 100644 index 00000000..fe60a220 --- /dev/null +++ b/elpa/go-translate-20221211.1327/gts-implements.el @@ -0,0 +1,647 @@ +;;; gts-implements.el --- Component implements -*- lexical-binding: t -*- + +;; Copyright (C) 2021 lorniu +;; SPDX-License-Identifier: MIT + +;;; Commentary: + +;; Builtin implements of basic components + +;;; Code: + +(require 'cl-lib) +(require 'url) +(require 'json) +(require 'gts-core) +(require 'gts-faces) + + +;;; [Logger] Log all to a standalone buffer + +(defclass gts-buffer-logger (gts-logger) + ((buffer :initarg buf :initform nil))) ; dont set :initarg to buffer, it will make an error on emacsv27. + +(defvar gts-logger-buffer-name " *gts-logger*") + +(cl-defmethod gts-log ((logger gts-buffer-logger) tag msg) + (with-current-buffer (get-buffer-create (or (oref logger buffer) gts-logger-buffer-name)) + (goto-char (point-max)) + (if (or (= (length msg) 0) (string= msg "\n")) + (insert "") + (insert + (propertize (cl-subseq (format "%-.1f" (time-to-seconds)) 6) 'face 'gts-logger-buffer-timestamp-face) + " " + (propertize (concat "[" tag "] ") 'face 'gts-logger-buffer-tag-face)) + (insert msg)) + (insert "\n"))) + +(setq gts-default-logger (gts-buffer-logger)) + + +;;; [Cacher] Cache in the memory + +(defclass gts-memory-cacher (gts-cacher) () + "Cache in the memory.") + +(cl-defmethod gts-cache-get ((cacher gts-memory-cacher) task) + (when gts-cache-enable + (with-slots (caches expired) cacher + (let ((key (gts-cache-key cacher task))) + (when-let ((cache (assoc key caches))) + (when (> (cddr cache) (time-to-seconds)) + (gts-do-log 'memory-cacher (format "%s: get from cache %s (%s)" (oref task id) key (length caches))) + (cadr cache))))))) + +(cl-defmethod gts-cache-set ((cacher gts-memory-cacher) task result) + (when gts-cache-enable + (with-slots (caches expired) cacher + (let* ((key (gts-cache-key cacher task)) + (cache (assoc key caches)) + (text (oref task text)) + (etime + ;; sentence with shorter expired time, but word with longer. + (if (string-match-p "[[:space:]\n]" text) + (+ (time-to-seconds) gts-cache-expired-factor) + (+ (time-to-seconds) (* 100 gts-cache-expired-factor))))) + (if cache + (progn + (setf (cadr cache) result) + (setf (cddr cache) etime) + (gts-do-log 'memory-cacher (format "%s: update cache %s (%s)" (oref task id) key (length caches)))) + (oset cacher caches (cons (cons key (cons result etime)) caches)) + (gts-do-log 'memory-cacher (format "%s: add to cache %s (%s)" (oref task id) key (length caches)))) + (gts-clear-expired cacher))))) + +(setq gts-default-cacher (gts-memory-cacher)) + + +;;; [Http Client] implement with builtin `url.el'. +;; This will be used as the default http client. + +(defclass gts-url-http-client (gts-http-client) ()) + +(defcustom gts-user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.75 Safari/537.36" + "The user agent used when send a request." + :type 'string + :group 'go-translate) + +(defvar url-http-end-of-headers) + +(cl-defmethod gts-request ((_ gts-url-http-client) url &key done fail data headers) + "Request URL with DATA and HEADERS asynchronous. +Execute DONE when success, or FAIL when failed." + (cl-assert (and url done fail)) + (let ((url-debug gts-debug-p) + (url-user-agent gts-user-agent) + (url-request-extra-headers headers) + (url-request-method (if data "POST" "GET")) + (url-request-data data)) + (url-retrieve url (lambda (status) + (unwind-protect + (if-let ((err (cond + ((eq (car status) :error) (cadr status)) + ((null url-http-end-of-headers) "Nothing responsed from server")))) + (funcall fail err) + (when done + (delete-region (point-min) url-http-end-of-headers) + (funcall done))) + (kill-buffer))) + nil t))) + +(setq gts-default-http-client (gts-url-http-client)) ; use this as default + + +;;; [Render] buffer render + +(defclass gts-buffer-render (gts-render) ()) + +(defcustom gts-split-width-threshold 80 + "Threshold width for window horizontal split." + :group 'go-translate + :type '(choice + (const :tag "Disable" nil) + (integer :tag "Threshold"))) + +(defcustom gts-buffer-follow-p nil + "If t then pop to the result window after translation." + :type 'boolean + :group 'go-translate) + +(defcustom gts-buffer-name "*Go-Translate*" + "The name of translation result buffer." + :type 'string + :group 'go-translate) + +(defcustom gts-buffer-window-config nil + "Window configuration used by the result buffer window. + +For example, set to: + + \\='((display-buffer-reuse-window display-buffer-in-side-window) + (side . right)) + +will force opening in right side window." + :type 'list + :group 'go-translate) + +(defcustom gts-buffer-render-task-header-function #'gts-buffer-render-task-header + "Function used to render the task header when in multiple engines's query." + :type 'function + :group 'go-translate) + +(defvar-local gts-buffer-translator nil) +(defvar-local gts-buffer-keybinding-messages nil) +(defvar-local gts-buffer-local-map nil) + +(cl-defmacro gts-buffer-set-key ((key &optional desc) form) + "Helper for define KEY in buffer." + (declare (indent 1)) + `(progn (define-key gts-buffer-local-map + (kbd ,key) + ,(if (equal 'function (car form)) `,form `(lambda () (interactive) ,form))) + (when ,desc + (cl-delete ,key gts-buffer-keybinding-messages :key #'car :test #'string=) + (push (cons ,key ,desc) gts-buffer-keybinding-messages)))) + +(defun gts-buffer-init-header-line (path &optional desc) + "Setup header line format. +It will show the basic information of the translation, +including PATH and other DESC." + (setq header-line-format + (list + " " + "[" (propertize (car path) 'face 'gts-render-buffer-header-line-lang-face) "]" + (if desc (concat " ― " (propertize desc 'face 'gts-render-buffer-header-line-desc-face)) "") + " → " + "[" (propertize (cdr path) 'face 'gts-render-buffer-header-line-lang-face) "]" + " (" (propertize "h" 'face 'font-lock-type-face) " for help)" + " " + "Loading..."))) + +(defun gts-buffer-change-header-line-state (type) + "Update header line according TYPE." + (cl-case type + (done + (when (string-equal (car (last header-line-format)) "Loading...") + (setq header-line-format (butlast header-line-format)))))) + +(defun gts-buffer-display-or-focus-buffer (buffer) + "Only display the BUFFER, or display and focus." + (with-current-buffer buffer + (if gts-buffer-follow-p (pop-to-buffer buffer) + (display-buffer buffer)))) + +(defun gts-buffer-ensure-a-blank-line-at-beginning (buffer) + "Ensure a blank line at beginning of BUFFER." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (save-excursion + (let ((m (mark-marker))) + (goto-char (point-min)) + (unless (equal (char-after) ?\n) + (insert "\n")) + (when (ignore-errors (= (marker-position m) 1)) + (set-marker m (point)))) + (set-buffer-modified-p nil))))) + +(defun gts-childframe-of-buffer (&optional buffer) + "Get the childframe of BUFFER if it exists, or return nil." + (let ((cf (window-frame (get-buffer-window buffer t)))) + (when (frame-parameter cf 'parent-frame) cf))) + +(defun gts-buffer-render-task-header (engine-tag parser-tag) + (concat (propertize + (format "%s %s\n" engine-tag (if parser-tag (format "(%s) " parser-tag) "")) + 'face 'gts-render-buffer-me-header-backgroud-face))) + +(defun gts-render-buffer-prepare (buffer translator) + (with-current-buffer (get-buffer-create buffer) + (let ((inhibit-read-only t) + (engines (gts-get translator 'engines))) + (with-slots (text path) translator + ;; setup + (deactivate-mark) + (visual-line-mode -1) + (font-lock-mode 1) + (setq-local cursor-type 'hbar) + (setq-local cursor-in-non-selected-windows nil) + (setq-local gts-buffer-translator translator) + ;; headline + (gts-buffer-init-header-line path (unless (cdr engines) (oref (car engines) tag))) + ;; source text + (erase-buffer) + (unless (gts-childframe-of-buffer (current-buffer)) (insert "\n")) ; except childframe + (insert text) + ;; keybinds + (setq gts-buffer-local-map (make-sparse-keymap)) + (gts-buffer-set-key ("x" "Reverse Path") + (gts-translate translator text (cons (cdr path) (car path)))) + (gts-buffer-set-key ("M-p" "Prev Path") + (gts-translate translator text (gts-next-path (gts-get translator 'picker) text path t))) + (gts-buffer-set-key ("M-n" "Next Path") + (gts-translate translator text (gts-next-path (gts-get translator 'picker) text path))) + (gts-buffer-set-key ("g" "Refresh") + (gts-translate translator text path)) + (gts-buffer-set-key ("y" "TTS") + (if-let ((task (get-text-property (point) 'task))) + (gts-do-tts text (car path) (oref task engine)) + (message "[TTS] No engine found at point"))) + (gts-buffer-set-key ("O" "Open Externally") + (when-let ((task (get-text-property (point) 'task))) + (let* ((meta (oref task meta)) (url (plist-get meta :url))) + (cond (url (browse-url url) (message "Opening %s... Done!" url)) + (t (message "Don't know how to open externally for this.")))))) + (gts-buffer-set-key ("C" "Clean Cache") + (gts-clear-all gts-default-cacher)) + (gts-buffer-set-key ("t" "Toggle-Follow") + (let ((state (if (setq gts-buffer-follow-p (not gts-buffer-follow-p)) "allowed" "disabled"))) + (message "Now, buffer following %s." state))) + (gts-buffer-set-key ("q" "Quit") #'kill-buffer-and-window) + (gts-buffer-set-key ("p") #'previous-line) + (gts-buffer-set-key ("n") #'next-line) + (gts-buffer-set-key ("C-g") + (unwind-protect (gts-tts-try-interrupt-playing-process) + (keyboard-quit))) + (gts-buffer-set-key ("h") + (message (mapconcat + (lambda (kd) (concat (propertize (car kd) 'face 'font-lock-keyword-face) ": " (cdr kd))) + (reverse gts-buffer-keybinding-messages) " "))) + (gts-buffer-set-key ("C-x C-q") + (progn (read-only-mode -1) + (use-local-map nil) + (local-set-key (kbd "C-x C-q") + (lambda () + (interactive) + (read-only-mode 1) + (use-local-map gts-buffer-local-map))))) + (read-only-mode 1) + (use-local-map gts-buffer-local-map) + ;; execute the hook if exists + (run-hooks 'gts-after-buffer-prepared-hook))))) + +(defun gts-render-buffer (buffer task) + "For single engine translation." + (when-let ((inhibit-read-only t) + (buf (get-buffer buffer))) + (with-current-buffer buf + (with-slots (err parsed meta engine translator) task + ;; error + (if err + (progn + (goto-char (point-max)) + (insert (propertize (format "\n\n%s" err) 'face 'gts-render-buffer-error-face))) + (erase-buffer) + (cond + ;; content (non-split) + ((stringp parsed) + (let ((tbeg (plist-get meta :tbeg)) + (tend (plist-get meta :tend))) + (unless tbeg + (insert (propertize (oref translator text) 'face 'gts-render-buffer-source-face) "\n\n")) + (unless tbeg (setq tbeg (point))) + (insert parsed) + (unless tend (setq tend (point))) + ;; try set mark in beginning of the translate result, + ;; and set currsor position in end of the translate result, + ;; so you can quick select the translate result with C-x C-x. + (when (not (gts-childframe-of-buffer buf)) ; when not childframe + (push-mark tend 'nomsg) + (goto-char tbeg) + (set-window-point (get-buffer-window buf t) tbeg)))) + ;; content (split) + (t (cl-loop for idx from 0 + for src in (gts-get translator 'sptext) + for tar in parsed + concat (concat (propertize src 'face 'gts-render-buffer-source-face) "\n\n" tar "\n\n") into res + finally (insert res))))) + ;; update states + (set-buffer-modified-p nil) + (gts-buffer-change-header-line-state 'done) + (put-text-property (point-min) (point-max) 'task task) + ;; execute the hook if exists + (run-hooks 'gts-after-buffer-render-hook)) + buf))) + +(defun gts-render-buffer-multi-engines (buffer task) + "For multiple engines translation." + (when-let ((inhibit-read-only t) + (buf (get-buffer buffer))) + (with-slots (from to translator) task + (with-slots (text task-queue version) translator + (with-current-buffer buf + (when (equal (oref gts-buffer-translator version) version) + (erase-buffer) + (insert (propertize (format "\n%s\n\n" text) 'face 'gts-render-buffer-source-face)) + ;; content + (save-excursion + (dolist (task task-queue) + (with-slots (err parsed meta engine) task + (let* ((result (if (or err (stringp parsed)) parsed + (string-join parsed "\n\n"))) + (header (funcall gts-buffer-render-task-header-function + (oref engine tag) + (oref (oref engine parser) tag))) + (content (cond + (err + (concat header (propertize (format "\n%s\n\n" err) 'face 'gts-render-buffer-error-face))) + ((string-empty-p result) + (concat header "\nLoading...\n\n")) + (t (concat header "\n" (string-trim result) "\n\n"))))) + (put-text-property 0 (length content) 'task task content) + (insert content))))) + ;; states + (set-buffer-modified-p nil) + ;; all tasks finished + (when (= (oref translator state) 3) + ;; cursor + (unless (gts-childframe-of-buffer buf) + (set-window-point (get-buffer-window buf t) (save-excursion (forward-line 2) (point)))) + ;; state + (gts-buffer-change-header-line-state 'done)) + ;; execute the hook if exists + (run-hooks 'gts-after-buffer-multiple-render-hook))) + buf)))) + +(cl-defmethod gts-pre ((_ gts-buffer-render) translator) + ;; init and setup + (gts-render-buffer-prepare gts-buffer-name translator) + ;; display + (let ((split-width-threshold (or gts-split-width-threshold split-width-threshold))) + (display-buffer gts-buffer-name gts-buffer-window-config))) + +(cl-defmethod gts-out ((_ gts-buffer-render) task) + ;; render & display + (when-let ((buf (gts-render-buffer gts-buffer-name task))) + (gts-buffer-ensure-a-blank-line-at-beginning buf) + (gts-buffer-display-or-focus-buffer buf))) + +(cl-defmethod gts-me-out ((_ gts-buffer-render) task) + ;; render & display + (when-let ((buf (gts-render-buffer-multi-engines gts-buffer-name task))) + (when (= (oref (oref task translator) state) 3) + (gts-buffer-display-or-focus-buffer buf)))) + + +;;; [Render] Child-Frame Render (Popup Mode) +;; implements via package Posframe, you should install it before use this + +(defclass gts-posframe-pop-render (gts-render) + ((width :initarg :width :initform 100) + (height :initarg :height :initform 15) + (forecolor :initarg :forecolor :initform nil) + (backcolor :initarg :backcolor :initform nil) + (padding :initarg :padding :initform 12)) + "Pop up a childframe to show the result. +The frame will disappear when do do anything but focus in it. +Manually close the frame with `q'.") + +(require 'posframe nil t) +(declare-function posframe-show "ext:posframe.el" t t) +(declare-function posframe-delete "ext:posframe.el" t t) +(declare-function posframe-hide "ext:posframe.el" t t) +(declare-function posframe-refresh "ext:posframe.el" t t) +(declare-function posframe-poshandler-frame-top-right-corner "ext:posframe.el" t t) + +(defcustom gts-posframe-pop-render-buffer " *GTS-Pop-Posframe*" + "Buffer name of Pop Posframe." + :type 'string + :group 'go-translate) + +(defvar gts-posframe-pop-render-timeout 30) +(defvar gts-posframe-pop-render-poshandler nil) + +(defun gts-posframe-init-header-line (from to) + (setq header-line-format + (list "[" (propertize from 'face 'gts-render-buffer-header-line-lang-face) "]" + " → " + "[" (propertize to 'face 'gts-render-buffer-header-line-lang-face) "]"))) + +(defun gts-posframe-render-auto-close-handler () + "Close the pop-up posframe window." + (interactive) + (unless (or (and gts-current-command + (member this-command (list gts-current-command #'exit-minibuffer))) + (and gts-posframe-pop-render-buffer + (string= (buffer-name) gts-posframe-pop-render-buffer))) + (ignore-errors (posframe-delete gts-posframe-pop-render-buffer)) + (remove-hook 'post-command-hook #'gts-posframe-render-auto-close-handler))) + +(cl-defmethod gts-pre ((render gts-posframe-pop-render) translator) + (with-slots (width height forecolor backcolor padding) render + (let ((inhibit-read-only t) + (buf gts-posframe-pop-render-buffer)) + (posframe-show buf + :string "Loading..." + :timeout gts-posframe-pop-render-timeout + :max-width width + :max-height height + :foreground-color (or forecolor gts-pop-posframe-forecolor) + :background-color (or backcolor gts-pop-posframe-backcolor) + :internal-border-width padding + :internal-border-color (or backcolor gts-pop-posframe-backcolor) + :accept-focus t + :position (point) + :poshandler gts-posframe-pop-render-poshandler) + ;; render + (gts-render-buffer-prepare buf translator) + (posframe-refresh buf) + ;; setup + (with-current-buffer buf + (gts-buffer-set-key ("q" "Close") (posframe-delete buf)))))) + +(cl-defmethod gts-out ((_ gts-posframe-pop-render) task) + ;; render & refresh + (when-let ((buf (gts-render-buffer gts-posframe-pop-render-buffer task))) + (posframe-refresh buf) + (add-hook 'post-command-hook #'gts-posframe-render-auto-close-handler))) + +(cl-defmethod initialize-instance :after ((_ gts-posframe-pop-render) &rest _) + (unless (featurep 'posframe) + (user-error "To use `gts-posframe-render', you should install and load package `posframe' first"))) + + +;;; [Render] Child-Frame Render (Pin Mode) + +(defclass gts-posframe-pin-render (gts-posframe-pop-render) + ((width :initarg :width :initform 60) + (height :initarg :height :initform 20) + (padding :initarg :padding :initform 8) + (bd-width :initarg :bd-width :initform 1) + (bd-color :initarg :bd-color :initform nil) + (backcolor :initarg :backcolor :initform nil) + (fri-color :initarg :fringe-color :initform nil) + (position :initarg :position :initform nil)) + "Pin the childframe in a fixed position to display the translate result. +The childframe will not close, until you kill it with `q'. +Other operations in the childframe buffer, just like in 'gts-buffer-render'.") + +(defcustom gts-posframe-pin-render-buffer " *GTS-Pin-Posframe*" + "Buffer name of Pin Posframe." + :type 'string + :group 'go-translate) + +(defvar gts-posframe-pin-render-frame nil) +(defvar gts-posframe-pin-render-poshandler #'posframe-poshandler-frame-top-right-corner) + +(cl-defmethod gts-pre ((render gts-posframe-pin-render) translator) + ;; create/show frame + (if (and (get-buffer gts-posframe-pin-render-buffer) gts-posframe-pin-render-frame) + (make-frame-visible gts-posframe-pin-render-frame) + (with-slots (width height min-width min-height bd-width forecolor backcolor bd-color padding position) render + (setq gts-posframe-pin-render-frame + (let ((inhibit-read-only t)) + (posframe-show gts-posframe-pin-render-buffer + :string "\nLoading..." + :width width + :height height + :min-width width + :min-height height + :foreground-color (or forecolor gts-pin-posframe-forecolor) + :background-color (or backcolor gts-pin-posframe-backcolor) + :internal-border-width bd-width + :border-color (or bd-color gts-pin-posframe-bdcolor) + :left-fringe padding + :right-fringe padding + :refresh nil + :accept-focus t + :respect-header-line t + :position position + :poshandler (unless position gts-posframe-pin-render-poshandler))))) + (set-frame-parameter gts-posframe-pin-render-frame 'drag-internal-border t) + (set-frame-parameter gts-posframe-pin-render-frame 'drag-with-header-line t) + (when-let ((color (or (oref render fri-color) gts-pin-posframe-fringe-color))) + (set-face-background 'fringe color gts-posframe-pin-render-frame))) + ;; render + (gts-render-buffer-prepare gts-posframe-pin-render-buffer translator) + (gts-buffer-ensure-a-blank-line-at-beginning gts-posframe-pin-render-buffer) + ;; setup + (with-current-buffer gts-posframe-pin-render-buffer + (gts-buffer-set-key ("q" "Hide") (posframe-hide gts-posframe-pin-render-buffer)) + (gts-buffer-set-key ("Q" "Close") (posframe-delete gts-posframe-pin-render-buffer)))) + +(cl-defmethod gts-out ((_ gts-posframe-pin-render) task) + ;; render & refresh + (when-let ((buf (gts-render-buffer gts-posframe-pin-render-buffer task))) + (gts-buffer-ensure-a-blank-line-at-beginning buf))) + +(cl-defmethod gts-me-out ((_ gts-posframe-pin-render) task) + ;; render & refresh + (gts-render-buffer-multi-engines gts-posframe-pin-render-buffer task)) + + +;;; [Render] kill-ring render + +(defclass gts-kill-ring-render (gts-render) ()) + +(cl-defmethod gts-out ((_ gts-kill-ring-render) task) + (deactivate-mark) + (with-slots (err parsed) task + (if err + (user-error "%s" err) + (kill-new (if (listp parsed) (string-join parsed "\n\n") parsed)) + (message "Translate result already in the kill ring.")))) + + +;;; [Texter] take current-at-point-or-selection as source text + +(defclass gts-current-or-selection-texter (gts-texter) ()) + +(cl-defmethod gts-text ((_ gts-current-or-selection-texter)) + (cond ((eq major-mode 'pdf-view-mode) + (if (pdf-view-active-region-p) + (car (pdf-view-active-region-text)))) + ((use-region-p) + (string-trim (buffer-substring-no-properties (region-beginning) (region-end)))) + (t (current-word t t)))) + +;; silence! +(declare-function pdf-view-active-region-p "ext:pdf-view.el" t t) +(declare-function pdf-view-active-region-text "ext:pdf-view.el" t t) + + +;;; [Texter] take whole-buffer for as source text + +(defclass gts-whole-buffer-texter (gts-texter) ()) + +(cl-defmethod gts-text ((_ gts-whole-buffer-texter)) + (buffer-substring-no-properties (point-min) (point-max))) + + +;;; [Picker] noprompt picker + +(defclass gts-noprompt-picker (gts-picker) + ((texter :initarg :texter :initform (gts-current-or-selection-texter)))) + +(defvar gts-picker-current-picker nil) +(defvar gts-picker-current-text nil) +(defvar gts-picker-current-path nil) + +(cl-defmethod gts-pick ((picker gts-noprompt-picker)) + (let ((text (gts-text (oref picker texter)))) + (when (= 0 (length (if text (string-trim text) ""))) + (user-error "Make sure there is any word at point, or selection exists")) + (let ((path (gts-path picker text))) + (setq gts-picker-current-path path) + (cl-values text path)))) + + +;;; [Picker] prompt, and flexible + +(defclass gts-prompt-picker (gts-picker) + ((texter :initarg :texter :initform (gts-current-or-selection-texter)))) + +(defvar gts-prompt-for-translate-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\C-g" #'top-level) + (define-key map "\C-n" #'gts-prompt-picker-next-path) + (define-key map "\C-p" (lambda () (interactive) (gts-prompt-picker-next-path t))) + (define-key map "\C-l" #'delete-minibuffer-contents) + (define-key map [C-return] (lambda () (interactive) (exit-minibuffer))) + map) + "Minibuffer keymap used when prompt user input.") + +(defun gts-prompt-picker-next-path (&optional backwardp) + "Pick next available translate path. +If BACKWARDP is t, then pick the previous one." + (interactive "P") + (let ((p (gts-next-path gts-picker-current-picker + gts-picker-current-text + gts-picker-current-path + backwardp))) + (setq gts-picker-current-path p) + (gts-picker-prompt-pick (minibuffer-contents) p) + (exit-minibuffer))) + +(defun gts-picker-prompt-pick (&optional text path) + (setq gts-picker-current-path path) + (let* ((enable-recursive-minibuffers t) + (minibuffer-allow-text-properties t) + (prompt (concat (concat "[" (car path) " > " (cdr path) "] ") "Text: ")) + (text (read-from-minibuffer prompt text gts-prompt-for-translate-keymap))) + (setq gts-picker-current-text text) + (when (zerop (length (string-trim text))) + (user-error "Text should not be null")) + (with-minibuffer-selected-window + (exit-minibuffer)))) + +(cl-defmethod gts-pick ((picker gts-prompt-picker)) + (setq gts-picker-current-picker picker) + (let* ((text (gts-text (oref picker texter))) + (path (gts-path picker text))) + (gts-picker-prompt-pick text path) + (cl-values gts-picker-current-text gts-picker-current-path))) + + +;;; [Splitter] split text by paragraph + +(defclass gts-paragraph-splitter (gts-splitter) ()) + +(cl-defmethod gts-split ((_ gts-paragraph-splitter) text) + (setq text (split-string text "\n\n" t)) + (if (and (listp text) (cadr text)) text)) + + +(provide 'gts-implements) + +;;; gts-implements.el ends here -- 2.47.3