From: Andreas Gerler Date: Sat, 21 Dec 2024 15:38:14 +0000 (+0100) Subject: update go-translate X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=cd65805459da0f7e96f04f5ed16be447092a9c48;p=emacsconfig.git update go-translate Signed-off-by: Andreas Gerler --- diff --git a/bba.org b/bba.org index fa96e497..29b8ed6b 100644 --- a/bba.org +++ b/bba.org @@ -954,15 +954,12 @@ Use our default socket files #+begin_src emacs-lisp (require 'go-translate) - (setq gts-translate-list '(("en" "de"))) + (setq gt-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))) + (setq gt-default-translator + (gt-translator + :engines (list (gt-bing-engine) (gt-google-engine)) + :render (gt-buffer-render))) #+end_src * [[http://www.mew.org][mew]] email diff --git a/elpa/go-translate-20221211.1327/go-translate-autoloads.el b/elpa/go-translate-20221211.1327/go-translate-autoloads.el deleted file mode 100644 index 358b41e7..00000000 --- a/elpa/go-translate-20221211.1327/go-translate-autoloads.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; 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 deleted file mode 100644 index 19c19eaf..00000000 --- a/elpa/go-translate-20221211.1327/go-translate-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(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 deleted file mode 100644 index 100ef599..00000000 --- a/elpa/go-translate-20221211.1327/go-translate.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; 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 deleted file mode 100644 index 69f25f0f..00000000 --- a/elpa/go-translate-20221211.1327/gts-core.el +++ /dev/null @@ -1,667 +0,0 @@ -;;; 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 deleted file mode 100644 index 27a13602..00000000 --- a/elpa/go-translate-20221211.1327/gts-engine-bing.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; 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 deleted file mode 100644 index 9b1bdfc2..00000000 --- a/elpa/go-translate-20221211.1327/gts-engine-deepl.el +++ /dev/null @@ -1,127 +0,0 @@ -;;; 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 deleted file mode 100644 index 8c784c48..00000000 --- a/elpa/go-translate-20221211.1327/gts-engine-google-rpc.el +++ /dev/null @@ -1,207 +0,0 @@ -;;; 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 deleted file mode 100644 index 2ac39ba5..00000000 --- a/elpa/go-translate-20221211.1327/gts-engine-google.el +++ /dev/null @@ -1,424 +0,0 @@ -;;; 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 deleted file mode 100644 index 772a4b2b..00000000 --- a/elpa/go-translate-20221211.1327/gts-engine-stardict.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; 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 deleted file mode 100644 index 594d3452..00000000 --- a/elpa/go-translate-20221211.1327/gts-engine-youdao.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; 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 deleted file mode 100644 index 107b4ed9..00000000 --- a/elpa/go-translate-20221211.1327/gts-faces.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; 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 deleted file mode 100644 index fe60a220..00000000 --- a/elpa/go-translate-20221211.1327/gts-implements.el +++ /dev/null @@ -1,647 +0,0 @@ -;;; 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 diff --git a/elpa/go-translate-20230503.303/go-translate-autoloads.el b/elpa/go-translate-20230503.303/go-translate-autoloads.el deleted file mode 100644 index 358b41e7..00000000 --- a/elpa/go-translate-20230503.303/go-translate-autoloads.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; 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-20230503.303/go-translate-pkg.el b/elpa/go-translate-20230503.303/go-translate-pkg.el deleted file mode 100644 index d7d1cecd..00000000 --- a/elpa/go-translate-20230503.303/go-translate-pkg.el +++ /dev/null @@ -1,14 +0,0 @@ -(define-package "go-translate" "20230503.303" "Translation framework supports multiple engines such as Google/Bing/DeepL" - '((emacs "27.1")) - :commit "59506f69503cca65291fa5ccd0a326e716338c23" :authors - '(("lorniu" . "lorniu@gmail.com")) - :maintainers - '(("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-20230503.303/go-translate.el b/elpa/go-translate-20230503.303/go-translate.el deleted file mode 100644 index 100ef599..00000000 --- a/elpa/go-translate-20230503.303/go-translate.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; 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-20230503.303/gts-core.el b/elpa/go-translate-20230503.303/gts-core.el deleted file mode 100644 index 998c3dfc..00000000 --- a/elpa/go-translate-20230503.303/gts-core.el +++ /dev/null @@ -1,673 +0,0 @@ -;;; 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.") - -(defvar gts-picker-last-path nil) - -(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 "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. -Picker choose path according this first. If non-match, choose other paths." - :type 'alist - :group 'go-translate) - -(defun gts-picker-filter-paths (paths text) - "Filter PATHS according TEXT. -The rules are provided by `gts-picker-lang-match-alist'." - (when text - (cl-loop with text = (with-temp-buffer ; clear punctuations - (insert text) - (goto-char (point-min)) - (while (re-search-forward "\\s.\\|\n" nil t) (replace-match "")) - (buffer-string)) - for path in paths - for matcher = (let ((p (cdr (cl-find-if ; get match rule - (lambda (item) (string-match-p (format "^%s$" (car item)) (car path))) - gts-picker-lang-match-alist)))) - (if (stringp p) (lambda (text) (string-match-p p text)) p)) - when (and matcher (funcall matcher text)) - collect path))) - -(cl-defmethod gts-paths ((picker gts-picker) &optional keep-order) - "All paths can be picked by PICKER. -When KEEP-ORDER is not nil then do not try to push last path to the first place." - (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) - (cl-loop for (lang1 . lang2) in gts-translate-list - do (let ((lang2 (if (consp lang2) (car lang2) lang2))) - (cl-pushnew (cons lang1 lang2) paths :test #'equal) - (unless (oref picker single) (cl-pushnew (cons lang2 lang1) paths :test #'equal)))) - (setq paths (nreverse paths)) - (if (and (not keep-order) - gts-picker-last-path (member gts-picker-last-path paths)) - (cons gts-picker-last-path (remove gts-picker-last-path paths)) - paths))) - -(cl-defmethod gts-path ((picker gts-picker) text) - "Default path for TEXT used by PICKER. -Return the first path matching TEXT. If no path matches, return the non-nil -`gts-picker-last-path', then the first available path." - (if-let* ((paths (gts-paths picker)) - (matched (gts-picker-filter-paths paths text))) - (car matched) - (or (let ((langs (mapcar #'car gts-picker-lang-match-alist))) - (cl-find-if (lambda (p) (not (member (car p) langs))) paths)) - (car paths)))) - -(cl-defmethod gts-next-path ((picker gts-picker) text path &optional backwardp) - (let (candidates idx (paths (gts-paths picker 'keep-order))) - (cl-loop for path in (append (gts-picker-filter-paths paths text) paths) - 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'.") -(defvar gts-current-picker nil "Picker used in current translate.") -(defvar gts-current-engines nil "Engines used in current translate.") -(defvar gts-current-render nil "Render used in current 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 - ('splitter (gts-ensure-plain (slot-value this slot))) - ('picker (ensure (gts-ensure-plain (or gts-current-picker (slot-value this slot))))) - ('engines (ensure (gts-ensure-list (gts-ensure-plain (or gts-current-engines (slot-value this slot)))))) - ('render (ensure (gts-ensure-plain (or gts-current-render (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'." - ;; dynamic - (setq gts-current-command this-command) - (setq gts-current-picker (oref this picker)) - (setq gts-current-engines (oref this engines)) - (setq gts-current-render (oref this render)) - ;; 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-20230503.303/gts-engine-bing.el b/elpa/go-translate-20230503.303/gts-engine-bing.el deleted file mode 100644 index 202d34bd..00000000 --- a/elpa/go-translate-20230503.303/gts-engine-bing.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; 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_AbusePreventionHelper = \\[\\([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-20230503.303/gts-engine-deepl.el b/elpa/go-translate-20230503.303/gts-engine-deepl.el deleted file mode 100644 index 9fa0a39d..00000000 --- a/elpa/go-translate-20230503.303/gts-engine-deepl.el +++ /dev/null @@ -1,127 +0,0 @@ -;;; 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 (* 2 (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-20230503.303/gts-engine-google-rpc.el b/elpa/go-translate-20230503.303/gts-engine-google-rpc.el deleted file mode 100644 index 8c784c48..00000000 --- a/elpa/go-translate-20230503.303/gts-engine-google-rpc.el +++ /dev/null @@ -1,207 +0,0 @@ -;;; 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-20230503.303/gts-engine-google.el b/elpa/go-translate-20230503.303/gts-engine-google.el deleted file mode 100644 index 2ac39ba5..00000000 --- a/elpa/go-translate-20230503.303/gts-engine-google.el +++ /dev/null @@ -1,424 +0,0 @@ -;;; 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-20230503.303/gts-engine-stardict.el b/elpa/go-translate-20230503.303/gts-engine-stardict.el deleted file mode 100644 index 3ce059ac..00000000 --- a/elpa/go-translate-20230503.303/gts-engine-stardict.el +++ /dev/null @@ -1,64 +0,0 @@ -;;; 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) - -(defcustom gts-stardict-args '("-n" "-c" "-0" "-1") - "Arguments passed to command `sdcv'." - :type 'list - :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 - (append gts-stardict-args (list 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-20230503.303/gts-engine-youdao.el b/elpa/go-translate-20230503.303/gts-engine-youdao.el deleted file mode 100644 index 594d3452..00000000 --- a/elpa/go-translate-20230503.303/gts-engine-youdao.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; 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-20230503.303/gts-faces.el b/elpa/go-translate-20230503.303/gts-faces.el deleted file mode 100644 index 107b4ed9..00000000 --- a/elpa/go-translate-20230503.303/gts-faces.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; 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-20240802.131/go-translate-autoloads.el b/elpa/go-translate-20240802.131/go-translate-autoloads.el new file mode 100644 index 00000000..308a5d34 --- /dev/null +++ b/elpa/go-translate-20240802.131/go-translate-autoloads.el @@ -0,0 +1,133 @@ +;;; go-translate-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from go-translate.el + +(autoload 'gt-do-translate "go-translate" "\ +Translate using `gt-default-translator'. + +Define your default translator like this: + + (setq gt-default-translator + (gt-translator :engines (gt-bing-engine))) + + (setq gt-default-translator + (gt-translator :taker (gt-taker :langs '(en fr) :text 'sentence :prompt t) + :engines (list (gt-google-engine) (gt-deepl-engine)) + :render (gt-buffer-render))) + +Or define several different translators and put them in `gt-preset-translators', +and switch with `gt-do-setup' at any time. + +This is just a simple wrapper of `gt-start' method. Create other translate +commands in the same way using your creativity. + +If ARG is not nil, translate with translator select by `gt-preset-translators'. + +(fn &optional ARG)" t) +(register-definition-prefixes "go-translate" '("gt-")) + + +;;; Generated autoloads from gt-core.el + +(autoload 'gt-do-speak "gt-core" "\ +Speak content around point. + +If the text under point or with selection has `gt-task' or `gt-tts-url' +property, try to speak it with current translation engine. + +Otherwise try to TTS with local program or using selected engine. + +When TTS with specific engine, you can specify the language with `lang.' prefix." t) +(register-definition-prefixes "gt-core" '("gt-")) + + +;;; Generated autoloads from gt-engine-bing.el + +(register-definition-prefixes "gt-engine-bing" '("gt-bing-")) + + +;;; Generated autoloads from gt-engine-chatgpt.el + +(register-definition-prefixes "gt-engine-chatgpt" '("gt-chatgpt-")) + + +;;; Generated autoloads from gt-engine-deepl.el + +(register-definition-prefixes "gt-engine-deepl" '("gt-deepl-")) + + +;;; Generated autoloads from gt-engine-echo.el + +(register-definition-prefixes "gt-engine-echo" '("gt-")) + + +;;; Generated autoloads from gt-engine-google.el + +(register-definition-prefixes "gt-engine-google" '("gt-google-")) + + +;;; Generated autoloads from gt-engine-google-rpc.el + +(register-definition-prefixes "gt-engine-google-rpc" '("gt-google-rpc-")) + + +;;; Generated autoloads from gt-engine-libre.el + +(register-definition-prefixes "gt-engine-libre" '("gt-libre-")) + + +;;; Generated autoloads from gt-engine-stardict.el + +(register-definition-prefixes "gt-engine-stardict" '("gt-stardict-")) + + +;;; Generated autoloads from gt-engine-youdao.el + +(register-definition-prefixes "gt-engine-youdao" '("gt-youdao-")) + + +;;; Generated autoloads from gt-extension.el + +(register-definition-prefixes "gt-extension" '("gt-")) + + +;;; Generated autoloads from gt-faces.el + +(register-definition-prefixes "gt-faces" '("gt-p")) + + +;;; Generated autoloads from gt-httpx.el + +(register-definition-prefixes "gt-httpx" '("gt-")) + + +;;; Generated autoloads from gt-text-utility.el + +(autoload 'gt-qrcode "gt-text-utility" "\ +Genrate QR Code for STR. + +(fn STR)" t) +(register-definition-prefixes "gt-text-utility" '("gt-text-")) + +;;; End of scraped data + +(provide 'go-translate-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; go-translate-autoloads.el ends here diff --git a/elpa/go-translate-20240802.131/go-translate-pkg.el b/elpa/go-translate-20240802.131/go-translate-pkg.el new file mode 100644 index 00000000..e22c61b9 --- /dev/null +++ b/elpa/go-translate-20240802.131/go-translate-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "go-translate" "20240802.131" + "Translation framework, configurable and scalable." + '((emacs "28.1")) + :url "https://github.com/lorniu/go-translate" + :commit "424682b94df9efb3dd59e396677b45e4a67b7723" + :revdesc "424682b94df9" + :keywords '("convenience") + :authors '(("lorniu" . "lorniu@gmail.com")) + :maintainers '(("lorniu" . "lorniu@gmail.com"))) diff --git a/elpa/go-translate-20240802.131/go-translate.el b/elpa/go-translate-20240802.131/go-translate.el new file mode 100644 index 00000000..867e38e3 --- /dev/null +++ b/elpa/go-translate-20240802.131/go-translate.el @@ -0,0 +1,348 @@ +;;; go-translate.el --- Translation framework, configurable and scalable -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu + +;; Author: lorniu +;; URL: https://github.com/lorniu/go-translate +;; Package-Requires: ((emacs "28.1")) +;; Keywords: convenience +;; Package-Version: 20240802.131 +;; Package-Revision: 424682b94df9 + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; Translation framework on Emacs, with high configurability and extensibility. +;; +;; - Support multiple translation engines, such as Google, Bing, DeepL, ChatGPT... +;; - With variety of output styles, such as Buffer, Overlay, Childframe and so on. +;; - With a flexible taker for easy retrieval of translated content and targets. +;; - Support multiple paragraphs/parts and multi-language translation. +;; - Support different http backends, such as url.el, curl. Async and non-blocking. +;; - Support caches, proxy and more. +;; +;; Notice, it is not limited to just being a translation framework. It can fulfill +;; any text transformation tasks, such as ChatGPT and more. +;; +;; Custom it as you need, extend it using your creativity. + +;; You can install it via MELPA or from github. Make sure it is on your `load-path'. +;; +;; For the most basic use, add the following configuration: +;; +;; (require 'go-translate) +;; +;; (setq gt-default-translator +;; (gt-translator +;; :taker (gt-taker :langs '(en zh)) +;; :engines (list (gt-google-engine) (gt-bing-engine)) +;; :render (gt-buffer-render))) +;; +;; Then start your translate with command `gt-do-translate'. +;; +;; See README.org for details. + +;;; Code: + +(require 'transient) +(require 'gt-core) +(require 'gt-extension) +(require 'gt-engine-bing) +(require 'gt-engine-google) +(require 'gt-engine-google-rpc) +(require 'gt-engine-deepl) +(require 'gt-engine-stardict) +(require 'gt-engine-youdao) +(require 'gt-engine-chatgpt) +(require 'gt-engine-libre) +(require 'gt-engine-echo) +(require 'gt-text-utility) + +;;; Mask these commands in M-x +(dolist (cmd '(gt-prompt-next-target + gt-buffer-render--cycle-next + gt-buffer-render--refresh + gt-buffer-render--browser + gt-buffer-render--keyboard-quit + gt-buffer-render--toggle-readonly + gt-buffer-render--toggle-polyglot + gt-buffer-render--delete-cache + gt-buffer-render--show-tips + gt-buffer-render--unfold-source-text + gt-posframe-render-auto-close-handler + gt-stardict-switch-dict + gt-overlay-render-save-to-kill-ring)) + (put cmd 'completion-predicate #'ignore)) + + +;;; Presets + +(defun gt-define-custom-taker () + (let ((text (completing-read "Initial text: " + (gt-make-completion-table `(,@gt-taker-text-things nil)))) + (pick (completing-read "Pick style: " + (gt-make-completion-table `(nil ,@gt-taker-pick-things)))) + (prompt (completing-read "Prompt style: " + (gt-make-completion-table (list 'disable 'buffer 'minibuffer)) nil t))) + (gt-taker :text (intern text) :pick (intern pick) + :prompt (pcase prompt ("buffer" 'buffer) ("minibuffer" t) (_ nil))))) + +(defcustom gt-preset-takers + (lambda () + `((,(gt-face-lazy "new..." 'bold) . ,#'gt-define-custom-taker) + (default . ,(gt-taker)) + (interactively . ,(gt-taker :text t :pick t :prompt t)) + (paragraph-at-point . ,(gt-taker :text 'paragraph :pick nil)) + (whole-buffer . ,(gt-taker :text 'buffer :pick 'nil)) + (whole-buffer-by-paragraph . ,(gt-taker :text 'buffer :pick 'paragraph)))) + "Preset takers. + +It is an alist or a function return the alist, which the value is a valid +instance of `gt-taker' and the key is a string or symbol, representing the +display label of the taker. + +Custom your own takers and put them into this list, then change the taker +of `gt-default-translator' at any time in `gt-do-setup'." + :type '(choice function + (alist :key-type (choice string symbol) + :value-type (sexp :tag "Instance of gt-taker"))) + :group 'gt-do-translate) + +(defcustom gt-preset-engines + (lambda () + `((Bing . ,(gt-bing-engine)) + (DeepL . ,(gt-deepl-engine)) + (Google . ,(gt-google-engine)) + (ChatGPT . ,(gt-chatgpt-engine)) + (ChatGPT-Stream . ,(gt-chatgpt-engine :stream t)) + (Youdao-Dict . ,(gt-youdao-dict-engine)) + (Youdao-Suggest . ,(gt-youdao-suggest-engine)) + (StarDict . ,(gt-stardict-engine)) + (LibreTranslate . ,(gt-libre-engine)) + (GoogleRPC . ,(gt-google-rpc-engine)) + (Google-Summary . ,(gt-google-engine :parse (gt-google-summary-parser))) + (Bionic_Reading . ,(gt-echo-engine :do '(clean br) :tag "Bionic Reading")))) + "Preset engines. + +It is an alist or a function return the alist, which the value is a valid +instance of `gt-engine' and the key is a string or symbol, representing the +display label of the engine. + +Custom your own engines and put them into this list, then change the engines +of `gt-default-translator' at any time in `gt-do-setup'." + :type '(choice function + (alist :key-type (choice string symbol) + :value-type (sexp :tag "Instance of gt-engine"))) + :group 'gt-do-translate) + +(defcustom gt-preset-renders + (lambda () + `((,gt-buffer-render-buffer-name . ,(gt-buffer-render)) + (insert/after . ,(gt-insert-render :type 'after)) + (insert/replace . ,(gt-insert-render :type 'replace)) + (overlay/after . ,(gt-overlay-render :type 'after)) + (overlay/help-echo . ,(gt-overlay-render :type 'help-echo)) + (message->echo-area . ,(gt-render)) + (save->kill-ring . ,(gt-kill-ring-render)) + (Pop-Posframe . ,(gt-posframe-pop-render)) + (Pin-Posframe . ,(gt-posframe-pin-render)) + (overlay-or-insert . ,(lambda () + (if buffer-read-only + (gt-overlay-render :type 'after :then (gt-kill-ring-render)) + (gt-insert-render :type 'after)))) + (system-notification . ,(gt-alert-render)))) + "Preset renders. + +It is an alist or a function return the alist, which the value is a valid +instance of `gt-render' and the key is a string or symbol, representing the +display label of the render. + +Custom your own render and put them into this list, then change the render +of `gt-default-translator' at any time in `gt-do-setup'." + :type '(choice function + (alist :key-type (choice string symbol) + :value-type (sexp :tag "Instance of gt-render"))) + :group 'gt-do-translate) + +(defcustom gt-preset-translators + (lambda () + `((default . ,(gt-translator :taker (cdar (gt-ensure-plain gt-preset-takers)) + :engines (cdar (gt-ensure-plain gt-preset-engines)) + :render (cdar (gt-ensure-plain gt-preset-renders)))) + (Text-Utility . ,(gt-text-utility + :taker (gt-taker :pick nil) + :render (gt-buffer-render))))) + "Preset translators. + +It is an alist or a function return the alist, which the value is a valid +instance of `gt-translator' and the key is a string or symbol, representing the +display label of the translator. + +Custom your own translator and put them into this list, then change the the +default translator to one of them at any time in `gt-do-setup'." + :type '(choice function + (alist :key-type (choice string symbol) + :value-type (sexp :tag "Instance of gt-translator"))) + :group 'gt-do-translate) + +(defcustom gt-default-translator nil + "The translator used by `gt-do-translate'. + +If you leave this nil, then the first translator in `gt-preset-translators' +will be used as the default translator." + :type '(restricted-sexp :match-alternatives (gt-translator-p 'nil)) + :group 'gt-do-translate) + +(defun gt-ensure-default-translator () + "Initial `gt-default-translator' if possible and make sure it's valid." + (unless gt-default-translator + (setq gt-default-translator (cdar (gt-ensure-plain gt-preset-translators)))) + (if (cl-typep gt-default-translator 'gt-translator) + (let (gt-debug-p) (gt-reset gt-default-translator)) + (user-error "The `gt-default-translator' is unavailable")) + gt-default-translator) + +(defun gt-translator-info (translator) + "Return TRANSLATOR's basic info for displaying." + (with-slots (taker engines render _taker _engines _render) translator + (cl-macrolet ((desc1 (name &rest body) + `(if (not (slot-boundp translator ',(intern (format "_%s" name)))) "unbound" + (when-let (,name (or ,name ,(intern (format "_%s" name)))) + (if (gt-functionp ,name) + (replace-regexp-in-string "[ \n\t]+" " " (format "%s" ,name)) + ,@body))))) + (list (desc1 taker (if (consp taker) (format "%s" taker) + (cl-flet ((desc2 (slot) (when (slot-boundp taker slot) + (format "%s: %s" slot (slot-value taker slot))))) + (format "<%s> %s" (gt-desc taker) + (string-join (remove nil (mapcar #'desc2 '(langs text pick prompt))) ", "))))) + (desc1 engines (mapconcat (lambda (en) (concat (format "%s" (oref en tag)) (if (gt-stream-p en) " (stream)"))) + (ensure-list (gt-ensure-plain engines)) ", ")) + (desc1 render (if (consp render) (format "%s" render) + (gt-desc (gt-ensure-plain render)))))))) + +(defun gt-set-taker (&optional translator taker) + "Set TRANSLATOR's TAKER to one from `gt-preset-takers'." + (interactive) + (unless translator (setq translator gt-default-translator)) + (unless taker + (let ((cands (gt-ensure-plain gt-preset-takers))) + (setq taker (gt-ensure-plain + (alist-get + (completing-read "Taker to use: " (gt-make-completion-table cands) nil t) + cands nil nil #'string-equal))))) + (oset translator taker nil) + (oset translator _taker taker) + (message "Changed taker done.")) + +(defun gt-set-engines (&optional translator engines) + "Set TRANSLATOR's ENGINES to ones from `gt-preset-engines'." + (interactive) + (unless translator (setq translator gt-default-translator)) + (unless engines + (let ((cands (gt-ensure-plain gt-preset-engines))) + (setq engines + (mapcar (lambda (item) + (let ((engine (gt-ensure-plain (alist-get item cands nil nil #'string-equal)))) + (if (cl-typep engine 'gt-engine) engine + (user-error "Invalid engine detected. Abort")))) + (completing-read-multiple "Engines to use (can choose multiple): " + (gt-make-completion-table cands)))))) + (oset translator engines nil) + (oset translator _engines engines) + (message "Changed engines done.")) + +(defun gt-set-render (&optional translator render) + "Set TRANSLATOR's RENDER to one from `gt-preset-renders'." + (interactive) + (unless translator (setq translator gt-default-translator)) + (unless render + (let ((cands (gt-ensure-plain gt-preset-renders))) + (setq render (gt-ensure-plain + (alist-get + (completing-read "Render to use: " (gt-make-completion-table cands) nil t) + cands nil nil #'string-equal))))) + (oset translator render nil) + (oset translator _render render) + (message "Changed render done.")) + +(defun gt-translator-copy-of-presets () + (let* ((tss (gt-ensure-plain gt-preset-translators)) + (tsn (completing-read "Preset translator: " tss nil t)) + (translator (alist-get tsn tss nil nil #'string-equal))) + (list (clone translator) tsn))) + +(defun gt-switch-translator () + "Switch `gt-default-translator' to another defined in `gt-preset-translators'." + (interactive) + (cl-destructuring-bind (translator name) + (gt-translator-copy-of-presets) + (setq gt-default-translator translator) + (gt-ensure-default-translator) + (message "Switch default translator to: %s" name))) + +(transient-define-prefix gt-do-setup () + "Setup `gt-default-translator' in user interface provided by transient." + :transient-non-suffix #'transient--do-exit + [:description + (lambda () + (format "Current Default Translator:\n\n %s\n" + (condition-case err + (apply #'format "Taker: %s\n Engines: %s\n Render: %s" (gt-translator-info (gt-ensure-default-translator))) + (error (format "%s" err))))) + [("t" "Set taker..." gt-set-taker :transient t)] + [("e" "Set engines..." gt-set-engines :transient t)] + [("r" "Set render..." gt-set-render :transient t)] + [("c" "Switch preset translator..." gt-switch-translator)]] + (interactive) + (gt-ensure-default-translator) + (transient-setup 'gt-do-setup)) + + +;;; Entrance + +;;;###autoload +(defun gt-do-translate (&optional arg) + "Translate using `gt-default-translator'. + +Define your default translator like this: + + (setq gt-default-translator + (gt-translator :engines (gt-bing-engine))) + + (setq gt-default-translator + (gt-translator :taker (gt-taker :langs '(en fr) :text 'sentence :prompt t) + :engines (list (gt-google-engine) (gt-deepl-engine)) + :render (gt-buffer-render))) + +Or define several different translators and put them in `gt-preset-translators', +and switch with `gt-do-setup' at any time. + +This is just a simple wrapper of `gt-start' method. Create other translate +commands in the same way using your creativity. + +If ARG is not nil, translate with translator select by `gt-preset-translators'." + (interactive "P") + (let ((gt-default-translator (if arg (car (gt-translator-copy-of-presets)) gt-default-translator))) + (gt-ensure-default-translator) + (gt-start gt-default-translator))) + +(provide 'go-translate) + +;;; go-translate.el ends here diff --git a/elpa/go-translate-20240802.131/gt-core.el b/elpa/go-translate-20240802.131/gt-core.el new file mode 100644 index 00000000..54537a92 --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-core.el @@ -0,0 +1,1965 @@ +;;; gt-core.el --- Core implement of the Translator -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu +;; Package-Requires: ((emacs "28.1")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; The core implement of the translator + +;;; Code: + +(require 'cl-lib) +(require 'subr-x) +(require 'dom) +(require 'eieio) +(require 'text-property-search) + +(defgroup go-translate nil + "Translation framework on Emacs, with high configurability and extensibility." + :group 'external + :prefix 'gt-) + +(defcustom gt-debug-p nil + "Whether enable the debug message." + :type 'boolean + :group 'go-translate) + + +;;; Components and Variables + +(defclass gt-single () + ((insts :allocation :class :initform nil)) + :abstract t + :documentation "Only create one instance for same slots.") + +(cl-defmethod make-instance ((class (subclass gt-single)) &rest slots) + (if-let* ((key (sha1 (format "%s" slots))) + (insts (oref-default class insts)) + (old (cdr-safe (assoc key insts)))) + old + (let ((inst (cl-call-next-method))) + (prog1 inst + (oset-default class insts `((,key . ,inst) ,@insts)))))) + +(defclass gt-validator () + ((if :initarg :if + :type (or function symbol list) + :documentation "See `gt-valid' for details.")) + :abstract t + :documentation "Use to detect whether component is available") + +(defclass gt-task () + ((text + :initarg :text + :type (or string list) + :documentation "Source text list to be translated.") + (src + :initarg :src + :initform nil + :type symbol + :documentation "Generally, the source language.") + (tgt + :initarg :tgt + :type symbol + :documentation "Generally, the target language.") + (meta + :initform nil + :initarg :meta + :type t + :documentation "Extra data passed in translation.") + (res + :initform nil + :type (or string list function) + :documentation "Translation result.") + (err + :initform nil + :documentation "Translation error.") + (cache + :initform nil + :documentation "Used to temporarily save the data from cache.") + (markers + :initform nil + :documentation "Markers tracking output bounds.") + (process + :initform nil + :documentation "Which process current task running.") + + (id + :initform (gensym "task-") + :documentation "Used to distinguish between different tasks.") + (version + :initform nil + :initarg :version + :documentation "If this is different with the one in translator, task is expired.") + + (engine + :initarg :engine + :documentation "Engine of current task.") + (render + :initarg :render + :documentation "Render of current task.") + (translator + :initarg :translator + :documentation "Translator of current task.")) + :documentation + "An object contains basic translation infomations. +Its life cycle is in one translation. It is created by translator, then derived +to engines for result, at last extracted by render for output.") + +(defclass gt-taker (gt-single gt-validator) + ((text + :initarg :text + :type (or function symbol string) + :documentation "See `gt-taker-text' for details.") + (pick + :initarg :pick + :type (or function symbol) + :documentation "See `gt-taker-pick' for details.") + (pick-pred + :initarg :pick-pred + :initform nil + :type (or function null) + :documentation "Filter the picked element with this function.") + (langs + :initarg :langs + :type list + :documentation "See `gt-langs' for details.") + (prompt + :initarg :prompt + :type (or function symbol) + :documentation "See `gt-taker-prompt' for details.") + (then + :initarg :then + :documentation "A function with current translator as argument. +Used to do extra works after taking done. For example, one can filter the +source text list to remove unnecessary elements, or modifiy the translate +target as a final step.")) + :documentation + "A component used to take the translate source text and targets for translator. + +The steps are: +1. take the initial text by `text' +2. get the available targets from `langs' +3. ensure the text and langs via `prompt' if necessary +4. split or filter text via `pick' if possible + +So you can define a taker fully like this: + + (gt-taker :text `buffer :langs `(en it) :prompt `buffer :pick `sentence) + +Or use the default value or corresponding variables as: + + (setq gt-langs `(en it)) + (gt-taker) + +Then use the taker in the translator and start your translation.") + +(defclass gt-parser (gt-single gt-validator) + ((tag + :initarg :tag + :initform nil + :type (or symbol string) + :documentation "Display label for this parser.")) + :documentation + "It is a component of `gt-engine', used to parse the response of the engine +to a user-friendly string. One engine can have different parsers, but can only +use one of them at a time.") + +(defclass gt-engine (gt-single gt-validator) + ((tag + :initarg :tag + :type (or string symbol) + :documentation "Display label for this engine.") + (parse + :initarg :parse + :initform (gt-parser) + :type (or function gt-parser) + :documentation "Used to generate user-friendly result from response.") + (delimiter + :initarg :delimiter + :type (or null string) + :documentation "The delimiter for multiple paragraphs or parts translation.") + (stream + :initarg :stream + :type boolean + :initform nil + :documentation "Enable stream support for this engine. +This effect both engine and render. If this is t, then retrieve results +part by part. Render supporting stream output should refresh the display +every time new data arrived.") + (cache + :initarg :cache + :type (or symbol function gt-cacher) + :documentation "Cache style used by the engine. +If this is nil, current engine will use no cache at all. +If this is literally symbol, see `gt-valid-literally' for details. +If this is a cacher, then cache using the cacher instead.") + (salt + :initarg :salt + :initform nil + :documentation "Distinguish from... now for cache key only.") + (then + :initarg :then + :type function + :documentation "Function run after result are responsed and parsed. +Take current task as argument. you can do extra works for current task +before rendering.")) + :documentation "Translate engine, retrieve the result and parse it. + +If `delimiter' is non nil, the translation for multiple paragraphs or parts will +take a strategy as `join-translate-split'. That is, join the source text list to +a single string separated by `delimiter', translate the whole string, and then +split the result by `delimiter' into multiple parts. This assumes that the +`delimiter' in string is kept by engine in the translation progress. + +Set `delimiter' to nil to avoid this strategy. In that case, a string list will +be passed to the engine, and a translated string list is expected. + +Also in some cases, you should turn the cache off by setting `no-cache' to t." + :abstract t) + +(defclass gt-render (gt-single gt-validator) + ((output + :initarg :output + :initform nil + :type (or function null) + :documentation "If this is not nil, then will override the default output logic.") + (then + :initarg :then + :initform nil + :type (or function gt-render null) + :documentation "Chain results to next render if possible. +If this is a function, pass current translator as argument and execute it only.") + (prefix + :initarg :prefix + :type (or function t) + :documentation "Custom prefix displayed in the render. +If this is nil, then don't display prefix. If this is function use its return value +as prefix. If this is a string, use the string as prefix.")) + :documentation + "A component used to output the all the results made by translator. +Method `gt-init' only works once before output, method `gt-output' will run after +every task finished.") + +(defclass gt-translator () + ((text + :type list + :initform nil + :initarg :text + :documentation "The text taken by taker, and prepare to translate. +This should be a list, every element is a string as one pargraph or one part. +This list will be sent to translate engines later.") + + (bounds + :type list + :initform nil + :documentation "The bounds in buffer corresponds to the `text' slot. +The first element is the working buffer, while rest are buffer bounds.") + + (target + :type list + :initform nil + :documentation "The target taken by taker. + +This should be a list. Generally, the first element is the source language and +the rest are the target languages. Target languages can be one or multiple, +that is, in one translation, can translate same text into multiple languages. + +Of course, the target may be more than just the languages. If translator is not +used to translate, then target may be something else representing the transform +targets.") + + (tasks + :initform nil + :type list + :documentation "All tasks created according the source text and targets.") + + (total + :initform 0 + :type (integer 0 *) + :documentation "Total tasks in current translation.") + + (state + :initform 0 + :type (member 0 1 2 3 4 9) + :documentation "The inner state of the translator for current translation: +0: new translator +1: all tasks added +2: render prepared +3: all result parsed +4: translate abort") + + (keep + :initform nil + :type boolean + :documentation "If t then don't clean text and target in a new translation.") + + (version + :documentation "Used to distinguish with expired translations.") + + (taker + :initarg :taker + :initform nil + :type (or function gt-taker list) + :documentation "Used to take input for the translator. +If this is a function, use its return value as the taker. It will take the +source text and targets, and save them into `text', `bounds' and `target' slots +for the following translate task. If this is a list, use the first available one.") + + (engines + :initarg :engines + :initform nil + :type (or function gt-engine list) + :documentation "The engines used to translate. +This should be one or more `gt-engine' instances or a function that return them. +The tasks created after `gt-take' will be passed to every engines. Every engine +should translate the task and parse the result. After every task finished, the +rendering process will be performed.") + + (render + :initarg :render + :initform nil + :type (or function gt-render list) + :documentation "Used to output the translation results. +This should be a `gt-render' instance or a function return one. +If this is a list, use the first available one.") + + (_taker + :type (or function gt-taker list) + :documentation "Backup of initial value of `taker', which may be a +function or `gt-taker' object. The value will be normalized at the start of +every translation and stored into the `taker' slot. Avoid changing this during +translation progress unless you are confident in what you are doing.") + + (_engines + :type (or function gt-engine list) + :documentation "Backup of initial `engines' like above.") + + (_render + :type (or function gt-render list) + :documentation "Backup of initial `render' like above.") + + (bag :initform nil)) + :documentation "Core component of the translation. + +The basic components of a translator is taker, engines and render: +1. Use `gt-taker' to capture the source text and target +2. Then use one or more `gt-engine' to get the translate result +3. At last use a `gt-render' to output the results to user. + +The start a translation, call `gt-start' on a translator instance like this: + + (gt-start (make-instance `gt-translator + :taker (gt-taker) + :engines (gt-google-engine) + :render (gt-buffer-render))) + +That is: 1) define the translator 2) executable `gt-start'.") + +(defconst gt-lang-codes + '((en . "English") + (zh . "Chinese") + (ru . "Russian") + (fr . "French") + (it . "Italian") + (es . "Spanish") + (de . "German") + (ko . "Korean") + (ja . "Japanese") + (yue . "Cantonese") + (af . "Afrikaans") + (ak . "Akan") + (am . "Amharic") + (ar . "Arabic") + (as . "Assamese") + (asa . "Asu") + (az . "Azerbaijani") + (be . "Belarusian") + (bem . "Bemba") + (bez . "Bena") + (bg . "Bulgarian") + (bm . "Bambara") + (bn . "Bengali") + (bo . "Tibetan") + (bs . "Bosnian") + (ca . "Catalan") + (cgg . "Chiga") + (chr . "Cherokee") + (cs . "Czech") + (da . "Danish") + (dav . "Taita") + (ebu . "Embu") + (ee . "Ewe") + (el . "Greek") + (eo . "Esperanto") + (et . "Estonian") + (eu . "Basque") + (fa . "Persian") + (ff . "Fulah") + (fi . "Finnish") + (fil . "Filipino") + (fo . "Faroese") + (ga . "Irish") + (gl . "Galician") + (gsw . "Swiss German") + (gu . "Gujarati") + (guz . "Gusii") + (gv . "Manx") + (ha . "Hausa") + (haw . "Hawaiian") + (he . "Hebrew") + (hi . "Hindi") + (hr . "Croatian") + (hu . "Hungarian") + (hy . "Armenian") + (id . "Indonesian") + (ig . "Igbo") + (ii . "Sichuan Yi") + (is . "Icelandic") + (jmc . "Machame") + (ka . "Georgian") + (kab . "Kabyle") + (kam . "Kamba") + (kde . "Makonde") + (kea . "Kabuverdianu") + (khq . "Koyra Chiini") + (ki . "Kikuyu") + (kk . "Kazakh") + (kl . "Kalaallisut") + (kln . "Kalenjin") + (km . "Khmer") + (kn . "Kannada") + (kok . "Konkani") + (kw . "Cornish") + (lag . "Langi") + (lg . "Ganda") + (lt . "Lithuanian") + (luo . "Luo") + (luy . "Luyia") + (lv . "Latvian") + (mas . "Masai") + (mer . "Meru") + (mfe . "Morisyen") + (mg . "Malagasy") + (mk . "Macedonian") + (ml . "Malayalam") + (mr . "Marathi") + (ms . "Malay") + (mt . "Maltese") + (my . "Burmese") + (naq . "Nama") + (nd . "North Ndebele") + (ne . "Nepali") + (nl . "Dutch") + (nn . "Norwegian Nynorsk") + (nyn . "Nyankole") + (om . "Oromo") + (or . "Oriya") + (pa . "Punjabi") + (pl . "Polish") + (ps . "Pashto") + (pt . "Portuguese") + (rm . "Romansh") + (ro . "Romanian") + (rof . "Rombo") + (rw . "Kinyarwanda") + (rwk . "Rwa") + (saq . "Samburu") + (seh . "Sena") + (ses . "Koyraboro Senni") + (sg . "Sango") + (shi . "Tachelhit") + (si . "Sinhala") + (sk . "Slovak") + (sl . "Slovenian") + (sn . "Shona") + (so . "Somali") + (sq . "Albanian") + (sr . "Serbian") + (sv . "Swedish") + (sw . "Swahili") + (ta . "Tamil") + (te . "Telugu") + (teo . "Teso") + (th . "Thai") + (ti . "Tigrinya") + (to . "Tonga") + (tr . "Turkish") + (tzm . "Central Morocco Tamazight") + (uk . "Ukrainian") + (ur . "Urdu") + (uz . "Uzbek") + (vi . "Vietnamese") + (vun . "Vunjo") + (xog . "Soga") + (cy . "Welsh") + (yo . "Yoruba") + (zu . "Zulu"))) + +(defconst gt-word-classes + '(pron adj adv adt art aux conj prep det abbr int vt vi v n a)) + +(defvar gt-current-command nil) + +(defvar gt-current-translator nil) + +(defvar-local gt-tracking-marker nil) + +(cl-defgeneric gt-init (object &rest _args) + "Initialization for OBJECT.") + +(cl-defgeneric gt-desc (object) + "Return the string representation of the OBJECT." + (format "%s" (eieio-object-class object))) + + +;;; Utility + +(defun gt-aref (vector &rest ns) + "Recursively find the element in VECTOR. NS is indexes, as the path." + (while ns + (setq vector (aref vector (pop ns)))) + vector) + +(defmacro gt-orefs (instance &rest slots) + "Get all the SLOTS in INSTANCE as a list." + `(list ,@(cl-loop for slot in slots + collect `(slot-value ,instance ',slot)))) + +(defun gt-ensure-plain (obj &rest args) + "Ensure OBJ is non-function and non-symbol. +If OBJ is a function, call it with ARGS and return the result. +If OBJ is symbol, return its value." + (if (functionp obj) (apply obj args) obj)) + +(defun gt-functionp (object) + "Check if OBJECT is a function and not a class." + (and (functionp object) (not (class-p object)))) + +(defun gt-clean-properties (text &optional props) + "Remove specified PROPS from TEXT." + (unless props (setq props '(gt-result gt-task gt-done read-only))) + (remove-list-of-text-properties 0 (length text) props text) + text) + +(defun gt-face-lazy (str face &optional display) + "Propertize STR to add FACE only when no face exists on it. +Set DISPLAY property to STR if it is not nil. + +For example: + + (gt-face-lazy s `font-lock-doc-face `(space (:width 30) raise 0.5)) + +When `space' in DISPLAY, prepend a space to the STR." + (if (or (null face) + (with-temp-buffer + (insert str) + (or (text-property-search-backward 'face) + (text-property-search-backward 'font-lock-face) + (text-property-search-backward 'display)))) + str + (let ((r (if face (propertize str 'face face) str)) + (ds (cl-loop for (k v) on display by #'cddr + if (eq k 'space) append v into spaces + else append (list k v) into normals + finally (return (cons normals spaces))))) + (when-let (normals (car ds)) + (setq r (propertize r 'display normals))) + (when-let (spaces (cdr ds)) + (setq r (concat (propertize " " 'display (cons 'space spaces)) r))) + r))) + +(defun gt-line-height-separator (pixel) + "This can set line-height of the following line to PIXEL." + (concat (propertize "\s" 'display `(space :height (,pixel))) + (propertize "\n" 'line-height t))) + +(defmacro gt-simple-keymap (&rest definitions) + "A small wrapper to define new keymap for DEFINITIONS." + `(let ((map (make-sparse-keymap))) + (progn + ,@(cl-loop for (key value) on definitions by #'cddr + for v = (if (memq (car value) '(function quote lambda)) + value + `(lambda () (interactive) ,value)) + collect `(define-key map ,key ,v))) + map)) + +(defun gt-collect-text (text-or-bounds) + "Collect the text corresponding to parts in TEXT-OR-BOUNDS." + (let* ((items (ensure-list text-or-bounds)) (car (car items))) + (unless (stringp car) + (with-current-buffer (if (bufferp car) car (current-buffer)) + (setq items + (mapcar (lambda (bd) (buffer-substring (car bd) (cdr bd))) + (if (bufferp car) (cdr items) items))))) + (mapcar #'gt-clean-properties items))) + +(defun gt-lookup-password (&rest params) + "Query password stored in '.authinfo'. +PARAMS contains search keys like :user, :host same as `auth-source-search'." + (when-let (secret (plist-get (car (apply 'auth-source-search params)) :secret)) + (if (functionp secret) + (funcall secret) + secret))) + +(defun gt-insert-text-at-marker (str marker &optional end-marker keep-cursor) + "Insert STR to position of MARKER. +If END-MARKER exists, delete the content between the markers first. +If KEEP-CURSOR is not nil, keep the cursor at front." + (with-current-buffer (marker-buffer marker) + (let ((inhibit-read-only t)) + (when end-marker + (set-marker-insertion-type end-marker t) + (delete-region marker end-marker)) + (goto-char marker) + (deactivate-mark) + (if keep-cursor + (save-excursion (insert str)) + (insert str))))) + +(defun gt-parse-html-dom (str) + "Parse html STR and return the DOM body." + (with-temp-buffer + (insert str) + (xml-remove-comments (point-min) (point-max)) + (dom-by-tag (libxml-parse-html-region) 'body))) + +(declare-function let-alist--deep-dot-search "ext:let-alist" t t) + +(defmacro gt-plist-let (varlist &rest body) + "Let-bind dotted symbols to plist and execute BODY like `let-alist'. + +The last form of VARLIST is the plist to be bound with dot, bind other variables +like those in `let*'. + +For example: + + (gt-plist-let plist (list .a .b)) + + (gt-plist-let \\=`(:a 3 :b 4) (+ .a .b)) + + (gt-plist-let ((x 1) \\='(:y 2 :z 3)) (+ x .y .z)) + +See gt-tests.el for details." + (declare (indent 1) (debug t)) + (require 'let-alist) + (let ((var (make-symbol "plist"))) + `(let* (,@(if (or (atom varlist) + (eq (car varlist) 'quote) + (eq (car varlist) '\`)) + `((,var ,varlist)) + `(,@(butlast varlist) ,(cons var (last varlist)))) + ,@(cl-loop for (.k . k) in (delete-dups (let-alist--deep-dot-search body)) + collect `(,.k (plist-get ,var ,(intern (format ":%s" k)))))) + ,@body))) + +(defun gt-make-completion-table (items &optional order) + "Make completion table that ensure ITEMS sort by original ORDER." + (lambda (input pred action) + (if (eq action 'metadata) + `(metadata (category . "go-translate") + (display-sort-function . ,(or order #'identity))) + (complete-with-action action items input pred)))) + +(defmacro gt-read-from-buffer (&rest forms) + "Read text in a new created buffer interactively. + +Available options can be specified as keyword arguments: + :buffer The buffer used for reading user input + :initial-contents The initial contents of the buffer + :keymap The keymap to use in the buffer + :window-config The window configuration for the window display the buffer + :catch Catch tag used in for inner `throw' + :apply-key The keybinding for applying changes (default: \"C-c C-c\") + :cancel-key The keybinding for canceling changes (default: \"C-c C-k\") + :apply-hook Hook run before apply operation + :cancel-hook Hook run before cancel operation + +Other FORMS is used to do extra initialization, you can config head line, mode +line format or bind keys here. + +User can modify the buffer, and submit with `apply-key', then the contents of +the buffer will returned as the result." + (gt-plist-let + ((cl-loop for item in forms by #'cddr + while (keywordp item) append (list (pop forms) (pop forms)))) + (let ((buffer (or .buffer (format "*gt-%s*" (gensym "tmp-")))) + (tag (or .catch ''gt-read-from-buffer)) + (apply-key (or .apply-key "C-c C-c")) + (cancel-key (or .cancel-key "C-c C-k"))) + `(if (and (cl-plusp (recursion-depth)) (buffer-live-p (get-buffer ,buffer))) + (throw 'exit t) ; avoid recursion + (save-window-excursion + (catch ,tag + (unwind-protect + (with-current-buffer (get-buffer-create ,buffer) + ,(if .keymap `(use-local-map ,.keymap)) + (local-set-key (kbd ,apply-key) + (lambda () + (interactive) + ,(if .apply-hook `(funcall ,.apply-hook)) + (throw ,tag (buffer-string)))) + (local-set-key (kbd ,cancel-key) + (lambda () + (interactive) + ,(if .cancel-hook `(funcall ,.cancel-hook)) + (throw ,tag nil))) + (add-hook 'kill-buffer-query-functions + (lambda () ; only allow quit with C-c C-k + (not (and (memq this-command '(kill-buffer kill-this-buffer)) + (message "Quit the buffer using `%s' please" ,cancel-key)))) + nil t) + (erase-buffer) + ,(if .initial-contents `(insert ,.initial-contents)) + ,@forms + (pop-to-buffer ,buffer ,.window-config) + (recursive-edit)) + (ignore-errors (kill-buffer ,buffer))))))))) + +(cl-defgeneric gt-word-p (lang text) + "Whether TEXT is a single word in LANG. +This is a generic method, improve it for specific LANG as you wish." + (setq text (string-trim text)) + (if (eq lang 'zh) + (and (< (length text) 5) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (re-search-forward "\\s." nil t) (replace-match "")) + (equal (thing-at-point 'word) text))) + (with-temp-buffer + (insert text) + (equal (thing-at-point 'word) text)))) + + +;;; Validator Trait + +;; add validate feature to `taker/engine/render/cache' through `:if' slot + +(cl-defgeneric gt-valid-literally (v text src tgt) + "Check literally symbol or form V to determine next step. + +It can be used by cacher and engine. + +V should be a symbol like `word', `parts', `src:en', `tgt:en', `selection', +`xxx-mode', `read-only', or symbol with `not-' or `no-' prefix such as +`not-word', `not-src:en', `no-parts' etc. + +V also can be a list form grouping above symbols with `and/or', for example: + + (or word not-parts (and tgt:cn #`xxxx)). + +TEXT, SRC and TGT are translation text and targets. + +This is a generic method, you can extend the V as you wish." + (:method :around (v text src tgt) + (cond ((or (null v) (eq v t)) v) + ((symbolp v) + (setq text (ensure-list text)) + (let ((vn (symbol-name v)) (notp nil)) + (when (string-match "^not?-\\(.*\\)" vn) ; not-xxx style + (setq vn (match-string 1 vn)) + (setq v (intern vn)) + (setq notp t)) + (funcall + (if notp #'not #'identity) + (cl-call-next-method v text src text)))) + ((consp v) ; compose as: (or word (and not-parts src:zh)) + (unless (member (car v) '(or and)) (push 'or v)) + (funcall (if (eq (pop v) 'or) #'cl-some #'cl-every) #'identity + (mapcar (lambda (x) (gt-valid-literally x text src tgt)) v))))) + (let ((vn (symbol-name v))) + (cond + ((eq v 'word) (and (car text) ; text is word + (not (cdr text)) + (gt-word-p (intern-soft src) (car text)))) + ((eq v 'parts) (cdr text)) ; text is multiple parts + ((eq v 'selection) (use-region-p)) ; use region is active + ((eq v 'read-only) buffer-read-only) ; buffer is read-only + ((string-suffix-p "-mode" vn) ; major-mode or minor-mode + (if (boundp v) (symbol-value v) (eq major-mode v))) + ((string-match "^\\(src\\|tgt\\):\\(.+\\)" vn) + (member (match-string 2 vn) ; src/tgt is specific one, as src:en + (mapcar (lambda (item) (format "%s" item)) + (ensure-list (if (equal (match-string 1 vn) "src") src tgt)))))))) + +(cl-defgeneric gt-valid (component &rest _args) + "Validate COMPONENT, return t if it's available." + (:method ((component gt-validator) carrier) + "Determine if current COMPONENT is available through `if' slot. +Slot value can be a function, a symbol or a list. CARRIER maybe a task, a +translator or a list to provide more validation data." + (let (text src tgt) + (cond + ((cl-typep carrier 'gt-task) + (setq text (oref (oref carrier translator) text) + src (oref carrier src) + tgt (oref carrier tgt))) + ((cl-typep carrier 'gt-translator) + (setq text (oref carrier text) + src (car (oref carrier target)) + tgt (cdr (oref carrier target)))) + ((consp carrier) + (setq text (car carrier) + src (cadr carrier) + tgt (caddr carrier))) + (t (user-error "Carrier type is not supported"))) + (with-slots (if) component + (cond ((not (slot-boundp component 'if)) t) + ((and (functionp if) (= 2 (car (func-arity if)))) + (funcall if component carrier)) + ((and (functionp if) (= 1 (car (func-arity if)))) + (funcall if carrier)) + (t (gt-valid-literally if text src tgt))))))) + + +;;; Logging + +(defvar gt-log-buffer-name "*gt-log*" + "Log buffer for translator.") + +(defun gt-log (tag &rest messages) + "Log MESSAGES to `gt-log-buffer-name'. +TAG is a label for message being logged." + (declare (indent 1)) + (when gt-debug-p + (with-current-buffer (get-buffer-create gt-log-buffer-name) + (goto-char (point-max)) + (if (and (null messages) (stringp tag)) + (insert tag) + (let* ((tag (when tag + (concat + (gt-face-lazy (cl-subseq (format "%-.1f" (time-to-seconds)) 6) 'gt-logger-buffer-timestamp-face) + (gt-face-lazy (if (ignore-errors (string-blank-p tag)) tag (format " [%s]" tag)) 'gt-logger-buffer-tag-face) + " "))) + (count (if (numberp (car messages)) (pop messages) (length tag))) + (messages (mapconcat (lambda (s) (format "%s" s)) (delq nil messages) "\n")) + (msg (if (string-blank-p messages) + messages + (with-temp-buffer + (insert messages) + (goto-char (point-min)) + (unless (= (length tag) count) + (insert "\n") + (goto-char (point-min))) + (while (re-search-forward "\n" nil t) + (save-excursion + (beginning-of-line) + (insert (make-string count ? )))) + (buffer-string))))) + (insert (or tag "") (or msg "") "\n")))))) + +(defmacro gt-log-funcall (fmt &rest objects) + `(gt-log "" + (gt-face-lazy + (format ,(if (string-match-p "^[ \n]" fmt) fmt (concat "gt-" fmt)) + ,@(cl-loop + for o in objects collect + `(let ((obj ,o)) (if (eieio-object-p obj) (gt-desc obj) obj)))) + 'font-lock-doc-face))) + + +;;; Caching + +(defclass gt-cacher (gt-validator) + ((storage :initform nil :documentation "Where to save the caches.")) + "Used to cache the translate results." + :abstract t) + +(defcustom gt-cache-alive-time (* 30 60) + "Default cache alive time." + :type 'integer + :group 'go-translate) + +(defvar gt-default-cacher nil) + +;; generic + +(defun gt-cacher-barking () + (unless gt-default-cacher + (user-error "Make sure `gt-default-cacher' is properly configured. eg:\n + (setq gt-default-cacher (gt-memory-cacher))"))) + +(cl-defgeneric gt-cache-get (_cacher _key &rest _) + "Query result of KEY from CACHER." + (:argument-precedence-order _key _cacher) + (gt-cacher-barking)) + +(cl-defgeneric gt-cache-set (_cacher _key &rest _) + "Save result of KEY to CACHER." + (:argument-precedence-order _key _cacher) + (gt-cacher-barking)) + +(cl-defgeneric gt-cache-purge (cacher &optional only-expired) + "Purge the storage of CACHER. +If ONLY-EXPIRED not nil, purge caches expired only.") + +;; implement of caching in memory + +(defclass gt-memory-cacher (gt-cacher gt-single) ()) + +(cl-defmethod gt-cache-get ((cacher gt-memory-cacher) key) + (with-slots (storage expired) cacher + (when-let (cache (ignore-errors (gethash key storage))) + (if (> (time-to-seconds) (cdr cache)) + (remhash key storage) + (gt-log 'memory-cacher (format "get [%s] from caches (%s)" key (hash-table-count storage))) + (car cache))))) + +(cl-defmethod gt-cache-set ((cacher gt-memory-cacher) key value) + (with-slots (storage) cacher + (unless storage + (setf storage (make-hash-table :test #'equal))) + (if (null value) + (remhash key storage) + (let ((existp (gethash key storage)) + (etime (+ (time-to-seconds) gt-cache-alive-time))) + (puthash key (cons value etime) storage) + (gt-cache-purge cacher t) + (gt-log 'memory-cacher + (format "%s [%s] to caches (%s)" (if existp "update" "add") key (hash-table-count storage))))))) + +(cl-defmethod gt-cache-purge ((cacher gt-memory-cacher) &optional only-expired) + (with-slots (storage) cacher + (when storage + (if only-expired + (maphash (lambda (key value) + (when (> (time-to-seconds) (cdr value)) + (remhash key storage))) + storage) + (clrhash storage))))) + +;; caching task + +(cl-defmethod gt-valid ((cacher gt-cacher) (task gt-task) pred text) + (with-slots (src tgt) task + (or (and (null pred) (not (slot-boundp cacher 'if))) + (let ((pred (or pred (oref cacher if)))) + (or (and (functionp pred) (funcall pred task)) + (gt-valid-literally pred text src tgt)))))) + +(cl-defmethod gt-cache-key ((task gt-task) &optional n) + "Generate caching key for the Nth text in TASK." + (with-slots (text src tgt engine parse) task + (sha1 (format "%s:%s:%s:%s:%s:%s" + (nth (or n 0) (ensure-list text)) src tgt + (gt-desc engine) + (gt-desc (oref engine parse)) + (or (oref engine salt) "1"))))) + +(cl-defmethod gt-cache-get (cacher (task gt-task)) + (let ((results (cl-loop + for i from 1 to (length (ensure-list (oref task text))) + collect (gt-cache-get cacher (gt-cache-key task (1- i)))))) + (when (cl-some #'identity results) + (gt-log 'render (format "%s: result from cache!" (oref task id)))) + results)) + +(cl-defmethod gt-cache-set (cacher (task gt-task) &optional pred) + (with-slots (text src tgt res) task + (cl-loop for c in text + for r in res + for i from 0 + if (gt-valid cacher task pred c) + do (gt-cache-set cacher (gt-cache-key task i) r)))) + +(defun gt-purge-cache (cacher) + "Purge storage of CACHER." + (interactive (list gt-default-cacher)) + (when (y-or-n-p (format "Purge all caches from %s now?" (gt-desc cacher))) + (gt-cacher-barking) + (gt-cache-purge (or cacher gt-default-cacher)) + (message "Cache purged."))) + + +;;; Http Client + +(require 'gt-httpx) + +(defvar plz-curl-program) + +(defvar gt-default-http-client + (if (and (require 'plz nil t) (executable-find plz-curl-program)) + (gt-plz-http-client) + (gt-url-http-client))) + +(cl-defmethod gt-request (&rest args &key url method headers data filter done fail sync retry cache) + "Simple wrapper for http client, and add cache support." + (ignore method headers filter sync retry) + (let ((client (gt-ensure-plain gt-default-http-client (url-host (url-generic-parse-url url))))) + (if (and client (eieio-object-p client) (object-of-class-p client 'gt-http-client)) + (let* ((ckey (sha1 (format "%s%s" url data))) + (donefn (when done + (lambda (raw) + ;; try to cache the result + (when cache + (let ((gt-cache-alive-time (if (numberp cache) cache gt-cache-alive-time))) + (gt-cache-set gt-default-cacher ckey raw))) + (funcall done raw))))) + ;; try to get from cache first + (if-let (r (and cache (gt-cache-get gt-default-cacher ckey))) + (progn (gt-log 'cacher (format "Find %s in cache..." ckey)) + (if donefn (funcall donefn r) r)) + (cl-remf args :cache) + (apply #'gt-request client `(:done ,donefn ,@args)))) + (let ((errmsg "Make sure `gt-default-http-client' is available. eg:\n\n(setq gt-default-http-client (gt-url-http-client))\n\n\n")) + (if fail (funcall fail errmsg) (user-error errmsg)))))) + + +;;; Taker + +(defcustom gt-langs nil + "Translation languages or targets. + +This is a list which element is a language string or symbol described in +ISO 939-1. The taker will use this to determine the translate source and target. + +For example, if you want to translate between a and b, just set like: + + (setq gt-langs `(a b)) or (setq gt-langs `(\"a\" \"b\")) + +If your working languages is more than two, just set like: + + (setq gt-langs `(a b c d ..)) + +The taker will choose the most possible translate source and target from +the list, also you can switch between them in the following translation. + +Notice, the value can be overrided by `langs' slot in taker of translator. So +config it for specific translator using slot is effectively." + :type '(repeat (choice string symbol)) + :group 'go-translate) + +(defcustom gt-polyglot-p nil + "Toggle polyglot for translation. + +If this is t, the text will be translated into multiple targets. + +For example, assuming `gt-langs' or slot of `langs' is (a b c), the text +may be translated from a to a and c if this is t, but translated from +a to b or a to c if this is nil." + :type 'boolean + :group 'go-translate) + +(defvar gt-taker-text-things '(word paragraph sentence buffer line page list sexp defun symbol)) + +(defvar gt-taker-pick-things '(word paragraph sentence line list sexp defun page symbol)) + +(defcustom gt-taker-text 'word + "The initial text taken by taker of translator. + +If the region is actived, take the selection text. Otherwise, if this is a +symbol, then try to use `thing-at-point' to take the text at point. If this +is a function then invoke it and use its result as the initial text. Specially +if this is t, take the text interactively. + +The default value is to take current active region or current word at point. + +Notice, the value can be overrided by `text' slot in taker of translator. So +config it for specific translator using slot is effectively." + :type `(choice function + (choice ,@(mapcar (lambda (item) `(const ,item)) gt-taker-text-things))) + :group 'go-translate) + +(defcustom gt-taker-pick 'paragraph + "Filter the initial text and pick some for translation. + +If this is nil, do not pick and use the initial text as source text to +translate directly. + +If this is a symbol, then pick elements by thing from initial text for +translation, thing is just like those in `thing-at-point'. + +If this is a function then pass the initial text into it and use its result +as source text to translate. + +Specially if this is t, pick the text interactively. + +The default value is paragraph, that is, try to split initial text into +paragraphs and do a multiple parts translation. + +Notice, the value can be overrided by `pick' slot in taker of translator. So +config it for specific translator using slot is effectively." + :type `(choice function + (choice ,@(mapcar (lambda (item) `(const ,item)) gt-taker-pick-things))) + :group 'go-translate) + +(defcustom gt-taker-prompt nil + "Whether or how to prompt for initial text and target. + +If you want to take the translation text and target interactively, set this to +a non nil value. + +If this is t, then read and confirm using minibuffer. If this is `buffer' then +open a new buffer instead to do the stuff. + +Notice, the value can be overrided by `prompt' slot in taker of translator. So +config it for specific translator using slot is effectively." + :type '(choice (const :tag "Off" nil) + (const :tag "With-Minibuffer" t) + (const :tag "With-Buffer" buffer) + symbol) + :group 'go-translate) + +(defcustom gt-lang-rules + (list (cons 'ja "[\u3040-\u30FF]") + (cons 'ko "[\uAC00-\uD7A3]") + (cons 'ru "[\u0410-\u044F]") ; if matched then text is ru, otherwise it's not + (cons 'zh (lambda () (re-search-forward "[\u4e00-\u9fa5]" nil t)))) + "Language match rules used to check the language of a given text. + +This is alist, key is the language and value is a regexp string or function. + +This is used by `gt-available-langs' to determine who are source language from +target list by matching this. Text will match against the rules one by one, +if matched, the language in rule serves as the source language, otherwise the +language is excluded from the source candidates. + +This is not perfect. It's not an easy thing to check the language precisely. +Maybe use the third party, for example python's langid, to check language is a +good idea. + +Please add rule for your own languages if possible, or fixup the mistakes in the +default rules to fit your need." + :type '(alist :key-type (symbol :tag "Lang") + :value-type (choice (function :tag "Function Rule") + (regexp :tag "Regexp rule"))) + :group 'go-translate) + +(defvar gt-skip-lang-rules-p nil) + +(defvar gt-ignore-target-history-p nil) + +(defvar gt-last-target nil) + +(defvar gt-target-history nil) + +(cl-defgeneric gt-langs-maybe (text langs) + "Which languages this TEXT maybe belongs to, pick from LANGS." + (let* ((srcs langs) + (hit (catch 'gt-langs + (with-temp-buffer + ;; insert text + (insert text) + ;; clear punctuations + (goto-char (point-min)) + (while (re-search-forward "\\s.\\|\n" nil t) (replace-match "")) + ;; apply rules + (cl-loop with rules = (cl-loop for r in gt-lang-rules if (member (car r) langs) collect r) + for (l . m) in rules + do (goto-char (point-min)) + do (if (if (functionp m) (funcall m) (re-search-forward m nil t)) + (throw 'gt-langs l) ; hit the one, return directly + (setq srcs (remove l srcs))) ; not the one, exclude it + finally (return nil)))))) + (if hit (ensure-list hit) srcs))) + +(cl-defgeneric gt-thing-at-point (thing _mode) + "Retrieve text at point or from the selected region. + +If there is an active region, return its bounds. Otherwise return +the bounds of the thing at point as a list of cons cells. + +THING should be an element of `gt-taker-text-things', it is used as the type +of thing to take. If it is nil, it uses the value of `gt-taker-text'. +If it is t, prompt the user to choose one from the list. + +This is a generic method, so you can extend the THING or override it for +specific MODE." + (:method :around (thing mode) + (if (use-region-p) + (region-bounds) + (when thing + (cl-call-next-method thing mode)))) + (unless (member thing gt-taker-text-things) + (setq thing (intern (completing-read "Take _ at point as source text: " gt-taker-text-things nil t nil 'gt-text-hist)))) + (gt-log 'taker (format "take text by: %s" thing)) + (if (eq thing 'buffer) + (let ((beg (save-excursion + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (beginning-of-line) + (point))) + (end (save-excursion + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (point)))) + (when (> end beg) + (list (cons beg end)))) + (when-let (rt (bounds-of-thing-at-point thing)) + (list rt)))) + +(cl-defgeneric gt-forward-thing (thing _mode) + "Get bound of THING after point and goto the end of THING. + +THING is is the ones in `gt-taker-pick-things'. + +This is a generic method, so you can override it for specific MODE." + (let ((ori (point)) pt end) + (pcase thing + ((or 'word 'symbol) (skip-syntax-forward "^w")) + (_ (skip-chars-forward " \r\n\t\f") + (when (string-match-p "[\n\r]" (buffer-substring ori (point))) + (skip-chars-backward " \t\f")))) + (setq pt (point)) + (forward-thing thing) + (setq end (if (memq thing '(paragraph)) + (point) + (save-excursion (skip-chars-backward " \r\n\t\f") (point)))) + (when (> end pt) (cons pt end)))) + +(defun gt-available-langs (langs text) + "Find available translation languages for given TEXT. + +LANGS is a list of languages to choose from, TEXT is used to determine +the available ones according rules in `gt-taker-lang-match-alist'. + +Return a list of language pairs (src . rest) where src is the source +language and rest is the target languages. Rest should be a list contains +one or more languages." + (if (cdr langs) + (setq langs (mapcar #'intern-soft langs)) + (user-error "At least two languages should be configed, current: %s" langs)) + (let* ((str (string-join (or (ensure-list text) ""))) + (srcs (or (if gt-skip-lang-rules-p langs (gt-langs-maybe str langs)) + (user-error "Maybe no language match current translation"))) + (pairs (if gt-polyglot-p + (cl-loop for lang in srcs + collect (cons lang (remove lang langs))) + (cl-loop for lang in srcs + append (cl-loop for tgt in (remove lang langs) + collect (list lang tgt)))))) + (if gt-ignore-target-history-p + pairs + (let* ((head (cl-delete-duplicates (cl-remove-if-not (lambda (l) (member l pairs)) gt-target-history))) + (tail (cl-remove-if (lambda (l) (member l head)) pairs))) + (append head tail))))) + +(defun gt-pick-items-by-thing (text-or-bounds &optional thing pred) + "Pick elements by THING from TEXT-OR-BOUNDS. + +THING is the one in `gt-taker-pick-things', PRED is a function with one +argument that used to filter the pick element. + +TEXT-OR-BOUNDS is a string or bound cell in the buffer. If it is a string, +should return a list of strings representing the pieces picked from the text. +If it is a bound, return a list of sub-bounds." + (if (null thing) + text-or-bounds + (unless (memq thing gt-taker-pick-things) + (setq thing (intern (completing-read "Pick _ for source text: " gt-taker-pick-things nil t nil 'gt-pick-hist)))) + (cl-flet ((ps (beg end mode) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (bds) + (while (not (save-excursion (skip-chars-forward " \r\n\t\f") (eobp))) + (when-let (bd (gt-forward-thing thing mode)) + (cl-destructuring-bind (a . b) bd + (when (or (null pred) (funcall pred (buffer-substring a b))) + (push (cons a b) bds))))) + (nreverse bds)))))) + (gt-log 'taker (format "pick from text by: %s" thing)) + (let ((mode major-mode)) + (cond ((stringp text-or-bounds) + (with-temp-buffer + (insert text-or-bounds) + (mapcar (lambda (p) (buffer-substring (car p) (cdr p))) + (ps (point-min) (point-max) mode)))) + ((consp text-or-bounds) + (let ((bd text-or-bounds)) ; (a . b) or (buffer (a . b)) + (with-current-buffer (if (bufferp (car bd)) (pop bd) (current-buffer)) + (if (consp (car bd)) (setq bd (car bd))) + (ps (car bd) (cdr bd) mode)))) + (t (user-error "Pick items error, maybe invalid input"))))))) + +(cl-defgeneric gt-take (taker translator) + "Take source text and targets for TRANSLATOR. + +This is core method of TAKER. It combines `gt-text', `gt-target', `gt-prompt' +and `gt-pick' together, saves text/bounds/target to be used in later translation +into the translator instance at last. + +See type `gt-taker' for more description." + (:method :before ((taker gt-taker) translator) + (gt-log-funcall "take (%s %s)" taker translator)) + (:method ((taker gt-taker) translator) + (with-slots (text bounds target keep) translator + (let ((prompt (and (null text) (null target) + (if (slot-boundp taker 'prompt) + (oref taker prompt) + gt-taker-prompt))) + (nopick (or (and text keep) + (gt-functionp (if (slot-boundp taker 'text) + (oref taker text) + gt-taker-text))))) + ;; 1) text + (unless text + (let ((rs (ensure-list (gt-text taker translator)))) + ;; bounds: (buffer (a . b) (c . d)) + (if (stringp (car rs)) + (setf bounds (list (current-buffer))) + (unless (bufferp (car rs)) + (push (current-buffer) rs)) + (setf bounds rs)) + ;; text: ("aaa" "bbb") + (setf text (gt-collect-text rs)))) + ;; 2) target + (unless target + (setf target (gt-target taker translator))) + ;; 3) prompt + (when prompt (gt-prompt taker translator prompt)) + (unless text (user-error "No source text found at all")) + ;; 4) pick + (unless nopick (gt-pick taker translator))))) + (:method :after ((taker gt-taker) translator) + (with-slots (text target) translator + (unless text + (user-error "Source Text should not be null")) + (with-slots (then) taker ; if `then' slot exists + (when (and (slot-boundp taker 'then) then (gt-functionp then)) + (funcall then translator)))))) + +(cl-defgeneric gt-text (_taker translator) + "Used to take initial text for TRANSLATOR. +Return text, text list or bounds in buffer. This is non-destructive." + (:method ((taker gt-taker) _translator) + "Return the text selected by the TAKER." + (let ((text (if (slot-boundp taker 'text) + (oref taker text) + gt-taker-text))) + (cond ((symbolp text) (gt-thing-at-point text major-mode)) + ((gt-functionp text) (funcall text)) + (t text))))) + +(cl-defgeneric gt-target (_taker translator &optional dir) + "Used to pick target for TRANSLATOR. +Return the target will be used. If DIR is `next or `prev, return the next or +previous one. This is non-destructive." + (:method ((taker gt-taker) translator &optional dir) + (when-let* ((langs (ensure-list + (if (slot-boundp taker 'langs) + (oref taker langs) + gt-langs))) + (tgts (if (car langs) + (gt-available-langs langs (oref translator text)) + (cdr langs))) + (index (let ((n (cl-position gt-last-target tgts :test #'equal))) + (if n (+ n (pcase dir ('next 1) ('prev -1) (_ 0))) 0))) + (target (nth (if (>= index (length tgts)) + 0 + (if (< index 0) (- (length tgts) 1) index)) + tgts))) + (setq gt-last-target target)))) + +(defvar gt-prompt-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\C-g" #'top-level) + (define-key map "\C-n" #'gt-prompt-next-target) + (define-key map "\C-p" (lambda () (interactive) (gt-prompt-next-target t))) + (define-key map "\C-l" #'delete-minibuffer-contents) + map) + "The keymap used when taker prompt with minibuffer.") + +(defvar gt-prompt-target nil) + +(defvar gt-prompt-overlay nil) + +(defun gt-prompt-prefix (target) + (when target + (format "[%s%s] " + (if-let (src (car target)) (format "%s > " src) "") + (mapconcat (lambda (s) (format "%s" s)) (ensure-list (cdr target)) ", ")))) + +(defun gt-prompt-next-target (&optional backwardp) + "Switch to next target in prompt minibuffer. +If BACKWARDP is not nil then switch to previous one." + (interactive) + (let ((gt-skip-lang-rules-p (or current-prefix-arg (string-blank-p (minibuffer-contents))))) + (setq gt-prompt-target + (gt-target (oref gt-current-translator taker) + (make-instance (eieio-object-class gt-current-translator) + :text (list (minibuffer-contents))) + (if backwardp 'prev 'next))) + (overlay-put gt-prompt-overlay 'before-string (gt-prompt-prefix gt-prompt-target)))) + +(cl-defgeneric gt-prompt (_taker translator _type) + "Prompt user with inital text and target, then update TRANSLATOR with new values." + (:method :before ((_taker gt-taker) translator _type) + (when (cdr (oref translator text)) ; for solo part only + (user-error "Multiple part text cannot be prompted"))) + (:method ((_ gt-taker) translator _type) + (with-slots (text bounds target) translator + (let* ((minibuffer-allow-text-properties t) + (newtext (minibuffer-with-setup-hook + (lambda () + (setq gt-prompt-target target) + (setq gt-prompt-overlay (make-overlay 1 2)) + (overlay-put gt-prompt-overlay 'before-string (gt-prompt-prefix gt-prompt-target))) + (read-from-minibuffer "Text: " (car text) gt-prompt-map)))) + (when (string-blank-p newtext) + (user-error "Text should not be null")) + (unless (equal newtext (car text)) + (setf bounds (list (car bounds)))) + (setf text (ensure-list newtext)) + (setf target gt-prompt-target))))) + +(cl-defgeneric gt-pick (_taker translator) + "Update TRANSLATOR with pieces picked from initial text or bounds." + (:method :around ((taker gt-taker) translator) + (with-slots (text bounds) translator + (unless (bufferp (car bounds)) ; ensure buffer is recorded + (push (current-buffer) bounds)) + (when (and (not (cdr text)) ; for solo part only + (if (slot-boundp taker 'pick) (oref taker pick) gt-taker-pick)) ; pick is non-nil + (cl-call-next-method taker translator)))) + (:method ((taker gt-taker) translator) + (with-slots (text bounds) translator + (if-let* ((buf (car bounds)) + (car (if (cdr bounds) (cl-subseq bounds 0 2) ; buffer bound + (or (car text) ; text + (user-error "Where should I pick from?")))) + (pick (if (slot-boundp taker 'pick) (oref taker pick) gt-taker-pick)) + (res (ensure-list + (cond + ((gt-functionp pick) (funcall pick car)) + ((memq pick gt-taker-pick-things) + (gt-pick-items-by-thing car pick (oref taker pick-pred))) + ((symbolp pick) (gt-pick pick translator)))))) + ;; string pieces vs bound pieces + (if (stringp (car res)) + (setf text res) + (unless (bufferp (car res)) (push buf res)) + (setf bounds res text (gt-collect-text res))) + (user-error "Nothing picked, empty request"))))) + + +;;; Engine + +(defcustom gt-cache-p t + "Whether enable the cache." + :type 'boolean + :group 'go-translate) + +(defconst gt-text-delimiter "314141592926666") + +(defun gt-current-cacher (engine task) + "Return the cacher used by ENGINE for current TASK." + (let (cacher condition) + (when gt-cache-p + (let ((cc (gt-ensure-plain + (if (slot-boundp engine 'cache) (if-let (c (gt-ensure-plain (oref engine cache) task)) c) t) + task))) + (cond ((null cc)) + ((eq cc t) (setq cacher gt-default-cacher condition nil)) + ((symbolp cc) (setq cacher gt-default-cacher condition cc)) + (t (setq cacher cc condition nil))))) + (cl-values cacher condition))) + +(cl-defmethod initialize-instance :after ((engine gt-engine) &rest _) + (unless (slot-boundp engine 'tag) + (oset engine tag (gt-desc engine)))) + +(cl-defmethod gt-init ((engine gt-engine) task) + "Preprocessing text in TASK for ENGINE. Try cache first if possible." + (with-slots (id text cache) task + (gt-log-funcall "init (%s %s)" engine id) + ;; if stream, not cache + (if (gt-stream-p engine) (oset engine cache nil)) + ;; query cache first + (when-let (cacher (car-safe (gt-current-cacher engine task))) + (setf cache (gt-cache-get cacher task))) + ;; only translate the parts not in cache + (if (and cache (cl-every #'identity cache)) + (gt-next engine task) + (let ((text-left (if cache (cl-loop for c in text for r in cache unless r collect c) text))) + ;; join with delimiter if possible + (if-let (delimiter (if (slot-boundp engine 'delimiter) (oref engine delimiter) gt-text-delimiter)) + (setf text (string-join text-left (concat "\n\n" delimiter "\n\n"))) + (setf text text-left)))))) + +(cl-defgeneric gt-translate (engine task &optional next) + "Translate or transform text in TASK and parse the results using ENGINE. + +The raw response will save into `res' slot of translator. Then NEXT runs, that +will do the parse and render job. See type `gt-engine' for more description." + (:method :around ((engine gt-engine) task &optional _next) + (gt-log-funcall "translate (%s %s)" engine (oref task id)) + (gt-init engine task) + (with-slots (id text err res render translator process) task + (unless (or res err) + (gt-log 'next (format "%s: %s prepare to translate" id (gt-desc engine))) + (let ((ret (cl-call-next-method + engine task + (lambda (task) + (if (equal (oref translator version) (oref task version)) + (condition-case err1 + (if (gt-stream-p engine) + (if gt-http-client-stream-abort-flag + (gt-log 'next (format "%s: %s translate streaming abort!" id (gt-desc engine))) + (gt-next-for-stream render task)) + (gt-log 'next (format "%s: %s translate success!" id (gt-desc engine))) + (gt-next engine task)) + (gt-fail task err1)) + (gt-log 'next (format "%s: ----- expired -----" id))))))) + (if (processp ret) (setf process ret)))))) + (:method ((engine gt-engine) _task _next) + (user-error "Method `gt-translate' of %s is not implement" (gt-desc engine)))) + +(cl-defgeneric gt-parse (_parser task) + "Parse results of TASK to user-friendly string." + (:method :before ((parser gt-parser) task) + (gt-log-funcall "parse (%s %s)" parser (oref task id))) + (:method ((_ gt-parser) _task) nil)) + +(cl-defgeneric gt-stream-p (_engine) + "Whether streaming query is on for ENGINE." + nil) + +(cl-defgeneric gt-next (_engine task) + "Chain to the parse and render phase for TASK." + (:method ((engine gt-engine) task) + (gt-log-funcall "next (%s %s)" engine (oref task id)) + (with-slots (text res meta cache translator) task + (with-slots (parse delimiter then) engine + ;; parse + (when res + (when-let (parser (and (slot-boundp engine 'parse) parse)) + (if (gt-functionp parser) + (funcall parser task) + (gt-parse parser task))) + ;; split with delimiter if possible + (when-let (delimiter (and (stringp res) (if (slot-boundp engine 'delimiter) delimiter gt-text-delimiter))) + (setf res (mapcar (lambda (item) (string-trim item "\n+")) (split-string res delimiter)))) + (setf res (ensure-list res)) + ;; run res-hook if possible + (when-let (hook (plist-get meta :res-hook)) + (setf res (funcall hook res)))) + ;; resume text and merge cache to res + (setf text (oref translator text)) + (if cache (setf res (cl-loop for c in cache if (null c) collect (pop res) else collect c))) + ;; verify + (unless res + (user-error "No translate result found")) + (unless (= (length (remove nil res)) (length text)) + (user-error "Source text and result text have no same length")) + ;; set cache if possible + (cl-destructuring-bind (cacher condition) (gt-current-cacher engine task) + (when cacher (gt-cache-set cacher task condition))) + ;; invoke then when it is exists + (when (and (slot-boundp engine 'then) then (gt-functionp then)) + (funcall then task)) + ;; all right, render + (gt-update-state translator) + (gt-output (oref translator render) translator))))) + +(cl-defgeneric gt-next-for-stream (_render task) + "Output result in TASK to specific marker position directly. +Notice, the result should propertized with `gt-result' to avoid issue. +This is used for streaming output for _RENDER." + (:method :around ((render gt-render) task) + (with-slots (markers) task + (if (null markers) + (progn + (setq gt-http-client-stream-abort-flag t) + (message "Stream output is unavailable for current task.")) + (setf markers (ensure-list markers)) + (cl-call-next-method render task)))) + (:method ((_render gt-render) task) + (with-slots (markers res) task + (save-excursion + (gt-insert-text-at-marker + (propertize (string-join (ensure-list res) "\n") 'gt-result 'stream) + (car markers) (cdr markers) t))))) + + +;;; Text to Speech + +(defcustom gt-tts-speaker (cl-find-if #'executable-find (list "mpv" "mplayer" "cvlc")) + "The program used to speak the translation result. +It also can be a command with options like `mpv --af=xxx'. +The value should not contain any space in the command path." + :type 'string + :group 'go-translate) + +(defvar gt-tts-langs nil) + +(defvar gt-tts-last-engine nil) + +(defvar gt-tts-speak-process nil) + +(defun gt-interrupt-speak-process () + (when (and gt-tts-speak-process (process-live-p gt-tts-speak-process)) + (ignore-errors (kill-process gt-tts-speak-process)) + (setq gt-tts-speak-process nil))) + +(cl-defmethod gt-play-audio (data &optional wait) + "Play DATA with `gt-tts-playing-process'. +DATA is raw audio data or audio url, or a buffer contains the raw data. +If WAIT is not nil, play after current process finished." + (unless (and gt-tts-speaker (executable-find (car (split-string gt-tts-speaker)))) + (user-error "You should install `mpv' first or config `gt-tts-speaker' correctly")) + (when wait + (condition-case _ + (while (and gt-tts-speak-process (process-live-p gt-tts-speak-process)) + (sleep-for 0.5)) + (quit (gt-interrupt-speak-process) (user-error "")))) + (gt-interrupt-speak-process) + (cl-flet ((speak () + (let ((proc (make-process + :name (format "gt-tts-process-%s" (+ 1000 (random 1000))) + :command (append (split-string-shell-command gt-tts-speaker) (list "-")) + :buffer nil + :noquery t + :sentinel (lambda (_ s) (if (string-match-p "finished" s) (message ""))) + :connection-type 'pipe))) + (message "Speaking...") + (setq gt-tts-speak-process proc) + (process-send-region proc (point-min) (point-max)) + (if (process-live-p proc) (process-send-eof proc))))) + (if (bufferp data) + (with-current-buffer data (speak)) + (with-temp-buffer + (let ((buf (current-buffer)) state) + (if (string-prefix-p "http" data) + (progn (gt-request :url data + :cache 10 + :done (lambda (raw) + (setq state 'done) + (with-current-buffer buf (insert raw))) + :fail (lambda (err) (setq state err))) + (while (null state) + (accept-process-output nil 0.5))) + (insert data)) + (if (and state (not (eq state 'done))) (signal 'user-error state)) + (speak)))))) + +(cl-defgeneric gt-speak (engine text &optional lang) + "Speak TEXT with LANG by ENGINE." + (:method ((_ (eql 'local)) text &optional _lang) + "TEXT to speech with local program." + (cond ((and (eq system-type 'darwin) (executable-find "say")) + (with-temp-buffer + (insert text) + (shell-command-on-region (point-min) (point-max) "say" t))) + ((and (memq system-type '(cygwin windows-nt)) (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 (user-error "No suitable local TTS service found")))) + (:method ((_ (eql 'interact)) text &optional noprompt) + "Text to speech with local program or using selected engine." + (let* ((prompt "Text to Speech: ") + (regexp (format "^ *\\(%s\\)\\." (mapconcat #'symbol-name (mapcar #'car gt-lang-codes) "\\|"))) + (engines `(locally ,@(cl-loop + for m in (cl--generic-method-table (cl--generic #'gt-speak)) + for n = (car (cl--generic-method-specializers m)) + unless (or (consp n) (memq n '(t gt-engine))) collect n))) + (overlay nil) + (text (if noprompt text + (minibuffer-with-setup-hook + (lambda () + (use-local-map (make-composed-keymap nil (current-local-map))) + (setq overlay (make-overlay (1- (length prompt)) (length prompt))) + (unless gt-tts-last-engine (setq gt-tts-last-engine 'locally)) + (overlay-put overlay 'display (format " (%s):" gt-tts-last-engine)) + (local-set-key (kbd "C-n") + (lambda () + (interactive) + (setq gt-tts-last-engine + (let ((i (cl-position gt-tts-last-engine engines))) + (nth (if (>= (+ i 1) (length engines)) 0 (1+ i)) engines))) + (overlay-put overlay 'display (format " (%s):" gt-tts-last-engine))))) + (read-string prompt (if (consp text) (buffer-substring (caar text) (cdar text)) text))))) + (lang (if (string-match regexp text) + (prog1 (intern-soft (match-string 1 text)) + (setq text (substring text (match-end 0)))) + (car (gt-langs-maybe text (or gt-tts-langs (mapcar #'car gt-lang-codes))))))) + (when (= (length (string-trim text)) 0) + (user-error "Input should not be null")) + (unless gt-tts-last-engine (setq gt-tts-last-engine 'locally)) + (gt-log 'tts (format "Speak with %s to %s" gt-tts-last-engine lang)) + (if (equal gt-tts-last-engine 'locally) + (gt-speak 'local text lang) + (gt-speak (make-instance gt-tts-last-engine) text lang)))) + (:method :around ((engine gt-engine) text &optional lang) + (cl-call-next-method engine text (intern-soft lang))) + (:method ((engine gt-engine) &rest _) + (user-error "No TTS service found on engine `%s'" (oref engine tag)))) + +;;;###autoload +(defun gt-do-speak () + "Speak content around point. + +If the text under point or with selection has `gt-task' or `gt-tts-url' +property, try to speak it with current translation engine. + +Otherwise try to TTS with local program or using selected engine. + +When TTS with specific engine, you can specify the language with `lang.' prefix." + (interactive) + (if-let (url (get-char-property (point) 'gt-tts-url)) + ;; 1. play the url + (gt-play-audio url) + (let (items engine) + (if-let (task (get-char-property (point) 'gt-task)) + (with-slots (src tgt res err translator) task + (with-slots (text target) translator + ;; 2. play current task + (setq engine (oref task engine)) + (unless (cl-find-method #'gt-speak '() `(,(eieio-object-class engine) t t)) + (user-error "No TTS service found on current engine `%s'" (oref engine tag))) + (let ((part (or (get-char-property (point) 'gt-part) 0)) + (col (lambda (l c) (push (format "%s. %s" l (substring-no-properties c)) items)))) + (if (use-region-p) + (cl-loop with text = (buffer-substring (region-beginning) (region-end)) + for l in (gt-langs-maybe text (list src tgt)) do (funcall col l text)) + (when-let (r (nth part text)) + (funcall col (car target) r)) + (when-let (r (and (not err) (or (get-pos-property (point) 'gt-brief) (nth part (ensure-list res))))) + (funcall col tgt r))) + (when items + (let* ((cand (completing-read + (format "Text to Speech (with %s): " (oref engine tag)) + (gt-make-completion-table items))) + (lang (if (string-match (format "^ *\\(%s\\)\\." (mapconcat #'symbol-name (mapcar #'car gt-lang-codes) "\\|")) cand) + (prog1 (intern-soft (match-string 1 cand)) + (setq cand (substring cand (match-end 0)))) + (car (gt-langs-maybe cand (list src tgt)))))) + (unless lang (user-error "Guess language of text failed")) + (gt-log 'tts (format "Speak with %s to %s" engine lang)) + (gt-speak engine cand lang)))))) + ;; 3. play with local program or using selected engine + (gt-speak 'interact (gt-text (gt-taker :text 'word) nil)))))) + + +;;; Render + +(cl-defmethod gt-init :around ((render gt-render) translator) + (gt-log-funcall "init (%s %s)" render translator) + (message "Processing...") + (condition-case err + (progn (cl-call-next-method render translator) + (gt-update-state translator)) + (error (gt-log 'render (format "%s initialize failed, abort" (gt-desc render))) + (user-error (format "[output init error] %s" err))))) + +(cl-defmethod gt-init ((_render gt-render) _translator) + "Initialize the RENDER. Only invoke once before output." + nil) + +(cl-defgeneric gt-extract (render translator) + "Extract TRANSLATOR's responses that to be consumed by RENDER." + (:method ((render gt-render) translator) + (with-slots (text tasks) translator + (cl-loop with tgts = (cl-delete-duplicates (mapcar (lambda (item) (oref item tgt)) tasks)) + with engines = (cl-delete-duplicates (mapcar (lambda (task) (oref task engine)) tasks)) + for task in tasks + for (tgt res err engine) = (gt-orefs task tgt res err engine) + for state = (if err 1 (if res 2 0)) ; 0 loading 1 error 2 result + for prefix = (with-slots (prefix) render + (if (and (slot-boundp render 'prefix) (not (eq prefix t))) + (when prefix + ;; custom prefix with :prefix slot + (if (gt-functionp prefix) + (funcall prefix task) + (format "%s" prefix))) + (when (or (cdr tgts) (cdr engines)) + ;; style as: en.Google.Detail + (let ((lst (list (if (cdr tgts) tgt) + (if (cdr engines) (oref engine tag)) + (if (cdr engines) (ignore-errors (oref (oref engine parse) tag)))))) + (concat + (mapconcat (lambda (item) (format "%s" item)) (remove nil lst) ".") + (if (and (cdr engines) (gt-stream-p engine)) " (stream)")))))) + for result = (pcase state (0 "Loading...") (1 err) (2 res)) + collect (list :result result :prefix prefix :state state :task task :tgt tgt :stream (gt-stream-p engine)) into lst + finally (return ;; sort by target, then by engine + (if (cdr tgts) + (cl-loop for tgt in tgts append + (cl-remove-if-not (lambda (tr) (equal tgt (plist-get tr :tgt))) lst)) + lst)))))) + +(cl-defgeneric gt-output (render translator) + "Output result of TRANSLATOR with RENDER, invoked after every task parsed. +Output to minibuffer by default." + (:method :around ((render gt-render) translator) + (with-slots (state) translator + (gt-log-funcall "output (%s %s) %s" render translator state) + (when (<= state 4) + (with-slots (output then) render + ;; error handler & functionp case + (condition-case err + (if (gt-functionp output) + (funcall output render translator) + (cl-call-next-method render translator) + ;; chain next render if possible + (when (and (= state 3) then) + (cond ((gt-functionp then) + (funcall then translator)) + ((and (eieio-object-p then) (object-of-class-p then 'gt-render)) + (gt-init then translator) + (gt-output then translator)) + (t (error "Bad then value specified in %s" (gt-desc render)))))) + (error (setf state 4) + (message "[output error] %s" (cadr err)))))))) + (:method ((render gt-render) translator) + (when (= 3 (oref translator state)) + (cl-loop with ret = (gt-extract render translator) + with mpp = (cdr (oref translator text)) + for tr in ret + for (prefix result) = (gt-plist-let tr (list (concat "[" .prefix "]" (if mpp "\n" " ")) .result)) + collect (concat (if (cdr ret) (propertize prefix 'face 'gt-render-prefix-face)) + (if (consp result) (string-join result "\n") result)) + into lst + finally (message "%s" (string-join lst "\n")))))) + + +;;; Translator + +(defun gt-add-task (task) + "Add new TASK for translation." + (with-slots (id engine render version translator) task + (with-slots (tasks state) translator + (when (= state 0) + (setf tasks (append tasks (list task))) + (gt-log (format "%d" (length tasks)) + (format "add task %s: (%s/%s)" id (gt-desc engine) (gt-desc render))))))) + +(defun gt-update-state (translator) + "Update state for TRANSLATOR." + (with-slots (state total tasks render) translator + (pcase state + (0 + (when (= (length tasks) total) + (gt-log 'translator "<1> all tasks added") + (setf state 1))) + (1 + (gt-log 'translator + (format "<2> %s prepared" (gt-desc render))) + (setf state 2)) + (2 + (when (= total (length (cl-remove-if-not (lambda (task) (or (oref task err) (oref task res))) tasks))) + (gt-log 'translator "<3> all result parsed") + (setf state 3)))))) + +(defun gt-fail (task error) + "Render ERROR message and ternimate the TASK." + (declare (indent 1)) + (gt-log-funcall "fail (%s)" (oref task id)) + (with-slots (translator render err version id) task + (when (equal version (oref translator version)) + (setf err (if (consp error) + (mapconcat (lambda (r) + (format (if (string-suffix-p "error" (format "%s" r)) "[%s]" "%s") r)) + (cl-remove-if (lambda (r) (memq r '(error user-error))) error) + " ") + (or error ""))) + (gt-update-state translator) + (gt-output render translator)) + (gt-log 'next (format "%s: [----- error -----] %s" id error)) + (gt-log nil 1 (with-temp-buffer + (let ((standard-output (current-buffer))) + (backtrace) + (buffer-string)))))) + +(cl-defgeneric gt-reset (translator) + "Reset status and other variables before translation for TRANSLATOR." + (:method ((translator gt-translator)) + (gt-log-funcall "reset (%s)" translator) + (unless gt-default-cacher + (setq gt-default-cacher (gt-memory-cacher))) + (unless gt-default-http-client + (setq gt-default-http-client (gt-url-http-client))) + (with-slots (version state tasks bag total taker engines render _taker _engines _render) translator + (unless (slot-boundp translator '_taker) + (unless taker (setf taker (gt-taker))) + (unless render (setf render (gt-render))) + (setf _taker taker _engines engines _render render)) + (setf version (time-to-seconds) state 0 tasks nil total 0 taker nil engines nil render nil bag nil)))) + +(cl-defmethod gt-init ((translator gt-translator) &rest _) + "Initialize the components, text and target for TRANSLATOR." + (gt-log-funcall "init (%s)" translator) + (with-slots (keep text bounds target version taker engines render _taker _engines _render) translator + ;; reset + (gt-reset translator) + ;; take + (unless keep (setf text nil bounds nil target nil)) + (setf taker (or (cl-find-if (lambda (tk) (gt-valid tk translator)) + (ensure-list (gt-ensure-plain _taker))) + (user-error "No taker found in this translator"))) + (gt-take taker translator) + (setf keep nil) + (let ((history-delete-duplicates t)) + (add-to-history 'gt-target-history target 8)) + ;; prepare engines and render + (setf engines (ensure-list (gt-ensure-plain _engines))) + (setf render (cl-find-if (lambda (rd) (gt-valid rd translator)) + (ensure-list (gt-ensure-plain _render)))) + ;; log + (gt-log 'translator (format "version: %s\ntarget: %s\nbounds: %s\ntext: %s\ntaker: %s, engines: %s, render: %s" + version target bounds text + (gt-desc taker) + (mapcar (lambda (en) (oref en tag)) engines) + (gt-desc render))))) + +(cl-defgeneric gt-start (translator) + "Start a new translation with TRANSLATOR." + (gt-log "\n\n") + (gt-log-funcall "start (%s)" translator) + (setq gt-current-command this-command) + (setq gt-current-translator translator) + ;; init + (gt-init translator nil) + (with-slots (text target version total engines render) translator + ;; tasks + (cl-loop for engine in engines + do (cl-loop for tgt in (cdr target) + for task = (gt-task + :text text + :src (car target) + :tgt tgt + :engine engine + :render render + :translator translator + :version version) + if (gt-valid engine task) + do (cl-incf total) and do (gt-add-task task)) + finally (gt-update-state translator)) + (when (zerop total) + (user-error "No task created, please check engines and langs setup")) + ;; translate + (if render (gt-init render translator)) + (cl-loop for task in (oref translator tasks) + do (condition-case err + (gt-translate (oref task engine) task) + (error (gt-fail task err)))))) + +(provide 'gt-core) + +;;; gt-core.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-bing.el b/elpa/go-translate-20240802.131/gt-engine-bing.el new file mode 100644 index 00000000..6d6f52df --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-bing.el @@ -0,0 +1,203 @@ +;;; gt-engine-bing.el --- Microsoft Translate -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; https://bing.com/translator + +;;; Code: + +(require 'gt-extension) + +(defgroup go-translate-bing nil + "Configs for Bing engine." + :group 'go-translate) + + + +(defclass gt-bing-parser (gt-parser) ()) + +(defclass gt-bing-engine (gt-engine) + ((tag :initform 'Bing) + (host :initform "https://www.bing.com") + (host-tld :initform nil) + (ig :initform nil) + (key :initform nil) + (token :initform nil) + (last-time :initform nil) + (expired-time :initform (* 30 60)) + (parse :initform (gt-bing-parser)))) + + +;;; Translate + +(defvar gt-bing-extra-langs-mapping '((zh . "zh-Hans"))) + +(defvar gt-bing-token-maybe-invalid nil) + +(defun gt-bing-get-lang (lang) + (or (cdr-safe (assoc lang gt-bing-extra-langs-mapping)) lang)) + +(defun gt-bing-with-token (engine done) + (declare (indent 1)) + (with-slots (ig key token host host-tld last-time expired-time) engine + (if (and token key ig last-time (not gt-bing-token-maybe-invalid) + (< (- (time-to-seconds) last-time) expired-time)) + (funcall done) + (gt-request :url (concat host "/translator") + :done (lambda (raw) + (with-temp-buffer + (insert raw) + (goto-char (point-min)) + (re-search-forward "IG:\"\\([A-Za-z0-9]+\\)\"") + (setf ig (match-string 1)) + (re-search-forward "curUrl=\"\\(http[a-z]*\\).*?\\([a-zA-Z]+\\.bing.com\\)") + (setf host-tld (concat (match-string 1) "://" (match-string 2))) + (re-search-forward "var params_AbusePreventionHelper = \\[\\([0-9]+\\), *\"\\([^\"]+\\)") + (setf key (match-string 1) token (match-string 2)) + (setf last-time (time-to-seconds)) + (setq gt-bing-token-maybe-invalid nil) + (gt-log 'bing (format "url: %s\nkey: %s\ntoken: %s\nig: %s" host-tld key token ig)) + (funcall done))) + :fail (lambda (err) (user-error "[BING] Get Token failed. %s" err)))))) + +(cl-defmethod gt-translate ((engine gt-bing-engine) task next) + (gt-bing-with-token engine + (lambda () + (with-slots (text src tgt res) task + (with-slots (host-tld ig key token) engine + (gt-request :url (format "%s/ttranslatev3?isVertical=1&IID=translator.5022.1&IG=%s" host-tld ig) + :headers `(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8")) + :data `(("fromLang" . ,(gt-bing-get-lang src)) + ("to" . ,(gt-bing-get-lang tgt)) + ("text" . ,text) + ("key" . ,key) + ("token" . ,token)) + :done (lambda (raw) + (setf res raw) + (funcall next task)) + :fail (lambda (err) + (gt-fail task + (pcase (car-safe (cdr-safe err)) + (429 "[429] Too many requests! Please try later") + (_ err)))))))))) + +(cl-defmethod gt-parse ((_ gt-bing-parser) task) + (with-slots (res err) task + (if-let* ((json (json-read-from-string (decode-coding-string res 'utf-8))) + (result (ignore-errors (cdr (assoc 'text (aref (cdr (assoc 'translations (aref json 0))) 0)))))) + (setf res result) + (setq gt-bing-token-maybe-invalid t) ; refresh token when error occurred + (setf err res) + (error "error %s" res)))) + + +;;; Text to Speech + +(defcustom gt-bing-tts-speed 1.0 + "Playing speed of TTS audio, 1.0 is normal speed." + :type 'number + :group 'go-translate-bing) + +(defvar gt-bing-tts-mapping '((zh . ("zh-CN" "Female" "zh-CN-XiaoxiaoNeural")) + (en . ("en-US" "Female" "en-US-AriaNeural")) + (af . ("af-ZA" "Female" "af-ZA-AdriNeural")) + (am . ("am-ET" "Female" "am-ET-MekdesNeural")) + (ar . ("ar-SA" "Male" "ar-SA-HamedNeural")) + (bn . ("bn-IN" "Female" "bn-IN-TanishaaNeural")) + (bg . ("bg-BG" "Male" "bg-BG-BorislavNeural")) + (ca . ("ca-ES" "Female" "ca-ES-JoanaNeural")) + (cs . ("cs-CZ" "Male" "cs-CZ-AntoninNeural")) + (cy . ("cy-GB" "Female" "cy-GB-NiaNeural")) + (da . ("da-DK" "Female" "da-DK-ChristelNeural")) + (de . ("de-DE" "Female" "de-DE-KatjaNeural")) + (el . ("el-GR" "Male" "el-GR-NestorasNeural")) + (es . ("es-ES" "Female" "es-ES-ElviraNeural")) + (et . ("et-EE" "Female" "et-EE-AnuNeural")) + (fa . ("fa-IR" "Female" "fa-IR-DilaraNeural")) + (fi . ("fi-FI" "Female" "fi-FI-NooraNeural")) + (fr . ("fr-FR" "Female" "fr-FR-DeniseNeural")) + (ga . ("ga-IE" "Female" "ga-IE-OrlaNeural")) + (gu . ("gu-IN" "Female" "gu-IN-DhwaniNeural")) + (he . ("he-IL" "Male" "he-IL-AvriNeural")) + (hi . ("hi-IN" "Female" "hi-IN-SwaraNeural")) + (hr . ("hr-HR" "Male" "hr-HR-SreckoNeural")) + (hu . ("hu-HU" "Male" "hu-HU-TamasNeural")) + (id . ("id-ID" "Male" "id-ID-ArdiNeural")) + (is . ("is-IS" "Female" "is-IS-GudrunNeural")) + (it . ("it-IT" "Male" "it-IT-DiegoNeural")) + (ja . ("ja-JP" "Female" "ja-JP-NanamiNeural")) + (kk . ("kk-KZ" "Female" "kk-KZ-AigulNeural")) + (km . ("km-KH" "Female" "km-KH-SreymomNeural")) + (kn . ("kn-IN" "Female" "kn-IN-SapnaNeural")) + (ko . ("ko-KR" "Female" "ko-KR-SunHiNeural")) + (lo . ("lo-LA" "Female" "lo-LA-KeomanyNeural")) + (lv . ("lv-LV" "Female" "lv-LV-EveritaNeural")) + (lt . ("lt-LT" "Female" "lt-LT-OnaNeural")) + (mk . ("mk-MK" "Female" "mk-MK-MarijaNeural")) + (ml . ("ml-IN" "Female" "ml-IN-SobhanaNeural")) + (mr . ("mr-IN" "Female" "mr-IN-AarohiNeural")) + (ms . ("ms-MY" "Male" "ms-MY-OsmanNeural")) + (mt . ("mt-MT" "Female" "mt-MT-GraceNeural")) + (my . ("my-MM" "Female" "my-MM-NilarNeural")) + (nl . ("nl-NL" "Female" "nl-NL-ColetteNeural")) + (nb . ("nb-NO" "Female" "nb-NO-PernilleNeural")) + (pl . ("pl-PL" "Female" "pl-PL-ZofiaNeural")) + (ps . ("ps-AF" "Female" "ps-AF-LatifaNeural")) + (pt . ("pt-BR" "Female" "pt-BR-FranciscaNeural")) + (ro . ("ro-RO" "Male" "ro-RO-EmilNeural")) + (ru . ("ru-RU" "Female" "ru-RU-DariyaNeural")) + (sk . ("sk-SK" "Male" "sk-SK-LukasNeural")) + (sl . ("sl-SI" "Male" "sl-SI-RokNeural")) + (sv . ("sv-SE" "Female" "sv-SE-SofieNeural")) + (ta . ("ta-IN" "Female" "ta-IN-PallaviNeural")) + (te . ("te-IN" "Male" "te-IN-ShrutiNeural")) + (th . ("th-TH" "Male" "th-TH-NiwatNeural")) + (tr . ("tr-TR" "Female" "tr-TR-EmelNeural")) + (uk . ("uk-UA" "Female" "uk-UA-PolinaNeural")) + (ur . ("ur-IN" "Female" "ur-IN-GulNeural")) + (uz . ("uz-UZ" "Female" "uz-UZ-MadinaNeural")) + (vi . ("vi-VN" "Male" "vi-VN-NamMinhNeural")) + (yue . ("zh-HK" "Female" "zh-HK-HiuGaaiNeural")))) + +(cl-defmethod gt-bing-tts-payload (lang text) + (let ((lm (assoc lang gt-bing-tts-mapping))) + (unless lm (user-error "Add the mapping of your language into `gt-bing-tts-langs-mapping' :)")) + (format "%s" + (cadr lm) (caddr lm) (cadr lm) (cadddr lm) + gt-bing-tts-speed (encode-coding-string text 'utf-8)))) + +(cl-defmethod gt-speak ((engine gt-bing-engine) text lang) + (with-slots (host host-tld ig key token) engine + (message "Requesting from %s for %s..." (or host-tld host) lang) + (gt-bing-with-token engine + (lambda () + (gt-request :url (format "%s/tfettts?isVertical=1&IID=translator.5022.2&IG=%s" host-tld ig) + :headers '(("content-type" . "application/x-www-form-urlencoded")) + :data `(("token" . ,token) ("key" . ,key) ("ssml" . ,(gt-bing-tts-payload lang text))) + :cache (length text) + :done #'gt-play-audio + :fail (lambda (err) (message "[BING-TTS] error in request, %s" err))))))) + +(provide 'gt-engine-bing) + +;;; gt-engine-bing.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-chatgpt.el b/elpa/go-translate-20240802.131/gt-engine-chatgpt.el new file mode 100644 index 00000000..01d0f449 --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-chatgpt.el @@ -0,0 +1,190 @@ +;;; gt-engine-chatgpt.el --- Engine for ChatGPT -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; https://platform.openai.com/docs/api-reference + +;;; Code: + +(require 'gt-extension) + +(defgroup go-translate-chatgpt nil + "Configs for ChatGPT engine." + :group 'go-translate) + + +;;; Components + +(defclass gt-chatgpt-engine (gt-engine) + ((tag :initform 'ChatGPT) + (host :initarg :host :initform nil) + (model :initarg :model :initform nil) + (temperature :initarg :temperature :initform nil) + (key :initarg :key :initform 'apikey + :documentation "The apikey of ChatGPT. +Can also put into .authinfo file as: + machine api.openai.com login apikey password ***"))) + + +;;; Translate + +(defcustom gt-chatgpt-host "https://api.openai.com" + "API host of ChatGPT." + :type 'string + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-key nil + "Auth Key of ChatGPT. Recommend to save in .authinfo file instead." + :type 'string + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-model "gpt-3.5-turbo" + "Model to be used in chat." + :type 'string + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-temperature 0.8 + "Temperature of ChatGPT." + :type 'number + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-system-prompt "You are a translation assistant" + "System prompt send to server when translation." + :type 'string + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-user-prompt-template "Translate the text to %s, text is: \n%s" + "Template for user prompt when translation. +When it is string, %s is placeholders of lang and text. +When it is function, arguments passed to it should be text and lang." + :type '(choice string function) + :group 'go-translate-chatgpt) + +(declare-function pulse-momentary-highlight-region "pulse") + +(defvar gt-chatgpt-streaming-finished-hook #'pulse-momentary-highlight-region + "The logic runs after all streams finished. +With two arguments BEG and END, which are the marker bounds of the result.") + +(cl-defmethod gt-ensure-key ((engine gt-chatgpt-engine)) + (with-slots (host key) engine + (unless (stringp key) + (if-let (apikey (or (gt-lookup-password + :user (if key (format "%s" key) "apikey") + :host (url-host (url-generic-parse-url (or host gt-chatgpt-host)))) + gt-chatgpt-key)) + (setf key apikey) + (user-error "You should provide a apikey for gt-chatgpt-engine"))))) + +(cl-defmethod gt-translate ((engine gt-chatgpt-engine) task next) + (gt-ensure-key engine) + (with-slots (text src tgt res translator markers) task + (with-slots (host key model temperature stream) engine + (when (and stream (cdr (oref translator text))) + (user-error "Multiple parts not support streaming")) + (gt-request :url (concat (or host gt-chatgpt-host) "/v1/chat/completions") + :headers `(("Content-Type" . "application/json") + ("Authorization" . ,(concat "Bearer " (encode-coding-string key 'utf-8)))) + :data (encode-coding-string + (json-encode + `((model . ,(or model gt-chatgpt-model)) + (temperature . ,(or temperature gt-chatgpt-temperature)) + (stream . ,stream) + (messages . [((role . system) + (content . ,gt-chatgpt-system-prompt)) + ((role . user) + (content . ,(if (functionp gt-chatgpt-user-prompt-template) + (funcall gt-chatgpt-user-prompt-template text tgt) + (format gt-chatgpt-user-prompt-template (alist-get tgt gt-lang-codes) text))))]))) + 'utf-8) + :filter (when stream + (lambda () + (unless gt-tracking-marker + (setq gt-tracking-marker (make-marker)) + (set-marker gt-tracking-marker (point-min))) + (goto-char gt-tracking-marker) + (condition-case err + (while (re-search-forward "^data: +\\({.+}\\)" nil t) + (let* ((json (json-read-from-string (decode-coding-string (match-string 1) 'utf-8))) + (choice (aref (alist-get 'choices json) 0)) + (content (alist-get 'content (alist-get 'delta choice))) + (finish (alist-get 'finish_reason choice))) + (if finish + (progn (message "") + (when gt-chatgpt-streaming-finished-hook + (with-current-buffer (marker-buffer (car markers)) + (funcall gt-chatgpt-streaming-finished-hook (car markers) (cdr markers))))) + (setf res (concat res content)) + (set-marker gt-tracking-marker (point)) + (unless (string-blank-p (concat res)) + (funcall next task))))) + (error (unless (string-prefix-p "json" (format "%s" (car err))) + (signal (car err) (cdr err))))))) + :done (unless stream + (lambda (raw) + (with-slots (res) task + (let* ((json (json-read-from-string raw)) + (str (alist-get 'content (alist-get 'message (let-alist json (aref .choices 0)))))) + (setf res str)) + (funcall next task)))) + :fail (lambda (err) (gt-fail task err)))))) + +(cl-defmethod gt-stream-p ((engine gt-chatgpt-engine)) + (oref engine stream)) + + +;;; Text to Speech + +(defcustom gt-chatgpt-tts-model "tts-1" + "Model used by TTS of ChatGPT." + :type 'string + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-tts-speed 1.0 + "Speech speed of return audio from ChatGPT." + :type 'number + :group 'go-translate-chatgpt) + +(defcustom gt-chatgpt-tts-voice "alloy" + "Which voice to use by ChatGPT Speech. +alloy, echo, fable, onyx, nova, or shimmer." + :type 'string + :group 'go-translate-chatgpt) + +(cl-defmethod gt-speak ((engine gt-chatgpt-engine) text _lang) + (gt-ensure-key engine) + (with-slots (host key) engine + (gt-request :url (concat (or host gt-chatgpt-host) "/v1/audio/speech") + :headers `(("Content-Type" . "application/json") + ("Authorization" . ,(concat "Bearer " key))) + :data (json-encode + `((input . ,text) + (model . ,gt-chatgpt-tts-model) + (speed . ,gt-chatgpt-tts-speed) + (voice . ,gt-chatgpt-tts-voice))) + :done #'gt-play-audio + :cache (length text)))) + +(provide 'gt-engine-chatgpt) + +;;; gt-engine-chatgpt.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-deepl.el b/elpa/go-translate-20240802.131/gt-engine-deepl.el new file mode 100644 index 00000000..4efdecb7 --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-deepl.el @@ -0,0 +1,164 @@ +;;; gt-engine-deepl.el --- Translate Engine for DeepL -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; https://www.deepl.com + +;;; Code: + +(require 'gt-extension) + +(defgroup go-translate-deepl nil + "Configs for DeepL engine." + :group 'go-translate) + + +;;; Components + +(defclass gt-deepl-parser (gt-parser) ()) + +(defclass gt-deepl-engine (gt-engine) + ((tag :initform 'DeepL) + (host :initform "https://api.deepl.com") + (host-free :initform "https://api-free.deepl.com") + (path :initform "/v2/translate") + (parse :initform (gt-deepl-parser)) + + (pro :initform nil + :initarg :pro + :documentation "Set t when use PRO version.") + + (key :initform 'auth-key + :initarg :key + :documentation "The auth-key of DeepL. +You can also put it into .authinfo file as: + machine api.deepl.com login auth-key password ***"))) + + +;;; Utils + +(defcustom gt-deepl-fill-enable t + "Controller whether 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 `gt-deepl-fill-input' +or `gt-deepl-fill-output'." + :type 'boolean + :group 'go-translate-deepl) + +(cl-defmethod gt-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 gt-deepl-fill-enable + (with-temp-buffer + (insert text) + (let ((fill-column (* 2 (point-max)))) + (fill-region (point-min) (point-max))) + (buffer-string)) + text)) + +(cl-defmethod gt-deepl-fill-output (text) + "Improve the output TEXT for better reading experience. +Mainly fill the text to suitable length." + (if gt-deepl-fill-enable + (with-temp-buffer + (insert text) + (fill-region (point-min) (point-max)) + (buffer-string)) + text)) + + +;;; Engine + +(defcustom gt-deepl-extra-params '(("split_sentences" . "1") + ("preserve_formatting" . "1")) + "Extra translation params send to DeepL server." + :type '(alist :key-type (string :tag "Key") + :value-type (string :tag "Value")) + :group 'go-translate-deepl) + +(defvar gt-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 + )) + +(defun gt-deepl-get-lang (lang) + (if-let (mapping (assoc lang gt-deepl-langs-mapping)) + (cdr mapping) + (user-error "Language %s is not supported by DeepL. +Supported list: %s" lang (mapconcat #'car gt-deepl-langs-mapping ", ")))) + +(cl-defmethod gt-ensure-key ((engine gt-deepl-engine)) + (with-slots (key) engine + (unless (stringp key) + (if-let (auth-key (gt-lookup-password + :user (if key (format "%s" key) "auth-key") + :host "api.deepl.com")) + (setf key auth-key) + (user-error "You should provide a auth-key for gt-deepl-engine"))))) + +(cl-defmethod gt-translate ((engine gt-deepl-engine) task next) + (gt-ensure-key engine) + (with-slots (text src tgt res) task + (with-slots (host host-free path pro key) engine + (gt-request :url (concat (if pro host host-free) path) + :headers `(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8") + ("Authorization" . ,(concat "DeepL-Auth-Key " key))) + :data `(("text" . ,(gt-deepl-fill-input text)) + ("target_lang" . ,(gt-deepl-get-lang tgt)) + ,(if-let (src (gt-deepl-get-lang src)) `("source_lang" . ,src)) + ,@gt-deepl-extra-params) + :done (lambda (raw) + (setf res raw) + (funcall next task)) + :fail (lambda (err) + (gt-fail task (pcase (car-safe (cdr-safe err)) + (403 "[403] Authorization failed. Please supply a valid auth_key parameter") + (413 "[413] The request size exceeds the limit") + (414 "[414] Request-URI Too Long") + (429 "[429] Too many requests. Please wait and resend your request") + (456 "[456] Quota exceeded. The character limit has been reached") + (_ err)))))))) + + +;;; Parser + +(cl-defmethod gt-parse ((_ gt-deepl-parser) task) + (with-slots (res meta) task + (let* ((json (json-read-from-string res)) + (str (decode-coding-string (mapconcat #'cdadr (cdar json) "\n") 'utf-8)) + (hook (lambda (rs) (mapcar #'gt-deepl-fill-output rs)))) + (setf res str meta (plist-put meta :res-hook hook))))) + +(provide 'gt-engine-deepl) + +;;; gt-engine-deepl.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-echo.el b/elpa/go-translate-20240802.131/gt-engine-echo.el new file mode 100644 index 00000000..165de0c8 --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-echo.el @@ -0,0 +1,70 @@ +;;; gt-engine-echo.el --- Echo Translate -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; For simple transform, and for test. + +;;; Code: + +(require 'gt-extension) + +(defclass gt-echo-engine (gt-engine) + ((tag :initform 'Echo) + (do :initform nil :initarg :do))) + +(cl-defmethod initialize-instance :after ((engine gt-echo-engine) &rest _) + (with-slots (cache delimiter) engine + (setf cache nil delimiter nil))) + +(cl-defmethod gt-translate ((engine gt-echo-engine) task next) + (with-slots (text res) task + (with-slots (do) engine + (setf res text) + (cl-labels ((process (sym) + (cond ((eq sym 'clean) + (setf res (mapcar #'substring-no-properties res))) + ((eq sym 'br) + (setf res (mapcar #'gt-prop-for-bionic-reading res))) + ((functionp sym) + (setf res (funcall sym res))) + ((consp sym) + (cl-loop for o in sym do (process o)))))) + (process do) + (funcall next task))))) + + + +(defun gt-prop-for-bionic-reading (text) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (skip-chars-forward " \t\n\r\f") + (while (forward-word) + (cl-destructuring-bind (beg . end) (bounds-of-thing-at-point 'word) + (setq end (+ beg (/ (- end beg) 2))) + (put-text-property beg end 'font-lock-face 'gt-bionic-reading-face))) + (buffer-string))) + +(provide 'gt-engine-echo) + +;;; gt-engine-echo.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-google-rpc.el b/elpa/go-translate-20240802.131/gt-engine-google-rpc.el new file mode 100644 index 00000000..c150b3a7 --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-google-rpc.el @@ -0,0 +1,223 @@ +;;; gt-engine-google-rpc.el --- Google translation with RPC API -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; http://translate.google.com, new RPC API + +;;; Code: + +(require 'gt-engine-google) + +(defgroup go-translate-google-rpc nil + "Configs for GoogleRPC engine." + :group 'go-translate) + +(defcustom gt-google-rpc-host "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-google-rpc) + + +;;; Components + +(defclass gt-google-rpc-parser (gt-google-parser) + ((tag :initform "Detail"))) + +(defclass gt-google-rpc-summary-parser (gt-google-summary-parser gt-google-rpc-parser) + ((tag :initform "Summary"))) + +(defclass gt-google-rpc-engine (gt-engine) + ((tag :initform 'GoogleRPC) + (host :initform nil) + (path :initform "/_/TranslateWebserverUi/data/batchexecute") + (parse :initform (gt-google-rpc-parser)) + + (rpc-translate :initform "MkEWBc") + (rpc-tts :initform "jQ1olc") + (rpc-sid :initform "FdrFJe") + (rpc-bl :initform "cfb2h"))) + + +;;; Engine + +(defcustom gt-google-rpc-request-headers + '(("Connection" . "Keep-Alive") + ("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8")) + "Extra request headers send to google-rpc server." + :type '(alist :key-type (string :tag "Key") :value-type (string :tag "Value")) + :group 'go-translate-google-rpc) + +(defun gt-google-rpc-with-token (engine done fail) + (declare (indent 1)) + (with-slots (host path rpc-sid rpc-bl) engine + (gt-request :url (or host gt-google-rpc-host) + :done (lambda (raw) + (with-temp-buffer + (insert raw) + (goto-char (point-min)) + (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" (or host gt-google-rpc-host) path + (gt-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 gt-translate ((engine gt-google-rpc-engine) task next) + (gt-google-rpc-with-token engine + (lambda (url-tpl) + (with-slots (text src tgt res) task + (with-slots (rpc-translate) engine + (gt-request :url (funcall url-tpl rpc-translate tgt) + :headers gt-google-rpc-request-headers + :data (format + "f.req=%s&" + (url-hexify-string + (json-encode `[[[,rpc-translate ,(json-encode `[[,text ,src ,tgt 1][]]) nil "generic"]]]))) + :done (lambda (raw) (setf res raw) (funcall next task)) + :fail (lambda (err) (gt-fail task err)))))) + (lambda (err) + (gt-fail task (format "Take token failed, %s" err))))) + +(cl-defmethod gt-speak ((engine gt-google-rpc-engine) text lang) + (with-slots (host rpc-tts) engine + (message "Requesting %s for %s..." (or host gt-google-rpc-host) lang) + (gt-google-rpc-with-token engine + (lambda (url-tpl) + (gt-request :url (funcall url-tpl rpc-tts "en-US") + :headers gt-google-rpc-request-headers + :data (format + "f.req=%s&" + (url-hexify-string + (json-encode `[[[,rpc-tts ,(json-encode `[,text ,lang nil "undefined" [0]]) nil "generic"]]]))) + :done (lambda (raw) + (with-temp-buffer + (insert raw) + (goto-char (point-min)) + (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)))) + (if-let (data (and (string= (gt-aref json 0 0) "wrb.fr") (gt-aref json 0 2))) + (progn (setq code (aref (json-read-from-string data) 0)) + (erase-buffer) + (insert code) + (base64-decode-region (point-min) (point-max)) + (gt-play-audio (current-buffer))) + (message "[GoogleRPC-TTS] No tts data responsed"))))) + :fail (lambda (err) (message "[GoogleRPC-TTS] Error, %s" err)))) + (lambda (err) (message "[GoogleRPC-TTS] Take token failed, %s" err))))) + + +;;; Parser + +(cl-defmethod gt-resp-to-json ((_ gt-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 gt-result--brief ((_ gt-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))) + (gt-aref json 1 0 0 5) + "")) + +(cl-defmethod gt-result--sphonetic ((_ gt-google-rpc-parser) json) + "Get the text phonetic from JSON." + (gt-aref json 0 0)) + +(cl-defmethod gt-result--tphonetic ((_ gt-google-rpc-parser) json) + "Get the translation phonetic from JSON." + (gt-aref json 1 0 0 1)) + +(cl-defmethod gt-result--details ((_ gt-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 (gt-aref 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 gt-result--definitions ((_ gt-google-rpc-parser) json) + "Get the definitions from JSON. +Result style: ((noun (a b)) (verb (c d)))." + (cl-loop with defs = (ignore-errors (gt-aref 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 gt-result--suggestion ((_ gt-google-rpc-parser) json) + "Get the suggestion from JSON." + (ignore-errors + (replace-regexp-in-string "\\|\\|\\|" "" (gt-aref json 0 1 0 0 1)))) + +(provide 'gt-engine-google-rpc) + +;;; gt-engine-google-rpc.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-google.el b/elpa/go-translate-20240802.131/gt-engine-google.el new file mode 100644 index 00000000..70c43b1f --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-google.el @@ -0,0 +1,447 @@ +;;; gt-engine-google.el --- Google translate -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; http://translate.google.com + +;;; Code: + +(require 'gt-extension) + +(defgroup go-translate-google nil + "Configs for Google engine." + :group 'go-translate) + +(defcustom gt-google-host "http://translate.googleapis.com" + "The base url of Google translate used by google engine. +you can customize it according to your country region." + :type 'string + :group 'go-translate-google) + + +;;; Components + +(defclass gt-google-parser (gt-parser) + ((tag :initform "Detail"))) + +(defclass gt-google-summary-parser (gt-google-parser) + ((tag :initform "Summary"))) + +(defclass gt-google-engine (gt-engine) + ((tag :initform 'Google) + (host :initform nil) + (path :initform "/translate_a/single") + (token :initform (cons 430675 2721866130) :initarg token) ; hard code + (token-time :initform t) + (token-expired-time :initform (* 30 60)) + (parse :initform (gt-google-parser)))) + + +;;; Engine + +(defcustom gt-google-request-headers '(("Connection" . "Keep-Alive")) + "Extra request headers send to google server." + :type '(alist :key-type (string :tag "Key") :value-type (string :tag "Value")) + :group 'go-translate-google) + +(defun gt-google-gen-url (engine text src tgt) + "Generate url for google ENGINE with TEXT, SRC and TGT." + (with-slots (host path token) engine + (format "%s%s?%s" + (or host gt-google-host) path + (mapconcat (lambda (p) + (format "%s=%s" + (url-hexify-string (car p)) + (url-hexify-string (format "%s" (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") + ("q" . ,text) + ("sl" . ,src) + ("tl" . ,tgt) + ("hl" . ,tgt) + ("tk" . ,(gt-google-tkk token text))) + "&")))) + +(defun gt-google-token-available-p (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)))))) + +(defun gt-google-with-token (engine done fail) + (declare (indent 1)) + (with-slots (host token token-time) engine + (if (gt-google-token-available-p engine) + (funcall done) + (gt-request :url (or host gt-google-host) + :headers gt-google-request-headers + :done (lambda (raw) + (with-temp-buffer + (insert raw) + (goto-char (point-min)) + (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 gt-translate ((engine gt-google-engine) task next) + (gt-google-with-token engine + (lambda () + (with-slots (text src tgt res) task + (gt-request :url (gt-google-gen-url engine text src tgt) + :headers gt-google-request-headers + :done (lambda (raw) (setf res raw) (funcall next task)) + :fail (lambda (err) (gt-fail task err))))) + (lambda (err) + (gt-fail task (format "Take token failed, %s" err))))) + +;; tts + +(defun gt-google-tts-split-text (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 gt-speak ((engine gt-google-engine) text lang) + (message "Requesting from %s for %s..." (or (oref engine host) gt-google-host) lang) + (cl-loop with texts = (gt-google-tts-split-text text) + with total = (length texts) + for c in texts + for i from 0 + for ps = `(("ie" . "UTF-8") + ("client" . "gtx") + ("prev" . "input") + ("tl" . ,lang) + ("q" . ,(string-trim c)) + ("total" . ,total) + ("idx" . ,i) + ("textlen" . ,(length c)) + ("tk" . ,(gt-google-tkk (oref engine token) c))) + for url = (format "%s/translate_tts?%s" + (or (oref engine host) gt-google-host) + (mapconcat (lambda (p) + (format "%s=%s" (url-hexify-string (car p)) (url-hexify-string (format "%s" (cdr p))))) + ps "&")) + do (gt-play-audio url 'wait))) + + +;;; Parser + +;; detail-mode, use as default + +(cl-defmethod gt-parse ((parser gt-google-parser) task) + (with-slots (res translator) task + (let* ((json (gt-resp-to-json parser res)) + (brief-result (gt-result--brief parser json))) + (if (cdr (oref translator text)) ; multi-parts + (setf res (string-trim (gt-result--brief parser json) "\n+")) + (let* ((sphonetic (gt-result--sphonetic parser json)) + (tphonetic (gt-result--tphonetic parser json)) + (details (gt-result--details parser json)) + (definitions (gt-result--definitions parser json)) + (suggestion (gt-result--suggestion parser json)) + (suggestionp (> (length suggestion) 0)) pt) + (cl-flet ((phonetic (ph) + (if (and (or definitions definitions) (> (length ph) 0)) + (propertize (format " [%s]" ph) 'face 'gt-google-buffer-phonetic-face) + "")) + (headline (line) + (propertize (format "[%s]\n" line) 'face 'gt-google-buffer-headline-face))) + (with-temp-buffer + ;; suggestion + (when suggestionp + (insert (propertize "Do you mean:" 'face 'gt-google-buffer-suggestion-desc-face) " " + (propertize suggestion 'face 'gt-google-buffer-suggestion-text-face) "?\n\n")) + ;; phonetic & translate + (if (or details definitions) + (progn + (insert (if suggestionp suggestion + (setq pt (point)) + (substring-no-properties (oref task text)))) + (insert (phonetic sphonetic) " ") + (insert (propertize brief-result 'face 'gt-google-buffer-brief-result-face)) + (insert (phonetic tphonetic) "\n\n")) + (insert brief-result)) + ;; 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 'gt-google-buffer-detail-demo-face)) + do (insert "\n")))) + ;; at last, return + (add-text-properties (point-min) (point-max) (list 'gt-mark pt 'gt-brief brief-result)) + (setf res (buffer-string))))))))) + +;; summary-mode + +(cl-defmethod gt-parse ((parser gt-google-summary-parser) task) + (let* ((json (gt-resp-to-json parser (oref task res))) + (result (string-trim (gt-result--brief parser json) "\n+"))) + (oset task res result))) + +;; Extract results from response + +(cl-defmethod gt-resp-to-json ((_ gt-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 gt-result--brief ((_ gt-google-parser) json) + "Get the translation text from JSON." + (mapconcat (lambda (item) (aref item 0)) (aref json 0) "")) + +(cl-defmethod gt-result--sphonetic ((_ gt-google-parser) json) + "Get the text phonetic from JSON." + (mapconcat (lambda (item) (if (> (length item) 3) (aref item 3) "")) (aref json 0) "")) + +(cl-defmethod gt-result--tphonetic ((_ gt-google-parser) json) + "Get the translation phonetic from JSON." + (mapconcat (lambda (item) (if (> (length item) 2) (aref item 2) "")) (aref json 0) "")) + +(cl-defmethod gt-result--details ((_ gt-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 gt-result--definitions ((_ gt-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 gt-result--suggestion ((_ gt-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 gt-google-token--bit-v-len 32) + +(defun gt-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 gt-google-token--number-to-bit-v (n) + "Return a bit vector from N." + (if (< n 0) (gt-google-token--bit-v-2comp + (gt-google-token--number-to-bit-v (abs n))) + (let ((v (make-vector gt-google-token--bit-v-len 0))) + (cl-loop for i downfrom (1- gt-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 gt-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 gt-google-token--bit-v-len + thereis (> (aref v i) 0))) + (- (gt-google-token--bit-v-to-number (gt-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 gt-google-token--logfn (fn n1 n2) + "Helper function for logical FN with N1 and N2." + (let ((v1 (gt-google-token--number-to-bit-v n1)) + (v2 (gt-google-token--number-to-bit-v n2)) + (v (make-vector gt-google-token--bit-v-len 0))) + (cl-loop for i from 0 below gt-google-token--bit-v-len do + (aset v i (funcall fn (aref v1 i) (aref v2 i)))) + (gt-google-token--bit-v-to-number v))) + +(defun gt-google-token--logand (n1 n2) + "Return a floating-point number from N1 and N2." + (gt-google-token--logfn #'logand n1 n2)) + +(defun gt-google-token--logxor (n1 n2) + "Return a floating-point number from N1 and N2." + (gt-google-token--logfn #'logxor n1 n2)) + +(defun gt-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 (gt-google-token--number-to-bit-v n)) + (v-result (make-vector gt-google-token--bit-v-len 0))) + (if (< d 0) + ;; Shift Right Logical + (cl-loop for i from (abs d) below gt-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 gt-google-token--bit-v-len + for j from 0 do + (aset v-result j (aref v i)))) + (gt-google-token--bit-v-to-number v-result))) + +(defun gt-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)) ?+) + (gt-google-token--lsh a (- d)) + (gt-google-token--lsh a d))) + (setq a (if (= (aref b c) ?+) + (gt-google-token--logand (+ a d) 4294967295.0) + (gt-google-token--logxor a d)))) + a) + +(defun gt-google-tkk (token text) + "Calculate the TOKEN for search TEXT." + (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 = (gt-google-token--gen-rl (+ (or rr b) c) vb) + finally (return rr)))) + (setq a (gt-google-token--gen-rl a ub)) + (setq a (gt-google-token--logxor a d1)) + (if (< a 0) (setq a (+ (gt-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 + (gt-google-token--logxor a b)) + "\\."))))) + +(provide 'gt-engine-google) + +;;; gt-engine-google.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-libre.el b/elpa/go-translate-20240802.131/gt-engine-libre.el new file mode 100644 index 00000000..b09b7b2b --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-libre.el @@ -0,0 +1,101 @@ +;;; gt-engine-libre.el --- Engine for LibreTranslate -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; https://github.com/LibreTranslate/LibreTranslate +;; https://libretranslate.com/ + +;;; Code: + +(require 'gt-extension) + +(defgroup go-translate-libre nil + "Configs for LibreTranslate engine." + :group 'go-translate) + +(defcustom gt-libre-host "https://translate.disroot.org/" + "API host of LibreTranslate. + +The official host is: https://libretranslate.com/, you can config this +to use third-party or your local service." + :type 'string + :group 'go-translate-libre) + + +;;; Components + +(defclass gt-libre-parser (gt-parser) ()) + +(defclass gt-libre-engine (gt-engine) + ((tag :initform 'LibreTranslate) + (host :initform nil :initarg :host) + (path :initform "/translate") + (parse :initform (gt-libre-parser)) + (delimiter :initform "21597" + ;; Any way to force specific segment not be changed after translate? + ;; I don't know! Just set this a random number, to make it work...sometimes. + ;; So this maybe failed in translating multiple parts text. + ) + (cache :initform nil) + (key :initform 'api-key + :initarg :key + :documentation "The api-key of LibreTranslate. +You can also put it into .authinfo file as: + machine [HOST like libretranslate.com] login api-key password [***]"))) + + +;;; Translate + +(cl-defmethod gt-ensure-key ((engine gt-libre-engine)) + (with-slots (host key) engine + (unless (stringp key) + (setf key + (gt-lookup-password + :user (if key (format "%s" key) "api-key") + :host (url-host (url-generic-parse-url (or host gt-libre-host)))))))) + +(cl-defmethod gt-translate ((engine gt-libre-engine) task next) + (gt-ensure-key engine) + (with-slots (text src tgt res) task + (with-slots (host path key) engine + (gt-request :url (concat (or host gt-libre-host) path) + :data `(("q" . ,text) + ("source" . ,src) + ("target" . ,tgt) + ("format" . "text") + ("alternatives" . 1) + ,(if key `("api_key" . ,key))) + :done (lambda (raw) + (setf res raw) + (funcall next task)) + :fail (lambda (err) + (gt-fail task err)))))) + +(cl-defmethod gt-parse ((_ gt-libre-parser) task) + (with-slots (res) task + (let ((json (json-read-from-string (decode-coding-string res 'utf-8)))) + (setf res (cdr (assoc 'translatedText json)))))) + +(provide 'gt-engine-libre) + +;;; gt-engine-libre.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-stardict.el b/elpa/go-translate-20240802.131/gt-engine-stardict.el new file mode 100644 index 00000000..3ec8c0af --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-stardict.el @@ -0,0 +1,183 @@ +;;; gt-engine-stardict.el --- StarDict -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; 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 +;; +;; Also, you can specify the dictionary and data-dir in `gt-stardict-engine' definition: +;; +;; (gt-stardict-engine :dict "a-dictionary" :dir "~/.stardict/dic" :dir-only t) +;; +;;; Code: + +(require 'gt-extension) + +(defclass gt-stardict-parser (gt-parser) ()) + +(defclass gt-stardict-engine (gt-engine) + ((tag :initform 'StarDict) + (dict + :initarg :dict + :initform nil + :type (or string null) + :documentation "Search only this dictionary if not nil.") + (dir + :initarg :dir + :initform nil + :type (or string null) + :documentation "Use this dir as data directory if not nil.") + (dir-only + :initarg :dir-only + :initform nil + :type boolean + :documentation "Only use dictionaries in `dir'.") + (exact + :initarg :exact + :initform nil + :type boolean + :documentation "Exact search, that is disable fuzzy-search.") + (cache :initform nil) + (parse :initform (gt-stardict-parser)))) + +(defvar gt-stardict-program "sdcv" + "Executable command of sdcv (StarDict Console Version).") + +(defconst gt-stardict-args '("--non-interactive" "--json-output" "-0" "-1")) + +(defvar gt-stardict-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] #'gt-stardict-switch-dict) + (define-key map (kbd "C-c C-c") #'gt-stardict-switch-dict) + map) + "The keymap used by StarDict.") + +(defun gt-stardict-build-args (engine) + (with-slots (dict dir dir-only exact) engine + (let ((args gt-stardict-args)) + (if dict (setq args `("--use-dict" ,dict ,@args))) + (if dir (setq args `("--data-dir" ,dir ,@args))) + (if dir-only (setq args `("--only-data-dir" ,@args))) + (if exact (setq args `("--exact-search" ,@args))) + (gt-log 'gt-stardict (format "[sdcv arguments]: %s" args)) + args))) + +(defun gt-stardict-list-dicts (engine) + (with-temp-buffer + (apply #'call-process gt-stardict-program nil t nil + (cons "--list-dicts" (gt-stardict-build-args engine))) + (goto-char (point-min)) + (cl-loop for d across (json-read) + collect (cons (alist-get 'name d) (alist-get 'wordcount d))))) + +(defun gt-stardict-switch-dict () + (interactive) + (let* ((task (get-char-property (point) 'gt-task)) + (engine (and task (oref task engine))) + (dicts (and engine (gt-stardict-list-dicts engine)))) + (when (= (length dicts) 0) (user-error "No dict found, nothing can do")) + (let ((dict (completing-read "Dictionary to use: " + (gt-make-completion-table (cons 'ALL dicts)) + nil t nil nil (oref engine dict)))) + (oset engine dict (unless (string= dict "ALL") dict)) + (oset gt-buffer-render-translator keep t) + (gt-start gt-buffer-render-translator)))) + +(cl-defgeneric gt-stardict-pretty-definition (dictionary definition) + "Try to pretty the DEFINITION part of DICTIONARY for output." + (:method ((_ (eql '朗道)) definition) + (with-temp-buffer + (insert definition) + ;; phonetic + (goto-char (point-min)) + (while (re-search-forward "^\\*\\(\\[.+\\]\\)" nil t) + (replace-match (propertize (match-string 1) 'face 'gt-stardict-phonetic-face))) + ;; related + (goto-char (point-min)) + (while (re-search-forward "^相关词组:" nil t) + (replace-match (concat "\n" (propertize (match-string 0) 'face 'bold)))) + ;; word class + (goto-char (point-min)) + (while (re-search-forward + (format "^\\(%s\\)\\. " (mapconcat (lambda (v) (format "%s" v)) gt-word-classes "\\|")) nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face 'gt-stardict-word-class-face)) + (buffer-string))) + (cond ((string-match-p "^朗道.+字典" (format "%s" dictionary)) + (gt-stardict-pretty-definition '朗道 definition)) + (t definition))) + +(cl-defmethod gt-translate ((engine gt-stardict-engine) task next) + (unless (executable-find gt-stardict-program) + (user-error "You should install `sdcv' first before use `gt-stardict-engine'")) + (with-slots (text res) task + (with-temp-buffer + (apply #'call-process gt-stardict-program nil t nil + (append (gt-stardict-build-args engine) (list text))) + (setf res (buffer-string)) + (funcall next task)))) + +(cl-defmethod gt-parse ((_ gt-stardict-parser) task) + (with-slots (res) task + (let ((json (condition-case _ (json-read-from-string res) + (error (user-error res)))) + (props `(pointer hand help-echo "Click to switch dictionary" keymap ,gt-stardict-map))) + (when (= (length json) 0) + (user-error (apply #'propertize "No translation result found, sorry :(" props))) + (with-temp-buffer + (cl-loop for d in (cl-remove-duplicates (mapcar #'cdar json) :test #'string=) + do (insert (apply #'propertize d 'display '(height 0.6) 'face 'gt-stardict-dict-face props) "\n\n") + collect (cl-loop for r across (cl-remove-if-not + (lambda (item) (string= (cdar item) d)) json) + for i from 1 + for word = (propertize (alist-get 'word r) + 'face 'gt-stardict-word-face + 'display '(raise 0.6)) + for definition = (propertize (gt-stardict-pretty-definition (intern d) (alist-get 'definition r)) + 'display '(raise 0.3) + 'line-prefix " " + 'wrap-prefix " ") + collect (concat (if (= i 0) (gt-line-height-separator 10)) word definition) into r1 + finally (return (string-join r1 "\n"))) + into rs finally (insert (string-join rs "\n\n"))) + (setf res (buffer-string)))))) + +(provide 'gt-engine-stardict) + +;;; gt-engine-stardict.el ends here diff --git a/elpa/go-translate-20240802.131/gt-engine-youdao.el b/elpa/go-translate-20240802.131/gt-engine-youdao.el new file mode 100644 index 00000000..28f22d1a --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-engine-youdao.el @@ -0,0 +1,188 @@ +;;; gt-engine-youdao.el --- YouDao Dict -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; 有道词典 (https://dict.youdao.com), A Chinese translation website. +;; +;; This engine is only for Chinese user. +;; +;; > 此引擎仅供中文翻译使用 +;; +;; There are two engine implements here, one is `gt-youdao-dict-engine' and another is `gt-youdao-suggest-engine'. +;; +;; > 这里为有道实现了两个引擎： +;; > 1. `gt-youdao-dict-engine'，基于网页翻译接口，具备基本的翻译能力 +;; > 2. `gt-youdao-suggest-engine', 用于展示输入单词的同义词及相关词汇 +;; > +;; > 另外，有道还提供 API 接口，罢了，要收费的。 + +;;; Code: + +(require 'gt-extension) + + +;;; 有道词典 + +(defclass gt-youdao-dict-parser (gt-parser) ()) + +(defclass gt-youdao-dict-engine (gt-engine) + ((tag :initform '有道词典) + (url :initform "https://dict.youdao.com/result?lang=%s&word=%s") + (parse :initform (gt-youdao-dict-parser)))) + +(cl-defmethod gt-translate ((engine gt-youdao-dict-engine) task next) + (with-slots (text src tgt res meta translator) task + (let* ((lang (cond ((equal src 'zh) tgt) + ((equal tgt 'zh) src) + (t (user-error "只支持中文跟其他语言之间的翻译")))) + (url (if (cdr (oref translator text)) + (user-error "不支持分段翻译") + (format (oref engine url) + (url-hexify-string (format "%s" lang)) + (url-hexify-string text))))) + (gt-request :url url + :done (lambda (raw) + (setf res (gt-parse-html-dom raw) meta url) + (funcall next task)) + :fail (lambda (err) (gt-fail task err)))))) + +(defun gt-youdao-dict--extract (dom) + "从 DOM 中解析结果。" + (let* ((phonetic (cl-loop for p in (dom-by-class dom "per-phone") + collect (cons (nth 2 (nth 2 p)) (nth 2 (nth 3 p))))) + (node (dom-by-id dom "catalogue_author")) + (exp-ce (cl-loop for n in (dom-by-class node "word-exp-ce") + for s = (car (dom-by-class n "point")) + for r = (car (dom-by-class n "word-exp_tran")) + collect (cons (nth 2 s) (nth 2 r)))) + (exp-nw (unless exp-ce + (cl-loop for n in (dom-by-class node "trans-content") + collect (nth 2 n)))) + (exp-ec (unless (or exp-nw exp-ce) + (cl-loop for n in (dom-by-class node "word-exp") + collect (cons (nth 2 (nth 2 n)) (nth 2 (nth 3 n)))))) + (exam-type (mapcar #'caddr (dom-by-class node "exam_type-value"))) + (word-wfs (cl-loop for n in (dom-by-class node "word-wfs-cell-less") + collect (cons (nth 2 (nth 2 (nth 2 n))) (nth 2 (nth 3 n)))))) + (list :exp-nw exp-nw :exp-ce exp-ce :exp-ec exp-ec :phonetic phonetic + :exam-type exam-type :word-wfs word-wfs))) + +(defun gt-youdao-dict--filter (result) + "对 RESULT 进行某些美化。" + (string-replace "】" "]" (string-replace "【" "[" result))) + +(defun gt-youdao-dict--tts-url (word &optional lang) + (format "http://dict.youdao.com/dictvoice?audio=%s&type=%s" + (url-hexify-string word) + (if (member lang '("英" 1 "1")) 1 0))) + +(cl-defmethod gt-parse ((_ gt-youdao-dict-parser) task) + (with-slots (res meta) task + (gt-plist-let ((gt-youdao-dict--extract res)) + (with-temp-buffer + ;; 音标 + (when .phonetic + (insert (substring-no-properties (oref task text)) " " + (propertize (if .exp-ce + (propertize (caar .phonetic) 'face 'gt-youdao-dict-phonetic-face) + (mapconcat (lambda (p) + (concat (propertize (car p) 'face 'gt-youdao-dict-label-face) " " + (propertize (cdr p) + 'face 'gt-youdao-dict-phonetic-face + 'mouse-face 'bold + 'gt-tts-url (gt-youdao-dict--tts-url (oref task text) (car p)) + 'keymap (gt-simple-keymap [mouse-1] #'gt-do-speak)))) + .phonetic " ")) + 'display '(height 0.7)) + "\n\n")) + ;; 释义 + (insert (cond + (.exp-nw (mapconcat #'identity .exp-nw "\n")) + (.exp-ce (mapconcat (lambda (exp) + (concat (propertize (car exp) 'face 'gt-youdao-dict-entry-face) "\n\n " (cdr exp))) + .exp-ce "\n\n")) + (.exp-ec (mapconcat (lambda (exp) + (if (cdr exp) + (concat (propertize (car exp) 'face 'gt-youdao-dict-entry-face) " " (cdr exp)) + (gt-youdao-dict--filter (car exp)))) + .exp-ec "\n\n")) + (t (user-error "也许没有翻译结果?"))) + "\n\n") + ;; 相关 + (cl-loop for wf in .word-wfs + for i from 1 + do (insert (propertize (car wf) 'face 'gt-youdao-dict-label-face) " " (cdr wf)) + do (insert (if (= (length .word-wfs) i) "\n\n" (if (> (current-column) fill-column) "\n" "\t")))) + ;; 考试 + (when-let (et (and .exam-type (mapconcat #'identity .exam-type " / "))) + (insert (propertize et 'face 'gt-youdao-dict-phonetic-face 'display '(height 0.7)))) + ;; 返回 + (setf res (if (or .exp-ce .exp-ec) + (propertize (buffer-string) 'gt-url meta) + (buffer-string))))))) + + +;;; 有道同义词 + +(defclass gt-youdao-suggest-parser (gt-parser) ()) + +(defclass gt-youdao-suggest-engine (gt-engine) + ((tag :initform '有道同义词) + (url :initform "https://dict.youdao.com/suggest?q=%s&num=%s&doctype=json") + (limit :initform 9 :initarg :limit) + (delimiter :initform nil) + (parse :initform (gt-youdao-suggest-parser)))) + +(cl-defmethod gt-translate ((engine gt-youdao-suggest-engine) task next) + (with-slots (text res meta) task + (when (cdr text) + (user-error "不支持一次翻译多个单词或句子")) + (let ((url (format (oref engine url) (url-hexify-string (car text)) (oref engine limit)))) + (gt-request :url url + :done (lambda (raw) (setf res raw meta url) (funcall next task)) + :fail (lambda (err) (gt-fail task err)))))) + +(cl-defmethod gt-parse ((_ gt-youdao-suggest-parser) task) + (with-slots (res meta) task + (let ((json (json-read-from-string res))) + (unless (= (alist-get 'code (alist-get 'result json)) 200) + (user-error (alist-get 'msg (alist-get 'result json)))) + (let ((lst (cl-loop + for item across (alist-get 'entries (alist-get 'data json)) + for i from 1 + for ent = (propertize (alist-get 'entry item) 'face 'gt-youdao-suggest-entry-face) + for exp = (if-let (ex (alist-get 'explain item)) (propertize (concat " " ex) 'wrap-prefix " ")) + collect (concat (if (> i 1) (gt-line-height-separator 18)) ent + (if exp (concat "\n" (gt-line-height-separator 8) exp)))))) + (with-temp-buffer + (insert (string-join lst "\n")) + (goto-char (point-min)) + (while (re-search-forward (format "\\(%s\\)\\(\\. \\|．\\)" + (mapconcat (lambda (v) (format "%s" v)) gt-word-classes "\\|")) + nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face 'gt-youdao-suggest-cixing-face)) + (setf res (propertize (buffer-string) 'gt-url meta))))))) + +(provide 'gt-engine-youdao) + +;;; gt-engine-youdao.el ends here diff --git a/elpa/go-translate-20240802.131/gt-extension.el b/elpa/go-translate-20240802.131/gt-extension.el new file mode 100644 index 00000000..6941181c --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-extension.el @@ -0,0 +1,1175 @@ +;;; gt-extension.el --- Extension components -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu +;; Package-Requires: ((emacs "28.1")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; Some extension components + +;;; Code: + +(require 'cl-lib) +(require 'json) +(require 'gt-core) +(require 'gt-faces) + + +;;; [Render] buffer render + +(defclass gt-buffer-render (gt-render) + ((buffer-name :initarg :buffer-name :initform nil) + (window-config :initarg :window-config :initform nil) + (split-threshold :initarg :split-threshold :initform nil)) + "Popup a new buffer to display the translation result.") + +(defcustom gt-buffer-render-follow-p nil + "Pop to the result buffer instead of just displaying." + :type 'boolean + :group 'go-translate) + +(defcustom gt-buffer-render-split-width-threshold 80 + "Threshold width of window horizontal split for Buffer-Render." + :group 'go-translate + :type '(choice + (const :tag "Disable" nil) + (integer :tag "Threshold"))) + +(defcustom gt-buffer-render-window-config + '((display-buffer-reuse-window display-buffer-in-direction) + (direction . right)) + "Window configuration of buffer window of Buffer-Render. + +Notice, this can be overrided by `window-config' slot of render instance." + :type 'sexp + :group 'go-translate) + +(defcustom gt-buffer-render-init-hook nil + "Hook run after buffer initialization in Buffer-Render." + :type 'hook + :group 'go-translate) + +(defcustom gt-buffer-render-output-hook nil + "Hook run after output finished in Buffer-Render." + :type 'hook + :group 'go-translate) + +(defvar gt-buffer-render-buffer-name "*gt-result*") + +(defvar gt-buffer-render-evil-leading-key "," "Leading key for keybinds in evil mode.") + +(defvar-local gt-buffer-render-translator nil) +(defvar-local gt-buffer-render-keybinding-messages nil) +(defvar-local gt-buffer-render-local-map nil) + +(declare-function evil-define-key* "ext:evil-core.el" t t) + +(cl-defmacro gt-buffer-render-key ((key &optional tag test) &rest form) + (declare (indent 1)) + `(when ,(or test `,test t) + (let ((fn ,(if (member (car-safe (car form)) '(function lambda)) + `,(car form) + `(lambda () (interactive) ,@form)))) + (if (bound-and-true-p evil-mode) + (evil-define-key* 'normal gt-buffer-render-local-map + (kbd (concat gt-buffer-render-evil-leading-key + (if gt-buffer-render-evil-leading-key " ") ,key)) + fn) + (define-key gt-buffer-render-local-map (kbd ,key) fn)) + (setq gt-buffer-render-keybinding-messages + (cl-remove ,key gt-buffer-render-keybinding-messages :key #'car :test #'string=)) + (when ,tag + (push (cons ,key ,tag) gt-buffer-render-keybinding-messages))))) + +(defun gt-buffer-render--refresh () + (interactive) + (oset gt-buffer-render-translator keep t) + (gt-start gt-buffer-render-translator)) + +(defun gt-buffer-render--cycle-next (&optional ignore-rules) + (interactive "P") + (with-slots (target taker keep) gt-buffer-render-translator + (if (and (slot-boundp taker 'langs) (gt-functionp (oref taker langs))) + (user-error "Current taker not support cycle next") + (let* ((curr gt-last-target) + (gt-skip-lang-rules-p ignore-rules) + (gt-ignore-target-history-p t) + (next (gt-target taker gt-buffer-render-translator 'next))) + (unless (equal next curr) + (setf target next keep t) + (gt-start gt-buffer-render-translator)))))) + +(defun gt-buffer-render--toggle-polyglot () + (interactive) + (setq gt-polyglot-p (not gt-polyglot-p)) + (with-slots (target keep) gt-buffer-render-translator + (setf target nil keep t) + (gt-start gt-buffer-render-translator))) + +(defun gt-buffer-render--browser () + (interactive) + (if-let (url (get-char-property (point) 'gt-url)) + (progn (browse-url url) + (message "Opening %s... Done!" url)) + (message "No url found on current result."))) + +(defun gt-buffer-render--delete-cache () + (interactive) + (when-let ((task (get-pos-property (point) 'gt-task)) + (key (gt-cache-key task (or (get-pos-property (point) 'gt-part) 0)))) + (gt-cache-set gt-default-cacher key nil) + (message "Delete %s from cacher" key))) + +(defun gt-buffer-render--keyboard-quit () + (interactive) + (unwind-protect + (gt-interrupt-speak-process) + (keyboard-quit))) + +(defun gt-buffer-render--show-tips () + (interactive) + (if gt-buffer-render-keybinding-messages + (message (mapconcat + (lambda (kd) (concat (propertize (car kd) 'face 'font-lock-keyword-face) ": " (cdr kd))) + (reverse gt-buffer-render-keybinding-messages) " ")) + (message "No any help tips found"))) + +(defun gt-buffer-render--toggle-readonly () + (interactive) + (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 gt-buffer-render-local-map)))) + +(defun gt-buffer-render--unfold-source-text () + (interactive) + (mapc (lambda (ov) + (delete-overlay ov)) + (overlays-at (point)))) + +(defvar gt-buffer-render-dislike-source-text nil) + +(defvar gt-buffer-render-source-text-limit 140 + "Fold some of the source text if it's too long. +This can be a number as visible length or a function with source text +as argument that return a length.") + +(defvar gt-buffer-render-source-text-fold-bound-function + #'gt-buffer-render-source-text-fold-bound) + +(defun gt-buffer-render-source-text-fold-bound () + (when (and (numberp gt-buffer-render-source-text-limit) + (> (point-max) gt-buffer-render-source-text-limit)) + (goto-char (min (point-max) (+ (point-min) gt-buffer-render-source-text-limit))) + (move-to-column fill-column) + (skip-chars-backward " \t\n") + (when-let (bd (bounds-of-thing-at-point 'word)) + (goto-char (cdr bd))) + (when (> (- (point-max) 20) (point)) + (cons (point) (point-max))))) + +(defun gt-buffer-insert-source-text (text &optional fold) + "Propertize and insert the source TEXT into render buffer. +If FOLD non nil, only make part of the text visible." + (let* ((text (string-trim text "\n+")) + (beg (point)) + (end (progn (insert (substring-no-properties text)) (point)))) + (insert "\n\n") + (save-excursion + (put-text-property beg end 'face 'gt-buffer-render-source-face) + (put-text-property beg (+ end 2) 'gt-source-text t) + (when fold + (when-let* ((bd (save-restriction + (narrow-to-region beg end) + (funcall gt-buffer-render-source-text-fold-bound-function))) + (ov (make-overlay beg end))) + (overlay-put ov 'display + (concat + (propertize (buffer-substring beg (car bd)) 'face 'gt-buffer-render-source-face) + " ...")) + (overlay-put ov 'keymap (gt-simple-keymap + [return] #'gt-buffer-render--unfold-source-text + [mouse-1] #'gt-buffer-render--unfold-source-text)) + (overlay-put ov 'pointer 'hand) + (overlay-put ov 'help-echo "Click to unfold the text"))) + (cons beg end)))) + +(defun gt-buffer-render-init (buffer render translator) + "Init BUFFER for RENDER of TRANSLATOR." + (with-current-buffer buffer + (with-slots (text tasks engines) 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 gt-buffer-render-translator translator) + ;; headline + (let ((engines (cl-delete-duplicates (mapcar (lambda (task) (oref task engine)) tasks)))) + (gt-header render translator (unless (cdr engines) (oref (car engines) tag)))) + ;; content + (let ((inhibit-read-only t) + (ret (gt-extract render translator))) + (erase-buffer) + (newline) + (save-excursion + (unless (or gt-buffer-render-dislike-source-text (cdr text)) ;; single part, single task + (pcase-let ((`(,beg . ,end) (gt-buffer-insert-source-text (car text)))) + (put-text-property beg end 'gt-task (car tasks)))) + (cl-loop for c in text + for i from 0 + if (cdr text) do (gt-buffer-insert-source-text c) ; multi parts + do (cl-loop for tr in ret + for stream = (plist-get tr :stream) + for res = (propertize "Loading..." + 'face 'gt-buffer-render-loading-face + 'gt-result (if stream 'stream t)) + for (prefix task) = (list (plist-get tr :prefix) (plist-get tr :task)) + for output = (propertize (concat prefix res "\n\n") 'gt-task task 'gt-part i) + do (let ((engine (oref task engine))) + (if (and (gt-stream-p engine) (= i 0)) ; record result bound for stream + (let ((beg (point)) end) + (insert output) + (setq beg (set-marker (make-marker) (+ beg (length prefix)))) + (setq end (set-marker (make-marker) (save-excursion (skip-chars-backward " \t\n") (point)))) + (oset task markers (cons beg end))) + (insert output))))))) + ;; keybinds + (setq gt-buffer-render-local-map (make-sparse-keymap)) + (use-local-map gt-buffer-render-local-map) + (gt-keybinds render translator) + ;; state + (read-only-mode 1) + (if-let (w (get-buffer-window nil t)) (set-window-point w (point))) + ;; execute the hook if exists + (run-hooks 'gt-buffer-render-init-hook)))) + +(defun gt-buffer-render-output (buffer render translator) + "Output TRANSLATOR's result to BUFFER for RENDER." + (with-current-buffer buffer + (let ((inhibit-read-only t) + (ret (gt-extract render translator)) bds prop) + (with-slots (text tasks) translator + (save-excursion + ;; refresh source text + (goto-char (point-min)) + (unless (cdr text) + (when-let (prop (text-property-search-forward 'gt-source-text)) + (delete-region (prop-match-beginning prop) (prop-match-end prop)) + (when (or (cdr ret) (not (get-pos-property 1 'gt-mark (car (ensure-list (plist-get (car ret) :result)))))) + (let ((bd (gt-buffer-insert-source-text (car text) t))) + (unless (cdr tasks) + (put-text-property (car bd) (cdr bd) 'gt-task (car tasks))))))) + ;; collect positions + (goto-char (point-min)) + (while (setq prop (text-property-search-forward 'gt-result)) + (push (cons (set-marker (make-marker) (prop-match-beginning prop)) + (set-marker (make-marker) (prop-match-end prop))) + bds)) + (setq bds (nreverse bds)) + ;; output results in bounds + (cl-loop for _ in text + for i from 0 + do (cl-loop for tr in ret + for (beg . end) = (pop bds) + for (res state task) = (list (plist-get tr :result) (plist-get tr :state) (plist-get tr :task)) + do (goto-char beg) + do (when (and (cl-plusp state) (null (get-char-property beg 'gt-done)) + (or (not (eq (get-char-property (point) 'gt-result) 'stream)) (= state 1))) + (delete-region beg end) + (insert (propertize (if (consp res) (nth i res) res) + 'gt-result t 'gt-done t 'gt-task task 'gt-part i)))))))) + ;; update states + (set-buffer-modified-p nil) + ;; execute the hook if exists + (run-hooks 'gt-buffer-render-output-hook))) + +(cl-defmethod gt-header ((_ gt-buffer-render) translator &optional tag) + "Set head line format for Buffer Render of TRANSLATOR. +TAG is extra message show in the middle if not nil." + (with-slots (target) translator + (let ((line (append + '(" ") + (when-let (src (car target)) + (list + "[" (propertize (format "%s" src) 'face 'gt-buffer-render-header-lang-face) "]" + (if tag (concat " ― " (propertize (format "%s" tag) 'face 'gt-buffer-render-header-desc-face)) "") + " → ")) + (list + "[" + (mapconcat (lambda (s) (propertize (format "%s" s) 'face 'gt-buffer-render-header-lang-face)) (cdr target) ", ") + "]" + (when (and gt-buffer-render-keybinding-messages (not (bound-and-true-p evil-mode))) + (concat " (" (propertize "?" 'face 'font-lock-type-face) " for tips)")))))) + (setq header-line-format line)))) + +(cl-defmethod gt-keybinds ((_ gt-buffer-render) _translator) + "Define keybinds for `gt-buffer-render-local-map'." + (gt-buffer-render-key ("t" "Cycle Next") #'gt-buffer-render--cycle-next) + (gt-buffer-render-key ("T" "Toggle Polyglot") #'gt-buffer-render--toggle-polyglot) + (gt-buffer-render-key ("y" "TTS") (lambda () (interactive) (let (gt-tts-last-engine) (gt-do-speak)))) + (gt-buffer-render-key ("O" "Browser") #'gt-buffer-render--browser) + (gt-buffer-render-key ("c" "Del Cache") #'gt-buffer-render--delete-cache) + (gt-buffer-render-key ("C") #'gt-purge-cache) + (gt-buffer-render-key ("g" "Refresh") #'gt-buffer-render--refresh) + (gt-buffer-render-key ("n") #'next-line) + (gt-buffer-render-key ("p") #'previous-line) + (gt-buffer-render-key ("h") #'backward-char) + (gt-buffer-render-key ("j") #'next-line) + (gt-buffer-render-key ("k") #'previous-line) + (gt-buffer-render-key ("l") #'forward-char) + (gt-buffer-render-key ("q" "Quit") #'kill-buffer-and-window) + (gt-buffer-render-key ("C-g") #'gt-buffer-render--keyboard-quit) + (gt-buffer-render-key ("C-x C-q") #'gt-buffer-render--toggle-readonly) + (gt-buffer-render-key ("?") #'gt-buffer-render--show-tips)) + +(cl-defmethod gt-extract :around ((render gt-buffer-render) translator) + "Decorate prefix and result for buffer render." + (cl-loop with mpp = (cdr (oref translator text)) + with ret = (cl-call-next-method render translator) + for tr in ret + for (prefix result state) = (gt-plist-let tr (list .prefix (format "%s" .result) .state)) + if (and prefix (or (not (slot-boundp render 'prefix)) (eq (oref render prefix) t))) + do (plist-put tr :prefix + (concat (propertize (concat prefix (unless mpp "\n")) + 'face (if mpp 'gt-buffer-render-inline-prefix-face 'gt-buffer-render-block-prefix-face)) + "\n")) + if (= 1 state) do (plist-put tr :result (propertize result 'face 'gt-buffer-render-error-face)) + collect tr)) + +(cl-defmethod gt-init ((render gt-buffer-render) translator) + (with-slots (buffer-name split-threshold window-config) render + (let ((buf (get-buffer-create (or buffer-name gt-buffer-render-buffer-name))) + (split-width-threshold (or split-threshold gt-buffer-render-split-width-threshold split-width-threshold))) + (gt-buffer-render-init buf render translator) + (display-buffer buf (or window-config gt-buffer-render-window-config))))) + +(cl-defmethod gt-output ((render gt-buffer-render) translator) + (when-let (buf (get-buffer (or (oref render buffer-name) gt-buffer-render-buffer-name))) + (gt-buffer-render-output buf render translator) + (when (= (oref translator state) 3) + (if gt-buffer-render-follow-p + (pop-to-buffer buf) + (display-buffer buf))))) + +(cl-defmethod gt-output :after ((_ gt-buffer-render) translator) + (when (= (oref translator state) 3) (message ""))) + + +;;; [Render] Child-Frame Render (Popup Mode) +;; implements via package Posframe, you should install it before use this + +(defclass gt-posframe-pop-render (gt-buffer-render) + ((width :initarg :width :initform nil) + (height :initarg :height :initform nil) + (forecolor :initarg :forecolor :initform nil) + (backcolor :initarg :backcolor :initform nil) + (padding :initarg :padding :initform 12) + (frame-params :initarg :frame-params :initform nil :type list + :documentation "Other parameters passed to `posframe-show'. Have higher priority.")) + "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'.") + +(defvar gt-posframe-pop-render-buffer " *GT-Pop-Posframe*") +(defvar gt-posframe-pop-render-init-hook nil) +(defvar gt-posframe-pop-render-output-hook nil) +(defvar gt-posframe-pop-render-timeout 30) +(defvar gt-posframe-pop-render-poshandler nil) + +(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) + +(defun gt-posframe-render-auto-close-handler () + "Close the pop-up posframe window." + (interactive) + (unless (or (and gt-current-command + (member this-command (list gt-current-command #'exit-minibuffer))) + (and gt-posframe-pop-render-buffer + (string= (buffer-name) gt-posframe-pop-render-buffer))) + (ignore-errors (posframe-delete gt-posframe-pop-render-buffer)) + (remove-hook 'post-command-hook #'gt-posframe-render-auto-close-handler))) + +(cl-defmethod gt-init :before ((_ gt-posframe-pop-render) _) + (unless (require 'posframe nil t) + (user-error "To use `gt-posframe-render', you should install and load package `posframe' first"))) + +(cl-defmethod gt-init ((render gt-posframe-pop-render) translator) + (with-slots (width height forecolor backcolor padding frame-params) render + (let ((inhibit-read-only t) + (gt-buffer-render-dislike-source-text t) + (gt-buffer-render-init-hook gt-posframe-pop-render-init-hook) + (buf (get-buffer-create gt-posframe-pop-render-buffer)) + (rweight (cond ((functionp width) (funcall width translator)) + ((numberp width) width) + (t (if fill-column (- fill-column 5) 50)))) + (rheight (cond ((functionp height) (funcall height translator)) + ((numberp height) height) + (t 0)))) + ;; height + (when (< rheight 1) + (let* ((h 1) (factor 1) (ts (ensure-list (oref translator text)))) + (with-temp-buffer + (insert (string-join ts "\n")) + (goto-char (point-min)) + (while (re-search-forward "\n+" nil t) (cl-incf h))) + (setq factor (* factor (length ts))) + (setq factor (* factor (max 1 (length (ensure-list (oref translator engines)))))) + (setq factor (* factor (max 1 (length (ensure-list (cdr (oref translator target))))))) + (setq rheight (* factor (+ 4 h))))) + ;; render + (gt-buffer-render-init buf render translator) + ;; create + (unless (get-buffer-window (get-buffer buf)) + (apply #'posframe-show buf + (append frame-params + (list + :timeout gt-posframe-pop-render-timeout + :width rweight + :height rheight + :max-height (/ (window-height) 2) + :foreground-color (or forecolor gt-pop-posframe-forecolor) + :background-color (or backcolor gt-pop-posframe-backcolor) + :internal-border-width padding + :internal-border-color (or backcolor gt-pop-posframe-backcolor) + :accept-focus t + :position (point) + :poshandler gt-posframe-pop-render-poshandler)))) + (posframe-refresh buf) + ;; setup + (with-current-buffer buf + (gt-buffer-render-key ("q" "Close") (posframe-delete buf))) + (add-hook 'post-command-hook #'gt-posframe-render-auto-close-handler)))) + +(cl-defmethod gt-output ((render gt-posframe-pop-render) translator) + (when-let (buf (get-buffer gt-posframe-pop-render-buffer)) + (let ((gt-buffer-render-output-hook gt-posframe-pop-render-output-hook)) + (gt-buffer-render-output buf render translator) + (posframe-refresh buf)))) + + +;;; [Render] Child-Frame Render (Pin Mode) + +(defclass gt-posframe-pin-render (gt-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) + (frame-params :initarg :frame-params :initform nil :type list + :documentation "Other parameters passed to `posframe-show'. Have higher priority.")) + "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 'gt-buffer-render'.") + +(defvar gt-posframe-pin-render-buffer " *GT-Pin-Posframe*") +(defvar gt-posframe-pin-render-frame nil) +(defvar gt-posframe-pin-render-init-hook nil) +(defvar gt-posframe-pin-render-output-hook nil) +(defvar gt-posframe-pin-render-poshandler #'posframe-poshandler-frame-top-right-corner) + +(cl-defmethod gt-init ((render gt-posframe-pin-render) translator) + (if (and (get-buffer gt-posframe-pin-render-buffer) gt-posframe-pin-render-frame) + (make-frame-visible gt-posframe-pin-render-frame) + (with-slots (width height min-width min-height bd-width forecolor backcolor bd-color padding position frame-params) render + (setq gt-posframe-pin-render-frame + (let ((inhibit-read-only t)) + (apply #'posframe-show gt-posframe-pin-render-buffer + (append frame-params + (list + :string "\nLoading..." + :width width + :height height + :min-width width + :min-height height + :foreground-color (or forecolor gt-pin-posframe-forecolor) + :background-color (or backcolor gt-pin-posframe-backcolor) + :internal-border-width bd-width + :border-color (or bd-color gt-pin-posframe-bdcolor) + :left-fringe padding + :right-fringe padding + :refresh nil + :accept-focus t + :respect-header-line t + :position position + :poshandler (unless position gt-posframe-pin-render-poshandler))))))) + (set-frame-parameter gt-posframe-pin-render-frame 'drag-internal-border t) + (set-frame-parameter gt-posframe-pin-render-frame 'drag-with-header-line t) + (when-let (color (or (oref render fri-color) gt-pin-posframe-fringe-color)) + (set-face-background 'fringe color gt-posframe-pin-render-frame))) + ;; render + (let ((gt-buffer-render-init-hook gt-posframe-pin-render-init-hook)) + (gt-buffer-render-init gt-posframe-pin-render-buffer render translator)) + ;; setup + (with-current-buffer gt-posframe-pin-render-buffer + (gt-buffer-render-key ("q" "Close") (posframe-hide gt-posframe-pin-render-buffer)))) + +(cl-defmethod gt-output ((render gt-posframe-pin-render) translator) + (let ((gt-buffer-render-output-hook gt-posframe-pin-render-output-hook)) + (gt-buffer-render-output gt-posframe-pin-render-buffer render translator))) + + +;;; [Render] kill-ring render + +(defclass gt-kill-ring-render (gt-render) () + :documentation "Used to save the translate result into kill ring.") + +(cl-defmethod gt-output ((render gt-kill-ring-render) translator) + (deactivate-mark) + (when (= (oref translator state) 3) + (let ((ret (gt-extract render translator))) + (when-let (err (cl-find-if (lambda (r) (<= (plist-get r :state) 1)) ret)) + (kill-new "") + (error "%s" (plist-get err :result))) + (kill-new (mapconcat (lambda (r) (string-join (plist-get r :result) "\n")) ret "\n\n")) + (message "Result already in the kill ring.")))) + + +;;; [Render] insert render + +(defclass gt-insert-render (gt-render) + ((type + :initarg :type + :initform 'after + :type (or (member after replace) boolean) + :documentation "How to insert the result.") + (rfmt + :initarg :rfmt + :initform nil + :documentation "Used to format the result string for insertion. +See `gt-insert-render-format' for details.") + (sface + :initarg :sface + :initform nil + :documentation "The propertize face of the source text after translation. +If this is nil then do nothing, if this is a face or a function return a face, +just propertize the source text with the face.") + (rface + :initarg :rface + :initform nil + :documentation "Result face."))) + +(defcustom gt-insert-render-type 'after + "Where to insert the result in Insert-Render. + +If this is `replace', insert the result by taking place the source text, +otherwise, insert after the source text. + +The value can be overrided by `type' slot of render." + :type '(choice (const :tag "Repace" replace) + (other :tag "Insert after" after)) + :group 'go-translate) + +(defcustom gt-insert-render-output-hook nil + "Hook run after output finished in Insert-Render. +With current translator as the only argument." + :type 'hook + :group 'go-translate) + +(defun gt-insert-render-format (render src res) + "Format RES for insert RENDER. + +SRC is the source text, RES is list extracted from translate task. + +Join them to a string, format or pretty it, at last return it as the result that +used to insert. + +If slot `rfmt' is a string contains `%s', format every part of results with +function `format' and join them. + + (gt-insert-render :rfmt \" <%s>\" :rface `font-lock-warning-face) + +If `rfmt' is a function with solo argument, apply the function on every part of +results and join them. If with two arguments, pass source text as the first +argument. If four arguments, then chain the formatting task to the function. + + (gt-insert-render :rfmt (lambda (w) (format \" [%s]\")) + :rface `font-lock-warning-face) + + (gt-insert-render :rfmt (lambda (s w) + (if (length< s 3) + (format \"\\n- %s\" w) + (propertize w `face `font-lock-warning-face)))) + +Otherwise, join the results use the default logic." + (with-slots (type rfmt rface) render + (cond + ((stringp rfmt) + (mapconcat (lambda (r) (gt-face-lazy (format rfmt r) (gt-ensure-plain rface r))) res "\n")) + ((functionp rfmt) + (let ((n (cdr (func-arity rfmt)))) + (if (<= n 2) + (mapconcat (lambda (r) + (let ((ret (or (if (= n 2) (funcall rfmt src r) (funcall rfmt r)) r))) + (gt-face-lazy ret (gt-ensure-plain rface r)))) + res "\n") + (funcall rfmt render src res)))) + (t (let* ((before (when (eq type 'after) + (if (string-blank-p src) "" + (if (gt-word-p nil src) " " + (if (or (looking-at "\n\n") + (save-excursion (skip-chars-forward " \n\t") (eobp))) + "\n\n" + "\n"))))) + (facefn (lambda (r) (gt-face-lazy r (gt-ensure-plain rface r)))) + (separator (if (= (length before) 0) "\n\n" before))) + (concat before (mapconcat facefn res separator))))))) + +(cl-defmethod gt-init ((render gt-insert-render) translator) + (with-slots (text bounds tasks) translator + (unless (buffer-live-p (car bounds)) + (error "Source buffer is unavailable, abort")) + (when (with-current-buffer (car bounds) buffer-read-only) + (error "Source buffer is readonly, can not insert")) + ;; only simple translate (single part, single target) allowing streaming output + ;; take bounds as output markers for it + (when (and (not (cdr text)) + (not (cdr tasks)) + (gt-stream-p (oref (car tasks) engine))) + (with-slots (markers engine) (car tasks) + (let ((type (oref render type)) + (beg (if-let (p (caadr bounds)) + (save-excursion + (goto-char p) + (skip-chars-forward "\n" (cdadr bounds)) + (point)) + (point))) + (end (if-let (p (cdadr bounds)) + (save-excursion + (goto-char p) + (skip-chars-backward " \t\n" (caadr bounds)) + (point)) + (point)))) + (setf markers (cons (set-marker (make-marker) (if (eq type 'after) end beg)) + (set-marker (make-marker) end)))))))) + +(cl-defmethod gt-output ((render gt-insert-render) translator) + (with-slots (bounds state) translator + (when (= 3 state) + (let ((ret (gt-extract render translator))) + (when-let (err (cl-find-if (lambda (tr) (<= (plist-get tr :state) 1)) ret)) + (user-error "Error in translation, %s" (plist-get err :result))) + (with-current-buffer (car bounds) + (with-slots (rfmt sface) render + (cl-loop with start = (point-marker) + with bds = (mapcar (lambda (bd) + (cons (save-excursion + (goto-char (car bd)) + (skip-chars-forward "\n") + (point-marker)) + (save-excursion + (goto-char (cdr bd)) + (skip-chars-backward " \t\n") + (point-marker)))) + (cdr bounds)) + with type = (let ((type (or (oref render type) gt-insert-render-type)) + (types '(after replace))) + (if (member type types) type + (intern (completing-read "Insert text as: " types nil t)))) + with hash = (when (and (eq type 'replace) (not (buffer-modified-p))) + (buffer-hash)) + with len = (length (plist-get (car ret) :result)) + for i from 0 below len + for (beg . end) = (if bds (nth i bds) + (if (use-region-p) + (car (region-bounds)) + (cons (point) (point)))) + for src = (if bds (buffer-substring beg end) "") + for res = (mapcar (lambda (tr) (nth i (plist-get tr :result))) ret) + do (goto-char end) + for fres = (gt-insert-render-format render src res) + do (let (p) + (if (eq type 'replace) + (delete-region beg end) + (when-let (face (and (eq type 'after) (gt-ensure-plain sface src))) + (delete-region beg end) + (insert (propertize src 'face face)))) + (setq p (point)) + (insert (propertize fres 'type 'gt-insert-result)) + (save-excursion + (goto-char p) + (skip-chars-forward " \t\n") + (push-mark))) + finally (progn + (if (> len 1) (goto-char start)) + (when (and hash (equal hash (buffer-hash))) + (set-buffer-modified-p nil)))) + (deactivate-mark) + (run-hook-with-args 'gt-insert-render-output-hook translator) + (message "ok."))))))) + +(cl-defmethod gt-next-for-stream ((render gt-insert-render) task) + (with-slots (markers res) task + (let* ((beg (car markers)) (end (cdr markers)) + (bounds (oref (oref task translator) bounds)) + (insert-text (with-current-buffer (car bounds) + (save-excursion + (goto-char end) + (gt-insert-render-format + render + (if (and (eq (oref render type) 'after) (caadr bounds)) + (buffer-substring (caadr bounds) (cdadr bounds)) + "") + (list (string-join (ensure-list res) "\n"))))))) + (gt-insert-text-at-marker insert-text beg end)))) + +(cl-defmethod gt-desc ((render gt-insert-render)) + (format "gt-insert-render/%s" (oref render type))) + + +;;; [Render] Render with Overlay + +(defclass gt-overlay-render (gt-render) + ((type + :initarg :type + :initform 'after + :type (or (member after replace help-echo before) boolean) + :documentation "How to display the result.") + (rfmt + :initarg :rfmt + :initform nil + :documentation + "Used to format the translation result to fit the overlay display. +See `gt-overlay-render-format' for details.") + (sface + :initarg :sface + :initform 'gt-overlay-source-face + :documentation "The propertize face of the source text after translation. +If this is nil then do nothing, if this is a face or a function return a face, +just propertize the source text with the face.") + (rface + :initarg :rface + :initform 'gt-overlay-result-face + :documentation "Result face.") + (rdisp + :initarg :rdisp + :initform nil + :documentation "Same as rface but used in `display' property.") + (pface + :initarg :pface + :initform 'gt-overlay-prefix-face + :documentation "Prefix face.") + (pdisp + :initarg :pdisp + :initform nil + :documentation "Same as pface but used in `display' property."))) + +(defcustom gt-overlay-render-type 'after + "How to display result in Overlay-Render. + +If this is `help-echo', display with help echo, if this is `replace', display +by covering the source text, otherwise, display before or after the source text. + +The value can be overrided by `type' slot of render." + :type '(choice (const :tag "Repace" replace) + (const :tag "Help Echo" help-echo) + (const :tag "After" after) + (other :tag "Before" before)) + :group 'go-translate) + +(defvar gt-overlay-render-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "") #'gt-delete-render-overlays) + (define-key map (kbd "") #'gt-overlay-render-save-to-kill-ring) + map) + "Keymap used in overlay render.") + +(defun gt-overlay-render-get-overlays (beg &optional end) + "Return overlays made by Overlay-Render in the region from BEG to END. +If END is nil, return the overlays at BEG." + (cl-remove-if-not (lambda (ov) (overlay-get ov 'gt)) + (if end + (overlays-in beg end) + (overlays-at beg)))) + +(defun gt-delete-render-overlays (beg &optional end) + "Delete overlays made by Overlay-Render in the region from BEG to END. +If called interactively, delete overlays around point or in region. With +`current-prefix-arg' non nil, delete all overlays in the buffer." + (interactive (cond (current-prefix-arg (list (point-min) (point-max))) + ((use-region-p) (list (region-beginning) (region-end))) + (t (list + (if (and (> (point) 1) ; for overlay before point + (not (gt-overlay-render-get-overlays (point))) + (gt-overlay-render-get-overlays (1- (point)))) + (1- (point)) + (point)) + nil)))) + (mapc #'delete-overlay (gt-overlay-render-get-overlays beg end))) + +(defun gt-overlay-render-save-to-kill-ring () + "Copy translate content at point to kill ring for Overlay-Render." + (interactive) + (if-let* ((ov (car (gt-overlay-render-get-overlays (point)))) + (rs (overlay-get ov 'gt))) + (progn (kill-new (string-trim rs)) + (message "Result already in the kill ring.")) + (user-error "No translate overlay found at point"))) + +(defun gt-overlay-render-format (render src res prefix) + "Format RES for overlay RENDER. + +SRC is the source text, RES and PREFIX are list extracted from translate task. + +Join them to a string, format or pretty it, at last return it as the result that +used to display. + +If slot `rfmt' is a string contains `%s', format every part of results with +function `format' and join them. + + (gt-overlay-render :rfmt \" <%s>\" :rface `font-lock-warning-face) + +If `rfmt' is a function with solo argument, apply the function on every part of +results and join them. If with two arguments, pass source text as the first +argument. If four arguments, then chain the formatting task to the function. + + (gt-overlay-render :rfmt (lambda (w) (format \" [%s]\")) + :rface `font-lock-warning-face) + + (gt-overlay-render :rfmt (lambda (s w) + (if (length< s 3) + (format \"\\n- %s\") + (propertize w `face `font-lock-warning-face)))) + +Otherwise, join the results use the default logic." + (with-slots (type rfmt rface rdisp pface pdisp) render + (cond + ((stringp rfmt) + (mapconcat (lambda (r) (gt-face-lazy (format rfmt r) + (gt-ensure-plain rface r) + (gt-ensure-plain rdisp r))) + res "\n")) + ((functionp rfmt) + (let ((n (cdr (func-arity rfmt)))) + (if (<= n 2) + (mapconcat (lambda (r) + (let ((ret (or (if (= n 2) (funcall rfmt src r) (funcall rfmt r)) r))) + (gt-face-lazy ret (gt-ensure-plain rface r) (gt-ensure-plain rdisp r)))) + res "\n") + (funcall rfmt render src res prefix)))) + (t (cl-loop with before = (when (eq type 'after) + (if (gt-word-p nil src) " " + (if (or (looking-at "\n\n") + (save-excursion (skip-chars-forward " \n\t") (eobp))) + "\n\n" + "\n"))) + with after = (when (eq type 'before) (if (gt-word-p nil src) " " "\n")) + for r in res for p in prefix + for pr = (gt-face-lazy r (gt-ensure-plain rface r) (gt-ensure-plain rdisp r)) + for pp = (if p (concat " " (gt-face-lazy p (gt-ensure-plain pface p) (gt-ensure-plain pdisp p)))) + collect (concat pr pp) into ret + finally (return (concat before (string-join ret (or before "\n\n")) after))))))) + +(cl-defmethod gt-init ((render gt-overlay-render) translator) + (with-slots (bounds state) translator + (unless (cdr bounds) + (error "%s only works for buffer bounds, abort" (gt-desc render))) + (unless (buffer-live-p (car bounds)) + (error "Source buffer is unavailable, abort")))) + +(cl-defmethod gt-output ((render gt-overlay-render) translator) + (with-slots (bounds state) translator + (when (= 3 state) + (let ((ret (gt-extract render translator))) + (when-let (err (cl-find-if (lambda (tr) (<= (plist-get tr :state) 1)) ret)) + (user-error "Error in translation, %s" (plist-get err :result))) + (with-current-buffer (car bounds) + (cl-loop with start = (point-marker) + with type = (let ((type (or (oref render type) gt-overlay-render-type)) + (types '(help-echo replace after before))) + (if (memq type types) type + (intern (completing-read "Display with overlay as: " types nil t)))) + with hooks = `((lambda (o &rest _) (delete-overlay o))) + for (beg . end) in (cdr bounds) for i from 0 + do (save-excursion + (goto-char beg) + (skip-chars-forward "\n") + (setq beg (point)) + (goto-char end) + (skip-chars-backward " \t\n") + (setq end (point))) + do (gt-delete-render-overlays beg end) + for src = (buffer-substring beg end) + do (save-excursion + (goto-char end) + (let* ((ov (make-overlay beg (point) nil t t)) + (fres (gt-overlay-render-format + render src + (mapcar (lambda (tr) (nth i (plist-get tr :result))) ret) + (mapcar (lambda (tr) (plist-get tr :prefix)) ret))) + (sface (oref render sface)) + (sface (unless (eq type 'replace) (gt-ensure-plain sface src)))) + (pcase type + ('help-echo (overlay-put ov 'help-echo fres)) + ('after (overlay-put ov 'after-string fres)) + ('before (overlay-put ov 'before-string fres))) + (overlay-put ov 'gt fres) + (overlay-put ov 'evaporate t) + (overlay-put ov 'pointer 'arrow) + (overlay-put ov 'insert-in-front-hooks hooks) + (overlay-put ov 'insert-behind-hooks hooks) + (overlay-put ov 'modification-hooks hooks) + (overlay-put ov 'keymap gt-overlay-render-map) + (if (eq type 'replace) + (progn (overlay-put ov 'display fres) + (overlay-put ov 'help-echo src)) + (if sface (overlay-put ov 'face sface))))) + finally (if (cddr bounds) (goto-char start))) + (deactivate-mark) + (message "ok.")))))) + +(cl-defmethod gt-desc ((render gt-overlay-render)) + (format "gt-overlay-render/%s" (oref render type))) + + +;;; [Render] Alert Render + +(defclass gt-alert-render (gt-render) () + :documentation "Output results as system notification. +It depends on the `alert' package.") + +(defvar gt-alert-render-args '(:timeout 10)) + +(declare-function alert "ext:alert.el" t t) + +(cl-defmethod gt-init ((_ gt-alert-render) _) + (unless (require 'alert nil t) + (user-error "To use `gt-alert-render', you should install and load package `alert' first"))) + +(cl-defmethod gt-output ((render gt-alert-render) translator) + (when (= (oref translator state) 3) + (let ((ret (gt-extract render translator)) lst) + ;; format + (dolist (tr ret) + (let ((prefix (if (cdr ret) (plist-get tr :prefix))) + (result (string-join (ensure-list (plist-get tr :result)) "\n"))) + (push (concat prefix result) lst))) + ;; output + (message "") + (apply #'alert (string-join (nreverse lst) "\n") :title "*Go-Translate*" gt-alert-render-args)))) + + +;;; [Taker] Prompt with new buffer + +(defcustom gt-buffer-prompt-window-config + '((display-buffer-reuse-window display-buffer-below-selected)) + "Window configuration of taker's buffer prompt window." + :type 'sexp + :group 'go-translate) + +(defvar gt-buffer-prompt-name "*gt-taker*") + +(defvar gt-buffer-prompt-map (make-sparse-keymap)) + +(defvar gt-buffer-prompt-after-init-function nil + "Function with no argument, executed after prompt buffer init. +Can do extra setup works for the buffer through this function.") + +(declare-function gt-set-render "ext:go-translate") +(declare-function gt-set-engines "ext:go-translate") +(declare-function gt-translator-info "ext:go-translate") + +(cl-defmethod gt-prompt ((taker gt-taker) translator (_ (eql 'buffer))) + "Prompt the TAKER's result using a new buffer for TRANSLATOR. + +Only works when taker's prompt slot is config as `buffer: + + :taker (gt-picker :prompt `buffer) + +Edit the text in buffer and confirm with `C-c C-c', you can also change +target, engines and render in the buffer for the following translation." + (with-slots (text target render engines _render _engines) translator + (when (cdr text) + (user-error "Multiple text cannot be prompted")) + (cl-labels ((prop (s &optional fn not-key) + (let (args) + (unless not-key (setq args `(,@args face font-lock-keyword-face))) + (if fn (setq args `(,@args local-map (keymap (mode-line keymap (mouse-1 . ,fn))) + mouse-face font-lock-warning-face))) + (apply #'propertize (format "%s" s) args))) + (set-head-line () + (setq header-line-format + (concat " " (cl-loop for (key . value) in `(("C-c C-c" . "to apply") + ("C-c C-k" . "to cancel")) + concat (format "%s %s " (prop key) value)) + " " (propertize "Translate taking..." 'face 'font-lock-warning-face)))) + (set-mode-line () + (setq mode-line-format + (let ((ms (concat "C-c C-n: Next Target\nC-c C-p: Prev Target\n\n" + "C-c C-e: Set Engines\nC-c C-r: Set Render"))) + (mapcar (lambda (item) (when item (propertize item 'help-echo ms))) + (cl-destructuring-bind (_ eg rd) + (ignore-errors (gt-translator-info translator)) + (list (prop (concat + (if-let (src (car target)) (concat "[" (prop src) "] → ")) + "[" (mapconcat (lambda (s) (prop s)) (cdr target) ", ") "]") + #'cycle-next-target t) + (if eg (concat " Engines: " (prop eg #'set-engines))) + (if rd (concat " Render: " (prop rd #'set-render))))))))) + (cycle-next-target (&optional backwardp) + (interactive) + (setf target + (gt-target taker (make-instance + (eieio-object-class translator) + :text (list (buffer-string))) + (if backwardp 'prev 'next))) + (set-mode-line)) + (cycle-prev-target () + (interactive) + (cycle-next-target t)) + (set-engines () + (interactive) + (gt-set-engines translator) + (set-mode-line)) + (set-render () + (interactive) + (gt-set-render translator) + (set-mode-line)) + (set-local-keys () + (local-set-key (kbd "C-c C-n") #'cycle-next-target) + (local-set-key (kbd "C-c C-p") #'cycle-prev-target) + (local-set-key (kbd "C-c C-e") #'set-engines) + (local-set-key (kbd "C-c C-r") #'set-render))) + (let* ((newtext (gt-read-from-buffer + :buffer gt-buffer-prompt-name + :initial-contents (or (car text) "") + :catch 'gt-buffer-prompt + :window-config gt-buffer-prompt-window-config + :keymap gt-buffer-prompt-map + (set-head-line) + (set-mode-line) + (set-local-keys) + (when gt-buffer-prompt-after-init-function + (funcall gt-buffer-prompt-after-init-function))))) + (when (null newtext) + (user-error "")) + (when (string-blank-p newtext) + (user-error "Text should not be null, abort")) + (setf text (ensure-list newtext)))))) + + +;;; [Taker] Pick only fresh words + +(defvar gt-fresh-word-class 'gt-fresh-word-with-file) + +(defvar gt-ripe-words-file (locate-user-emacs-file "gt-known-words.txt")) + +(defmacro gt-with-ripe-words-file (&rest form) + `(let* ((case-fold-search t) + (bufname " gt-known-words") + (buf (or (get-buffer bufname) + (progn + (unless (file-exists-p gt-ripe-words-file) + (write-region (point-min) (point-min) gt-ripe-words-file)) + (find-file-noselect gt-ripe-words-file))))) + (with-current-buffer buf + (unless (equal (buffer-name) bufname) + (rename-buffer bufname)) + (goto-char (point-min)) + (prog1 (progn ,@form) (basic-save-buffer))))) + +(cl-defgeneric gt-word-fresh-p (word) + (:method ((_ (eql 'gt-fresh-word-with-file)) word) + (gt-with-ripe-words-file + (not (re-search-forward (concat "^" word "$") nil t)))) + (gt-word-fresh-p gt-fresh-word-class word)) + +(cl-defgeneric gt-fresh-word (&rest words) + (:method ((_ (eql 'gt-fresh-word-with-file)) &rest words) + (gt-with-ripe-words-file + (if (equal words (list t)) ; clear ripes + (erase-buffer) + (dolist (word words) ; remove from ripes + (goto-char (point-min)) + (while (re-search-forward (concat "^" word "$") nil t) + (delete-region (match-beginning 0) (match-end 0)) + (if (looking-at "\n") (delete-char 1))))))) + (apply #'gt-fresh-word gt-fresh-word-class words)) + +(cl-defgeneric gt-ripen-word (&rest words) + (:method ((_ (eql 'gt-fresh-word-with-file)) &rest words) + (gt-with-ripe-words-file ; add to ripes + (dolist (word words) + (goto-char (point-min)) + (unless (re-search-forward (concat "^" word "$") nil t) + (insert (downcase word) "\n"))))) + (apply #'gt-ripen-word gt-fresh-word-class words)) + +(defvar gt-fresh-words-last nil) + +(defun gt-record-words-as-known () + "Record the words as known." + (interactive) + (let* ((si (string-join + (sort (delete-dups + (mapcar #'downcase + (or gt-fresh-words-last + (ensure-list (thing-at-point 'word)))))) + " ")) + (ss (read-string "Words to record as known: " si)) + (ws (split-string ss))) + (apply #'gt-ripen-word ws))) + +(defun gt-record-words-as-unknown () + "Record the words as unknown." + (interactive) + (let* ((ss (read-string "Words to record as unknown: " (thing-at-point 'word))) + (ws (split-string ss))) + (apply #'gt-fresh-word ws))) + +;; (gt-taker :pick 'fresh-word) + +(cl-defmethod gt-pick ((_ (eql 'fresh-word)) translator) + (with-slots (text bounds taker) translator + (setq gt-fresh-words-last nil) + (let* ((car (if (cdr bounds) (cl-subseq bounds 0 2) (car text))) + (pred (lambda (word) + (and (if-let (p (oref taker pick-pred)) (funcall p word) t) + (> (string-bytes word) 2) + (not (string-match-p "^[0-9]+$" word)) + (gt-word-fresh-p word) + (push word gt-fresh-words-last))))) + (gt-pick-items-by-thing car 'word pred)))) + + +;;; [Taker] pdf-view-mode + +(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) + +(cl-defmethod gt-text-at-point (_thing (_ (eql 'pdf-view-mode))) + (if (pdf-view-active-region-p) + (pdf-view-active-region-text) + (user-error "You should make a selection before translate"))) + +(provide 'gt-extension) + +;;; gt-extension.el ends here diff --git a/elpa/go-translate-20240802.131/gt-faces.el b/elpa/go-translate-20240802.131/gt-faces.el new file mode 100644 index 00000000..14dea12d --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-faces.el @@ -0,0 +1,221 @@ +;;; gt-faces.el --- Face definitions -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; The faces and colors. + +;;; Code: + +(require 'gt-core) + +(defgroup go-translate-faces nil + "The faces for this framework." + :group 'go-translate) + + +;;; Common + +(defface gt-logger-buffer-tag-face '((t :inherit font-lock-comment-face)) + "Used in the logger buffer tag keyword." + :group 'go-translate-faces) + +(defface gt-logger-buffer-timestamp-face '((t :foreground "grey")) + "Used in the logger buffer timestamp keyword." + :group 'go-translate-faces) + +(defface gt-render-prefix-face '((t :foreground "grey")) + "Used in the buffer's block prefix." + :group 'go-translate-faces) + + +;;; Buffer Render + +(defface gt-buffer-render-header-lang-face '((t :inherit font-lock-keyword-face)) + "Used in the buffer's `header-line-format' for langs." + :group 'go-translate-faces) + +(defface gt-buffer-render-header-desc-face '((t :inherit font-lock-variable-name-face)) + "Used in the buffer's `header-line-format' for description." + :group 'go-translate-faces) + +(defface gt-buffer-render-source-face + '((((background light)) :background "ivory") + (((background dark)) :background "gray20" :foreground "gray" :weight light)) + "Used in the buffer's source text." + :group 'go-translate-faces) + +(defface gt-buffer-render-inline-prefix-face + '((((background light)) :height 0.8 :foreground "grey") + (((background dark)) :height 0.8 :foreground "grey30")) + "Used in the buffer's inline prefix." + :group 'go-translate-faces) + +(defface gt-buffer-render-block-prefix-face '((t :background "slategray" :foreground "white" :extend t)) + "Used in the buffer's block prefix." + :group 'go-translate-faces) + +(defface gt-buffer-render-error-face '((t :weight bold :inherit font-lock-comment-face)) + "Used in the buffer's error text." + :group 'go-translate-faces) + +(defface gt-buffer-render-loading-face '((t :inherit font-lock-comment-face)) + "Used in the buffer's loading messaget." + :group 'go-translate-faces) + + +;;; Google Buffer Render + +(defface gt-google-buffer-headline-face '((t :inherit font-lock-function-name-face :weight bold)) + "Propertize the headline in buffer rendering." + :group 'go-translate-faces) + +(defface gt-google-buffer-phonetic-face '((t :inherit font-lock-string-face :slant normal)) + "Propertize the phonetic in buffer rendering." + :group 'go-translate-faces) + +(defface gt-google-buffer-suggestion-desc-face '((t :inherit font-lock-warning-face)) + "Propertize the suggestion description in buffer rendering." + :group 'go-translate-faces) + +(defface gt-google-buffer-suggestion-text-face '((t :slant italic :underline t)) + "Propertize the phonetic text in buffer rendering." + :group 'go-translate-faces) + +(defface gt-google-buffer-brief-result-face '((t :weight bold)) + "Propertize the brief result in buffer rendering." + :group 'go-translate-faces) + +(defface gt-google-buffer-source-face '((t :inherit font-lock-string-face)) + "Propertize the source in buffer rendering." + :group 'go-translate-faces) + +(defface gt-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 gt-pop-posframe-forecolor "white" + "Default foreground color of pop posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gt-pop-posframe-backcolor "black" + "Default background color of pop posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gt-pin-posframe-forecolor nil + "Default foreground color of pin posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gt-pin-posframe-backcolor nil + "Default background color of pin posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gt-pin-posframe-bdcolor "#000000" + "Default border color of pin posframe." + :type 'string + :group 'go-translate-faces) + +(defcustom gt-pin-posframe-fringe-color nil + "Used in the posframe pip buffer fringe color." + :type 'string + :group 'go-translate-faces) + + +;;; Overlay Render + +(defface gt-overlay-source-face '((t :underline (:color "grey" :style wave))) + "Used in the overlay's source." + :group 'go-translate-faces) + +(defface gt-overlay-result-face '((t :inherit font-lock-string-face)) + "Used in the overlay's result." + :group 'go-translate-faces) + +(defface gt-overlay-prefix-face '((t :inherit font-lock-comment-face)) + "Used in the overlay's prefix." + :group 'go-translate-faces) + + +;; Youdao + +(defface gt-youdao-dict-label-face '((((background light)) :foreground "lightblue") + (((background dark)) :foreground "darkcyan")) + "Face for label of youdao-dict." + :group 'go-translate-faces) + +(defface gt-youdao-dict-phonetic-face '((((background light)) :foreground "grey") + (((background dark)) :foreground "darkgray")) + "Face for phonetic of youdao-dict." + :group 'go-translate-faces) + +(defface gt-youdao-dict-entry-face '((t :bold t)) + "Face for entry of youdao-dict." + :group 'go-translate-faces) + +(defface gt-youdao-suggest-entry-face '((t :bold t)) + "Face for entry of youdao-suggest." + :group 'go-translate-faces) + +(defface gt-youdao-suggest-cixing-face '((((background light)) :foreground "grey") + (((background dark)) :foreground "grey")) + "Face for cixing of youdao-suggest." + :group 'go-translate-faces) + + +;;; StarDict + +(defface gt-stardict-dict-face '((((background light)) :foreground "grey") + (((background dark)) :foreground "darkcyan")) + "Face for dict of StarDict." + :group 'go-translate-faces) + +(defface gt-stardict-word-face '((((background light)) :bold t :foreground "darkblue") + (((background dark)) :bold t)) + "Face for word of StarDict." + :group 'go-translate-faces) + +(defface gt-stardict-phonetic-face '((((background light)) :foreground "lightblue") + (((background dark)) :foreground "darkcyan")) + "Face for phonetic of StarDict." + :group 'go-translate-faces) + +(defface gt-stardict-word-class-face '((t :bold t)) + "Face for cixing of StarDict." + :group 'go-translate-faces) + + +;;; Misc + +(defface gt-bionic-reading-face '((t :weight bold)) + "Face for bionic reading word." + :group 'go-translate-faces) + +(provide 'gt-faces) + +;;; gt-faces.el ends here diff --git a/elpa/go-translate-20240802.131/gt-httpx.el b/elpa/go-translate-20240802.131/gt-httpx.el new file mode 100644 index 00000000..def4a9b2 --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-httpx.el @@ -0,0 +1,358 @@ +;;; gt-httpx.el --- Http Client -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu +;; Package-Requires: ((emacs "28.1")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; Http client components used by the framework. With unified interface to +;; compact different http backends. +;; +;; - Support both sync/async request +;; - Support streaming request +;; - Support retry for timeout +;; - Support config proxies for backends +;; - Support file upload/download +;; + +;;; Code: + +(require 'cl-lib) +(require 'eieio) +(require 'url) + +(if (fboundp 'gt-log) + (declare-function gt-log "ext:gt-core") + (defalias 'gt-log 'ignore)) + +(if (fboundp 'gt-single) + (declare-function gt-single--eieio-childp "ext:gt-core") + (defclass gt-single () () :abstract t)) + +(defun gt-http-binary-p (content-type) + "Check if current CONTENT-TYPE is binary." + (if (null content-type) nil + (cl-destructuring-bind (mime sub) (string-split content-type "/" nil "[ \n\r\t]") + (not (or (equal mime "text") + (and (equal mime "application") + (string-match-p "json\\|xml\\|php" sub))))))) + +(defun gt-format-params (alist) + "Format ALIST to k=v style query string." + (mapconcat (lambda (arg) + (format "%s=%s" + (url-hexify-string (format "%s" (car arg))) + (url-hexify-string (format "%s" (or (cdr arg) 1))))) + (delq nil alist) "&")) + +(defvar gt-multipart-boundary "gt-boundary-O0o0O69Oo") + +(defun gt-format-formdata (alist) + "Generate multipart/formdata string from ALIST." + (with-temp-buffer + (set-buffer-multibyte nil) + (cl-loop for (key . value) in alist for i from 1 + for filep = nil for contentype = nil + do (setq key (format "%s" key)) + do (if (consp value) ; ((afile "~/aaa.jpg" "image/jpeg")) + (setq contentype (or (cadr value) "application/octet-stream") + value (format "%s" (car value)) filep t) + (setq value (format "%s" value))) + for newline = "\r\n" + do (insert "--" gt-multipart-boundary newline) + if filep do (let ((fn (url-encode-url (url-file-nondirectory value)))) + (insert "Content-Disposition: form-data; name=\"" key "\" filename=\"" fn "\"" newline) + (insert "Content-Type: " contentype newline newline) + (insert-file-contents-literally value) + (goto-char (point-max))) + else do (insert "Content-Disposition: form-data; name=\"" key "\"" newline newline value) + if (< i (length alist)) do (insert newline) + else do (insert newline "--" gt-multipart-boundary "--")) + (buffer-substring-no-properties (point-min) (point-max)))) + + +;;; Http Client + +(defclass gt-http-client (gt-single) + ((user-agent :initarg :user-agent :initform nil :type (or string null))) + "Used to send http request." + :abstract t) + +(defvar gt-http-client-max-retry 3) + +(defvar gt-user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.75 Safari/537.36") + +(defvar-local gt-http-client-stream-abort-flag nil + "Non-nil means to ignore following stream progress in callback of http filter.") + +(cl-defgeneric gt-request (http-client &rest _args &key url method headers data filter done fail sync retry &allow-other-keys) + "Send HTTP request using the given HTTP-CLIENT. + +Keyword arguments: + - URL: The URL to send the request to. + - METHOD: Request method, symbol like \\='post. If nil guess by data. + - HEADERS: Additional headers to include in the request. Alist. + - DATA: The data to include in the request. If this is a string, it will be + sent directly as request body. If this is a list and every element + is (key . value) then this will be joined to a string like a=1&b=2 and + then be sent. If this is a list and some element is (key filename) + format, then the list will be normalized as multipart formdata string + and be sent. + - FILTER: A function to be called every time when some data returned. + - DONE: A function to be called when the request succeeds. + - FAIL: A function to be called when the request fails. + - RETRY: How many times it can retry for timeout. Number. + - SYNC: Non-nil means request synchronized. Boolean. + +If request async, return the process behind the request." + (:method :around ((client gt-http-client) &rest args &key url method _headers data filter done fail sync retry) + ;; normalize and validate + (if (and (null filter) (null done)) (setq sync t args `(:sync t ,@args))) + (cl-assert (and url (or (and sync (not filter)) (and (not sync) (or filter done))))) + (if (null method) (setq args `(:method ,(if data 'post 'get) ,@args))) + ;; sync + (if sync (apply #'cl-call-next-method client args) + ;; async + (let* ((tag (eieio-object-class client)) + (failfn (lambda (status) + ;; retry for timeout + (unless retry (setq retry gt-http-client-max-retry)) + (if (and (string-match-p "Operation timeout" (format "%s" status)) (cl-plusp retry)) + (progn (gt-log tag (format "request timeout, retrying (remains %d times)..." retry)) + (apply #'gt-request client `(:retry ,(1- retry) ,@args))) + ;; failed finally + (gt-log tag (format "Request FAIL: (%s) %s" url status)) + (if fail (funcall fail status) + (signal (car status) (cdr status)))))) + (filterfn (when filter + (lambda () + ;; abort action and error case + (unless gt-http-client-stream-abort-flag + (condition-case err + (funcall filter) + (error + (setq gt-http-client-stream-abort-flag t) + (gt-log tag (format "Error in filter: (%s) %s" url err)) + (funcall failfn err))))))) + (donefn (lambda (raw) + (gt-log tag (format "✓ %s" url)) + (when done (funcall done raw))))) + (apply #'cl-call-next-method client `(:fail ,failfn :filter ,filterfn :done ,donefn ,@args)))))) + + +;; http client implemented using `url.el' + +(defclass gt-url-http-client (gt-http-client) + ((proxy-services + :initarg :proxies + :initform nil + :type (or list null) + :documentation "Proxy services passed to `url.el', see `url-proxy-services' for details.")) + :documentation "Http Client implemented using `url.el'.") + +(defvar url-http-content-type) +(defvar url-http-end-of-headers) +(defvar url-http-transfer-encoding) + +(defvar gt-url-extra-filter nil) + +(defun gt-url-http-extra-filter (beg end len) + (when (and gt-url-extra-filter (bound-and-true-p url-http-end-of-headers) + (if (equal url-http-transfer-encoding "chunked") (= beg end) ; when delete + (= len 0))) ; when insert + (save-excursion + (save-restriction + (narrow-to-region url-http-end-of-headers (point-max)) + (funcall gt-url-extra-filter))))) + +(cl-defmethod gt-request ((client gt-url-http-client) &key url method headers data filter done fail sync retry) + (ignore retry) + (let* ((inhibit-message t) + (message-log-max nil) + (url-user-agent (or (oref client user-agent) gt-user-agent)) + (url-proxy-services (or (oref client proxy-services) url-proxy-services)) + (formdatap (and (consp data) + (or (string-match-p "multipart/formdata" + (or (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) "")) + (cl-some (lambda (x) (consp (cdr x))) data)))) + (url-request-data (funcall (if (atom data) #'identity ; string + (if formdatap #'gt-format-formdata #'gt-format-params)) ; alist + data)) + (url-request-extra-headers (progn + (when formdatap + (setf (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) + (concat "multipart/form-data; boundary=" gt-multipart-boundary))) + headers)) + (url-request-method (string-to-unibyte (upcase (format "%s" method)))) + (url-mime-encoding-string "identity") + (get-resp-content (lambda () + (set-buffer-multibyte (not (gt-http-binary-p url-http-content-type))) + (buffer-substring-no-properties (min (1+ url-http-end-of-headers) (point-max)) (point-max))))) + ;; log + (gt-log (eieio-object-class client) + (format "> %s\n> %s" client url) + (if url-request-extra-headers (format "> HEADER: %S" url-request-extra-headers)) + (if url-request-data (format "> DATA: %s" url-request-data))) + ;; sync + (if sync + (condition-case err + (let ((buf (url-retrieve-synchronously url nil t))) + (unwind-protect + (with-current-buffer buf + (let ((s (funcall get-resp-content))) (if done (funcall done s) s))) + (ignore-errors (kill-buffer buf)))) + (error (if fail (funcall fail err) (signal 'user-error (cdr err))))) + ;; async + (let ((buf (url-retrieve url + (lambda (status) + (let ((cb (current-buffer))) + (remove-hook 'after-change-functions #'gt-url-http-extra-filter t) + (unwind-protect + (if-let (err (or (cdr-safe (plist-get status :error)) + (when (or (null url-http-end-of-headers) (= 1 (point-max))) + (list 'empty-response "Nothing responsed from server")))) + (if fail (funcall fail err) (signal 'user-error err)) + (if done (funcall done (funcall get-resp-content)))) + (kill-buffer cb)))) + nil t))) + (when (and filter (buffer-live-p buf)) + (with-current-buffer buf + (setq-local gt-url-extra-filter filter) + (add-hook 'after-change-functions #'gt-url-http-extra-filter nil t))) + (get-buffer-process buf))))) + + +;;; request with `curl' by package `plz.el' + +;; you should install `plz.el' first before use this + +(defclass gt-plz-http-client (gt-http-client) + ((extra-args + :initarg :args + :type list + :documentation "Extra arguments passed to curl programe.")) + :documentation "Http Client implemented using `plz.el'.") + +(defvar plz-curl-program) +(defvar plz-curl-default-args) +(defvar plz-http-end-of-headers-regexp) + +(declare-function plz "ext:plz.el" t t) +(declare-function plz-error-message "ext:plz.el" t t) +(declare-function plz-error-curl-error "ext:plz.el" t t) +(declare-function plz-error-response "ext:plz.el" t t) +(declare-function plz-response-status "ext:plz.el" t t) +(declare-function plz-response-body "ext:plz.el" t t) +(declare-function plz--narrow-to-body "ext:plz.el" t t) + +(defvar gt-plz-initialize-error-message + "\n\nTry to install curl and specify the program like this to solve the problem:\n + (setq plz-curl-program \"c:/msys64/usr/bin/curl.exe\")\n +Or switch http client to `gt-url-http-client' instead:\n + (setq gt-default-http-client (gt-url-http-client))") + +(cl-defmethod gt-request :before ((_ gt-plz-http-client) &rest _) + (unless (and (require 'plz nil t) (executable-find plz-curl-program)) + (error "You should have `plz.el' and `curl' installed before using `gt-plz-http-client'"))) + +(cl-defmethod gt-request ((client gt-plz-http-client) &key url method headers data filter done fail sync retry) + (ignore retry) + (let* ((plz-curl-default-args (if (slot-boundp client 'extra-args) + (append (oref client extra-args) plz-curl-default-args) + plz-curl-default-args)) + (formdatap (and (consp data) + (or (string-match-p "multipart/formdata" + (or (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) "")) + (cl-some (lambda (x) (consp (cdr x))) data)))) + (data (funcall (if (atom data) #'identity ; string + (if formdatap #'gt-format-formdata #'gt-format-params)) ; alist + data)) + (string-or-binary (lambda () ; decode according content-type. there is no builtin way to do this in plz + (widen) + (let* ((content-type (mail-fetch-field "content-type")) + (binaryp (gt-http-binary-p content-type))) + (set-buffer-multibyte (not binaryp)) + (goto-char (point-min)) + (plz--narrow-to-body) + (unless binaryp (decode-coding-region (point-min) (point-max) 'utf-8)) + (buffer-string))))) + ;; headers + (when formdatap + (setf (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) + (concat "multipart/form-data; boundary=" gt-multipart-boundary))) + (unless (alist-get "User-Agent" headers nil nil #'string-equal-ignore-case) + (push `("User-Agent" . ,(or (oref client user-agent) gt-user-agent)) headers)) + ;; log + (gt-log (eieio-object-class client) + (format "> %s\n> %s" client url) + (if headers (format "> HEADER: %s" headers)) + (if data (format "> DATA: %s" data)) + (if plz-curl-default-args (format "> EXTRA: %s" plz-curl-default-args))) + ;; sync + (if sync + (condition-case err + (let ((r (plz method url + :headers headers + :body data + :body-type (if formdatap 'binary 'text) + :decode nil + :as string-or-binary + :then 'sync))) + (if done (funcall done r) r)) + (error (if fail (funcall fail err) + (signal 'user-error (cdr err))))) + ;; async + (plz method url + :headers headers + :body data + :body-type (if formdatap 'binary 'text) + :decode nil + :as string-or-binary + :filter (when filter + (lambda (proc string) + (with-current-buffer (process-buffer proc) + (save-excursion + (goto-char (point-max)) + (insert string) + (goto-char (point-min)) + (when (re-search-forward plz-http-end-of-headers-regexp nil t) + (save-restriction + (narrow-to-region (point) (point-max)) + (funcall filter))))))) + :then (lambda (raw) + (when done (funcall done raw))) + :else (lambda (err) + (let ((ret ;; try to compat with error object of url.el, see `url-retrieve' for details + (or (plz-error-message err) + (when-let (r (plz-error-curl-error err)) + (list 'curl-error + (concat (format "%s" (or (cdr r) (car r))) + (pcase (car r) + (2 (when (memq system-type '(cygwin windows-nt ms-dos)) + gt-plz-initialize-error-message)))))) + (when-let (r (plz-error-response err)) + (list 'http (plz-response-status r) (plz-response-body r)))))) + (if fail (funcall fail ret) + (signal 'user-error ret)))))))) + +(provide 'gt-httpx) + +;;; gt-httpx.el ends here diff --git a/elpa/go-translate-20240802.131/gt-text-utility.el b/elpa/go-translate-20240802.131/gt-text-utility.el new file mode 100644 index 00000000..c2cc152f --- /dev/null +++ b/elpa/go-translate-20240802.131/gt-text-utility.el @@ -0,0 +1,124 @@ +;;; gt-text-utility.el --- Text utilities base on the translator -*- lexical-binding: t -*- + +;; Copyright (C) 2024 lorniu +;; Author: lorniu + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is NOT part of GNU Emacs. + +;;; Commentary: + +;; Integrate md5, sha1, base64, qrcode and others into this translation framework. +;; +;; Shows that this framework is more than just translation purposes. +;; +;; Use like this: +;; +;; \\=(gt-start (gt-text-utility :render (gt-buffer-render))) +;; +;; To avoid be prompted, specify the targets like this: +;; +;; \\=(gt-start (gt-text-utility :taker (gt-taker :langs '(md5 sha1)) :render (gt-insert-render))) + +;;; Code: + +(require 'gt-extension) + +(defvar gt-text-utilities `(base64 rot13 qrcode speak ,@(secure-hash-algorithms)) + "List of available targets for `gt-text-utility-engine'.") + +(defclass gt-text-utility (gt-translator) ()) + +(defclass gt-text-utility-engine (gt-engine) + ((tag :initform 'Text-Utility) + (cache :initform nil) + (delimiter :initform nil))) + +(cl-defmethod gt-reset :after ((translator gt-text-utility) &rest _) + (with-slots (_engines) translator + (unless _engines (setf _engines (gt-text-utility-engine))) + (setf _engines (ensure-list _engines)) + (unless (and (not (cdr _engines)) (cl-typep (car _engines) 'gt-text-utility-engine)) + (user-error "%s should use only one gt-text-utility-engine as engine" (gt-desc translator))))) + +(cl-defmethod gt-target ((taker gt-taker) (_ gt-text-utility) &rest _) + (let ((tgts (if (slot-boundp taker 'langs) + (ensure-list (oref taker langs)) + (mapcar #'intern + (completing-read-multiple + "Utilities (can choose multiple): " gt-text-utilities + nil t nil 'gt-text-utility-hist))))) + (unless tgts (user-error "No targets found")) + (cons nil (cl-delete-duplicates tgts)))) + +(cl-defmethod gt-translate ((_ gt-text-utility-engine) task _) + "Translate and render the result directly, skip parse and other steps." + (with-slots (text tgt res translator) task + (setf res (mapcar (lambda (c) (gt-text-util tgt (encode-coding-string c 'utf-8))) text)) + (gt-update-state translator) + (gt-output (oref translator render) translator))) + +(cl-defmethod gt-keybinds ((_buffer gt-buffer-render) (_ gt-text-utility)) + (gt-buffer-render-key ("t" "Cycle Next") #'gt-buffer-render--cycle-next) + (gt-buffer-render-key ("g" "Refresh") #'gt-buffer-render--refresh) + (gt-buffer-render-key ("q" "Quit") #'kill-buffer-and-window) + (gt-buffer-render-key ("C-x C-q") #'gt-buffer-render--toggle-readonly) + (gt-buffer-render-key ("?") #'gt-buffer-render--show-tips)) + + + +(cl-defgeneric gt-text-util (target text) + "Dispatch to different TEXT utility methods for different TARGET." + (:method ((_ (eql 'base64)) text) (base64-encode-string text t)) + (:method ((_ (eql 'rot13)) text) (rot13 text)) + (:method ((_ (eql 'qrcode)) text) (gt-qrcode text)) + (:method ((_ (eql 'speak)) text) (gt-text-speak-button text)) + (if (member target (secure-hash-algorithms)) + (secure-hash target text) + (user-error "Unimplemented"))) + +(defun gt-text-speak-button (str) + (propertize str + 'display " click to speak... " + 'pointer 'hand + 'keymap (gt-simple-keymap [mouse-1] (lambda () (interactive) (gt-speak 'interact str t))) + 'face '(:box t) + 'mouse-face '(:reverse-video t :inherit font-lock-warning-face))) + +(declare-function qrencode "ext:qrencode.el" t t) + +;;;###autoload +(defun gt-qrcode (str) + "Genrate QR Code for STR." + (interactive (list (read-string "String to generate QRCode: "))) + (let ((code (if (executable-find "qrencode") + (with-temp-buffer + (let ((coding-system-for-read 'raw-text)) + (set-buffer-multibyte nil) + (insert str) + (shell-command-on-region (point-min) (point-max) "qrencode -t PNG -o -" (current-buffer)) + (if (string-match-p "PNG" (buffer-substring 1 (min (point-max) 8))) + (propertize " " 'display `(image :type png :data ,(buffer-string) :width 200)) + (user-error (buffer-string))))) + (if (require 'qrencode nil t) + (qrencode str) + (user-error "Install program `qrencode' or package `qrencode.el' first to generate QR Code"))))) + (if (called-interactively-p 'any) (message "%s" code) code))) + +(provide 'gt-text-utility) + +;;; gt-text-utility.el ends here diff --git a/elpa/graphql-mode-20230411.1943/graphql-mode-autoloads.el b/elpa/graphql-mode-20230411.1943/graphql-mode-autoloads.el deleted file mode 100644 index 46d7976b..00000000 --- a/elpa/graphql-mode-20230411.1943/graphql-mode-autoloads.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; graphql-mode-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 "graphql-mode" "graphql-mode.el" (0 0 0 0)) -;;; Generated autoloads from graphql-mode.el - -(autoload 'graphql-mode "graphql-mode" "\ -A major mode to edit GraphQL schemas. - -\(fn)" t nil) - -(add-to-list 'auto-mode-alist '("\\.graphql\\'" . graphql-mode)) - -(add-to-list 'auto-mode-alist '("\\.gql\\'" . graphql-mode)) - -(register-definition-prefixes "graphql-mode" '("graphql-")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; graphql-mode-autoloads.el ends here