From: Andreas Gerler Date: Wed, 21 May 2025 12:42:59 +0000 (+0200) Subject: update go-translate X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=50fc04346fce6db24ad31f6e2bfa07dbc6b33618;p=emacsconfig.git update go-translate --- diff --git a/elpa/go-translate-20240802.131/go-translate-autoloads.el b/elpa/go-translate-20240802.131/go-translate-autoloads.el deleted file mode 100644 index 308a5d34..00000000 --- a/elpa/go-translate-20240802.131/go-translate-autoloads.el +++ /dev/null @@ -1,133 +0,0 @@ -;;; 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 deleted file mode 100644 index e22c61b9..00000000 --- a/elpa/go-translate-20240802.131/go-translate-pkg.el +++ /dev/null @@ -1,10 +0,0 @@ -;; -*- 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 deleted file mode 100644 index 867e38e3..00000000 --- a/elpa/go-translate-20240802.131/go-translate.el +++ /dev/null @@ -1,348 +0,0 @@ -;;; 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 deleted file mode 100644 index 54537a92..00000000 --- a/elpa/go-translate-20240802.131/gt-core.el +++ /dev/null @@ -1,1965 +0,0 @@ -;;; 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 deleted file mode 100644 index 6d6f52df..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-bing.el +++ /dev/null @@ -1,203 +0,0 @@ -;;; 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 deleted file mode 100644 index 01d0f449..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-chatgpt.el +++ /dev/null @@ -1,190 +0,0 @@ -;;; 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 deleted file mode 100644 index 4efdecb7..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-deepl.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; 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 deleted file mode 100644 index 165de0c8..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-echo.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; 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 deleted file mode 100644 index c150b3a7..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-google-rpc.el +++ /dev/null @@ -1,223 +0,0 @@ -;;; 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 deleted file mode 100644 index 70c43b1f..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-google.el +++ /dev/null @@ -1,447 +0,0 @@ -;;; 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 deleted file mode 100644 index b09b7b2b..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-libre.el +++ /dev/null @@ -1,101 +0,0 @@ -;;; 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 deleted file mode 100644 index 3ec8c0af..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-stardict.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; 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 deleted file mode 100644 index 28f22d1a..00000000 --- a/elpa/go-translate-20240802.131/gt-engine-youdao.el +++ /dev/null @@ -1,188 +0,0 @@ -;;; 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 deleted file mode 100644 index 6941181c..00000000 --- a/elpa/go-translate-20240802.131/gt-extension.el +++ /dev/null @@ -1,1175 +0,0 @@ -;;; 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 deleted file mode 100644 index 14dea12d..00000000 --- a/elpa/go-translate-20240802.131/gt-faces.el +++ /dev/null @@ -1,221 +0,0 @@ -;;; 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 deleted file mode 100644 index def4a9b2..00000000 --- a/elpa/go-translate-20240802.131/gt-httpx.el +++ /dev/null @@ -1,358 +0,0 @@ -;;; 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 deleted file mode 100644 index c2cc152f..00000000 --- a/elpa/go-translate-20240802.131/gt-text-utility.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; 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/go-translate-20250318.907/go-translate-autoloads.el b/elpa/go-translate-20250318.907/go-translate-autoloads.el new file mode 100644 index 00000000..f96edc21 --- /dev/null +++ b/elpa/go-translate-20250318.907/go-translate-autoloads.el @@ -0,0 +1,138 @@ +;;; 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-osxdict.el + +(register-definition-prefixes "gt-engine-osxdict" '("gt-osxdict-")) + + +;;; 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-20250318.907/go-translate-pkg.el b/elpa/go-translate-20250318.907/go-translate-pkg.el new file mode 100644 index 00000000..18dc69c2 --- /dev/null +++ b/elpa/go-translate-20250318.907/go-translate-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "go-translate" "20250318.907" + "Translation framework, configurable and scalable." + '((emacs "28.1")) + :url "https://github.com/lorniu/go-translate" + :commit "a924e0bd6b37d424c222377982e6f71a4ddf4452" + :revdesc "a924e0bd6b37" + :keywords '("convenience") + :authors '(("lorniu" . "lorniu@gmail.com")) + :maintainers '(("lorniu" . "lorniu@gmail.com"))) diff --git a/elpa/go-translate-20250318.907/go-translate.el b/elpa/go-translate-20250318.907/go-translate.el new file mode 100644 index 00000000..64950412 --- /dev/null +++ b/elpa/go-translate-20250318.907/go-translate.el @@ -0,0 +1,350 @@ +;;; 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: 20250318.907 +;; Package-Revision: a924e0bd6b37 + +;; 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-osxdict) +(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))) + (OSX-Dictionary . ,(gt-osxdict-engine)) + (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-20250318.907/gt-core.el b/elpa/go-translate-20250318.907/gt-core.el new file mode 100644 index 00000000..7436b0c8 --- /dev/null +++ b/elpa/go-translate-20250318.907/gt-core.el @@ -0,0 +1,1966 @@ +;;; 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 (with-temp-buffer + (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-20250318.907/gt-engine-bing.el b/elpa/go-translate-20250318.907/gt-engine-bing.el new file mode 100644 index 00000000..6d6f52df --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-chatgpt.el b/elpa/go-translate-20250318.907/gt-engine-chatgpt.el new file mode 100644 index 00000000..bc2bdf5b --- /dev/null +++ b/elpa/go-translate-20250318.907/gt-engine-chatgpt.el @@ -0,0 +1,196 @@ +;;; 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) + (path :initarg :path :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-path "/v1/chat/completions" + "API endpoint 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 path 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) (or path gt-chatgpt-path)) + :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-20250318.907/gt-engine-deepl.el b/elpa/go-translate-20250318.907/gt-engine-deepl.el new file mode 100644 index 00000000..44550c5e --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-echo.el b/elpa/go-translate-20250318.907/gt-engine-echo.el new file mode 100644 index 00000000..165de0c8 --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-google-rpc.el b/elpa/go-translate-20250318.907/gt-engine-google-rpc.el new file mode 100644 index 00000000..e2067e0f --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-google.el b/elpa/go-translate-20250318.907/gt-engine-google.el new file mode 100644 index 00000000..70c43b1f --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-libre.el b/elpa/go-translate-20250318.907/gt-engine-libre.el new file mode 100644 index 00000000..b09b7b2b --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-osxdict.el b/elpa/go-translate-20250318.907/gt-engine-osxdict.el new file mode 100644 index 00000000..a01821bc --- /dev/null +++ b/elpa/go-translate-20250318.907/gt-engine-osxdict.el @@ -0,0 +1,86 @@ +;;; gt-engine-osxdict.el --- OSX-Dictionary -*- 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 osx-dictionary (macOS only). +;; +;; osx-dictionary, a program written by itchyny, is Dictionary.app interface for macOS. +;; I know it from https://github.com/xuchunyang/osx-dictionary.el. This engine is working +;; with it, and can be used offline for macOS user. +;; +;; Make sure program `osx-dictionary' is on your PATH, or config it with `gt-osxdict-program'. +;; +;; Source: https://github.com/itchyny/dictionary.vim/tree/master/autoload/dictionary.m +;; Build: clang -framework CoreServices -framework Foundation dictionary.m -o osx-dictionary +;; +;;; Code: + +(require 'gt-extension) + +(defclass gt-osxdict-parser (gt-parser) ()) + +(defclass gt-osxdict-engine (gt-engine) + ((tag :initform 'osx-dictionary) + (program :initarg :program :initform nil :documentation "Path of osx-dictionary") + (delimiter :initform nil) + (cache :initform nil) + (parse :initform (gt-osxdict-parser)))) + +(defvar gt-osxdict-program "osx-dictionary" + "Executable command or full path of osx-dictionary.") + +(cl-defmethod gt-translate ((engine gt-osxdict-engine) task next) + (let ((program (or (oref engine program) gt-osxdict-program))) + (unless (executable-find program) + (user-error (format "[gt-osxdict-engine] Make sure executable `%s' is available'.\n + Source: https://github.com/itchyny/dictionary.vim/tree/master/autoload/dictionary.m + Build: clang -framework CoreServices -framework Foundation dictionary.m -o %s +" program program))) + (with-slots (text res) task + (when (cdr text) + (user-error "[gt-osxdict-engine] Multiple parts translation is not supported")) + (with-temp-buffer + (ignore-errors + (apply #'call-process program nil t nil text) + (setf res (buffer-string)))) + (if (string-empty-p res) (setf res nil)) + (funcall next task)))) + +(cl-defmethod gt-parse ((_ gt-osxdict-parser) task) + (with-slots (res) task + (with-temp-buffer + (insert res) + ;; This is written casually, should be improved. + ;; https://github.com/itchyny/dictionary.vim/blob/master/syntax/dictionary.vim + (cl-loop for (regexp . face) in + '(("|.+|" . font-lock-comment-face) + ("^ *▸.*" . font-lock-string-face) + ("^ *[A-Z]\\..*" . bold-italic)) + do (goto-char (point-min)) + do (while (re-search-forward regexp nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face face))) + (setf res (buffer-string))))) + +(provide 'gt-engine-osxdict) + +;;; gt-engine-osxdict.el ends here diff --git a/elpa/go-translate-20250318.907/gt-engine-stardict.el b/elpa/go-translate-20250318.907/gt-engine-stardict.el new file mode 100644 index 00000000..3ec8c0af --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-engine-youdao.el b/elpa/go-translate-20250318.907/gt-engine-youdao.el new file mode 100644 index 00000000..cde71de2 --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-extension.el b/elpa/go-translate-20250318.907/gt-extension.el new file mode 100644 index 00000000..b4bc1266 --- /dev/null +++ b/elpa/go-translate-20250318.907/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-thing-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-20250318.907/gt-faces.el b/elpa/go-translate-20250318.907/gt-faces.el new file mode 100644 index 00000000..14dea12d --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-httpx.el b/elpa/go-translate-20250318.907/gt-httpx.el new file mode 100644 index 00000000..647d8c79 --- /dev/null +++ b/elpa/go-translate-20250318.907/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-20250318.907/gt-text-utility.el b/elpa/go-translate-20250318.907/gt-text-utility.el new file mode 100644 index 00000000..c2cc152f --- /dev/null +++ b/elpa/go-translate-20250318.907/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