(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
--- /dev/null
+;;; 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))))
+
+\f
+;;;### (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"))
+
+;;;***
+\f
+;;;### (autoloads nil "gts-core" "gts-core.el" (0 0 0 0))
+;;; Generated autoloads from gts-core.el
+
+(register-definition-prefixes "gts-core" '("gts-"))
+
+;;;***
+\f
+;;;### (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-"))
+
+;;;***
+\f
+;;;### (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-"))
+
+;;;***
+\f
+;;;### (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-"))
+
+;;;***
+\f
+;;;### (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-"))
+
+;;;***
+\f
+;;;### (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-"))
+
+;;;***
+\f
+;;;### (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"))
+
+;;;***
+\f
+;;;### (autoloads nil "gts-faces" "gts-faces.el" (0 0 0 0))
+;;; Generated autoloads from gts-faces.el
+
+(register-definition-prefixes "gts-faces" '("gts-p"))
+
+;;;***
+\f
+;;;### (autoloads nil "gts-implements" "gts-implements.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from gts-implements.el
+
+(register-definition-prefixes "gts-implements" '("gts-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("go-translate-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; go-translate-autoloads.el ends here
--- /dev/null
+(define-package "go-translate" "20221211.1327" "Translation framework supports multiple engines such as Google/Bing/DeepL"
+ '((emacs "27.1"))
+ :commit "65d5139f202320b71e6b8b03d752d02b7c0b8c6f" :authors
+ '(("lorniu" . "lorniuNOSPAMgmail.com"))
+ :maintainer
+ '("lorniu" . "lorniuNOSPAMgmail.com")
+ :keywords
+ '("convenience")
+ :url "https://github.com/lorniu/go-translate")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; go-translate.el --- Translation framework supports multiple engines such as Google/Bing/DeepL -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+
+;; Author: lorniu <lorniuNOSPAMgmail.com>
+;; 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)
+
+\f
+;;; 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
--- /dev/null
+;;; gts-core.el --- Translate engines and utils -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; 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)
+
+\f
+;;; 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))
+
+\f
+;;; 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)
+
+\f
+;;; 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"))))
+
+\f
+;;; 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))
+
+\f
+;;; 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")))
+
+\f
+;;; 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))))))
+
+\f
+;;; Splitter
+
+(cl-defgeneric gts-split (gts-splitter text)
+ "Split TEXT to several parts.
+Return list of string, or nil if split failed.")
+
+\f
+;;; 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))))
+
+\f
+;;; 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)))))))
+
+\f
+;;; 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))))))))
+
+\f
+;;; 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
--- /dev/null
+;;; gts-engine-bing.el --- Microsoft Translate -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; 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 "<speak version='1.0' xml:lang='%s'><voice xml:lang='%s' xml:gender='Female' name='%s'><prosody rate='-20.00%%'>%s</prosody></voice></speak>")
+
+ (parser :initform (gts-bing-parser))))
+
+\f
+;;; 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)))))
+
+\f
+;;; 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"))))
+
+\f
+;;; 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
--- /dev/null
+;;; gts-engine-deepl.el --- Translate Engine for DeepL -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; SPDX-License-Identifier: MIT
+
+;;; Commentary:
+
+;; https://www.deepl.com
+
+;;; Code:
+
+(require 'gts-implements)
+
+\f
+;;; 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")))
+
+\f
+;;; 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))
+
+\f
+;;; 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)))))))
+
+\f
+;;; 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
--- /dev/null
+;;; gts-engine-google-rpc.el --- Google translation with rpc api -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; 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)
+
+\f
+;;; 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")))
+
+\f
+;;; 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"))))
+
+\f
+;;; 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 "<b>\\|</b>\\|<i>\\|</i>" "" (gts-aref-for json 0 1 0 0 1))))
+
+
+(provide 'gts-engine-google-rpc)
+
+;;; gts-engine-google-rpc.el ends here
--- /dev/null
+;;; gts-engine-google.el --- Google translate module -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; SPDX-License-Identifier: MIT
+
+;;; Commentary:
+
+;; http://translate.google.com
+
+;;; Code:
+
+(require 'gts-implements)
+
+\f
+;;; 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))))
+
+\f
+;;; 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)))))
+
+\f
+;;; 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))))
+
+\f
+;;; 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
--- /dev/null
+;;; gts-engine-stardict.el --- StarDict -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; 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
--- /dev/null
+;;; gts-engine-youdao.el --- YouDao Dict -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; 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
--- /dev/null
+;;; gts-faces.el --- Face definitions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; 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)
+
+\f
+;;; 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)
+
+\f
+;;; 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)
+
+\f
+;;; 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
--- /dev/null
+;;; gts-implements.el --- Component implements -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
+;; SPDX-License-Identifier: MIT
+
+;;; Commentary:
+
+;; Builtin implements of basic components
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'url)
+(require 'json)
+(require 'gts-core)
+(require 'gts-faces)
+
+\f
+;;; [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))
+
+\f
+;;; [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))
+
+\f
+;;; [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
+
+\f
+;;; [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))))
+
+\f
+;;; [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")))
+
+\f
+;;; [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))
+
+\f
+;;; [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."))))
+
+\f
+;;; [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)
+
+\f
+;;; [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)))
+
+\f
+;;; [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))))
+
+\f
+;;; [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)))
+
+\f
+;;; [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
projects / emacsconfig.git / commitdiff