feat: translation works as expected

This commit is contained in:
Pavel Korytov 2022-08-21 19:51:45 +03:00
parent 8dea1499fe
commit 19fe81ea98

View file

@ -32,12 +32,14 @@
(require 'transient)
(require 'url-util)
(declare-function evil-define-key* "evil-core")
(defgroup reverso nil
"Client for the https://reverso.net translation service."
:group 'applications)
(defface reverso-highlight-face
'((t (:inherit bold)))
'((t (:inherit underline)))
"Face for highlighting selected words in translation."
:group 'reverso)
@ -46,6 +48,16 @@
"Face for highlighting errors in grammar check."
:group 'reverso)
(defface reverso-heading-face
'((t (:inherit transient-heading)))
"Face for heading in reverso buffers."
:group 'reverso)
(defface reverso-language-face
'((t (:inherit transient-value)))
"Face for language names in reverso buffers."
:group 'reverso)
(defcustom reverso-max-display-lines-in-input 5
"Maximum number of lines to display in input."
:type 'integer
@ -72,7 +84,8 @@
(russian . rus)
(ukrainian . ukr)
(turkish . tur)
(chinese . chi))
(chinese . chi)
(swedish . swe))
"Mapping from long language names to short ones.
This one is used for the translation queries.")
@ -96,22 +109,25 @@ This one is used for the translation queries.")
This one is used for the synonyms queries.")
(defconst reverso--right-to-left-languages
'(arabic hebrew)
"List of languages that are written from right to left.")
(defcustom reverso-languages (mapcar #'car reverso--language-mapping)
"Subset of languages to use."
:type `(set ,@(cl-loop for cell in reverso--language-mapping
collect (list 'const (car cell)))))
(defconst reverso--languages
'((translation . (arabic chinese dutch english french german hebrew
italian japanese korean polish portugese
romanian russian spanish swedish turkish
ukrainian))
'((translation . (arabic german english spanish french hebrew italian
japanese dutch polish portuguese romanian russian
swedish turkish ukrainian chinese))
(context . (arabic german english spanish french hebrew italian
japanese dutch polish portugese romanian
japanese dutch polish portuguese romanian
russian swedish turkish ukrainian chinese))
(grammar . (english french))
(synonyms . (arabic german english spanish french hebrew italian
japanese dutch polish portugese romanian
japanese dutch polish portuguese romanian
russian)))
"Available languages for diferent operations.")
@ -149,9 +165,72 @@ This one is used for the synonyms queries.")
japanese dutch portuguese english))
(turkish . (arabic german spanish french italian portuguese
romanian english))
(chinese . (english french spanish)))))
(chinese . (english french spanish))))
(translation
. ((arabic . (german english spanish french hebrew italian
portuguese russian turkish))
(german . (arabic english spanish french hebrew italian
japanese dutch polish portuguese romanian
russian swedish turkish ukrainian))
(english . (arabic german spanish french hebrew italian
japanese dutch polish portuguese romanian
russian swedish turkish ukrainian chinese))
(spanish . (arabic german english french hebrew italian
japanese dutch polish portuguese romanian
russian swedish turkish chinese ukrainian))
(french . (arabic german english spanish hebrew italian
japanese dutch polish portuguese romanian
russian swedish turkish chinese ukrainian))
(hebrew . (arabic german english spanish french italian dutch
portuguese russian ukrainian))
(italian . (arabic german english spanish french hebrew
japanese dutch polish portuguese romanian
russian swedish turkish ukrainian))
(japanese . (german english spanish french italian portuguese
russian ukrainian))
(dutch . (german english spanish french hebrew italian
portuguese russian ukrainian))
(polish . (german english spanish french italian ukrainian))
(portuguese . (arabic german english spanish french hebrew
italian japanese dutch russian turkish
ukrainian))
(romanian . (german english spanish french italian turkish
ukrainian))
(russian . (arabic german english spanish french hebrew italian
japanese dutch portuguese ukrainian))
(swedish . (german english spanish french italian ukrainian))
(turkish . (arabic german english spanish french italian
portuguese romanian ukrainian))
(ukrainian . (english))
(chinese . (english french spanish ukrainian)))))
"Which languages are compatible with which.")
(defun reverso-verify-settings ()
"Check if all the languages are set correctly."
(interactive)
(let ((languages (mapcar #'car reverso--language-mapping)))
(dolist (cell reverso--languages)
(dolist (lang (cdr cell))
(unless (memq lang languages)
(error "Language %s is not available (reverso--languages)" lang))))
(dolist (lang reverso-languages)
(unless (memq lang languages)
(error "Language %s is not available (reverso-languages)" lang)))
(dolist (cell-kind reverso--languages-compatible)
(dolist (cell-lang (cdr cell-kind))
(unless (memq (car cell-lang) languages)
(error
"Language %s is not available (reverso--languages-compatible)"
(car cell-lang)))
(dolist (lang (cdr cell-lang))
(unless (memq lang languages)
(error
"Language %s is not available (reverso--languages-compatible)"
lang))))))
(message "Everything is OK"))
;;; API
(defconst reverso--urls
'((translation . "https://api.reverso.net/translate/v1/translation")
(context . "https://context.reverso.net/translation/")
@ -161,13 +240,13 @@ This one is used for the synonyms queries.")
(defconst reverso--user-agents
'("Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
"Mozilla/5.0 (X11; Linux x86_64; rv:103.0) Gecko/20100101 Firefox/103.0"
"Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:103.0) Gecko/20100101 Firefox/103.0"
"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
"Mozilla/5.0 (Windows NT 10.0; rv:103.0) Gecko/20100101 Firefox/103.0"
"Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36"
"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.6 Safari/605.1.15"
"Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:103.0) Gecko/20100101 Firefox/103.0")
"Mozilla/5.0 (X11; Linux x86_64; rv:103.0) Gecko/20100101 Firefox/103.0"
"Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:103.0) Gecko/20100101 Firefox/103.0"
"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
"Mozilla/5.0 (Windows NT 10.0; rv:103.0) Gecko/20100101 Firefox/103.0"
"Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36"
"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.6 Safari/605.1.15"
"Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:103.0) Gecko/20100101 Firefox/103.0")
"User-Agents to use for reverso.el requests.
A random one is be picked at package initialization.")
@ -180,8 +259,22 @@ A random one is be picked at package initialization.")
(defun reverso--translate (text source target cb)
"Translate TEXT from language SOURCE to TARGET.
SOURCE and TARGET are keys of `reverso--languages'. CB is a function
that is called with the result."
SOURCE and TARGET are keys of `reverso--languages'. CB is called with
the result.
The result is an alist with the following keys:
- `:corrected-text': set when the text has been corrected
- `:language-from': the source language
- `:language-to': the target language
- `:detected-language': set when the detected target language is
different from the source language
- `:translation': a string with translated text
- `:context-results': a list with found contexts.
An item of the list is an alist with the keys:
- `:source': a string in the source language
- `:target': a string in the target language"
(when (string-empty-p text)
(user-error "Empty input!"))
(unless (and (alist-get source reverso--language-mapping)
(member source
(alist-get 'translation reverso--languages)))
@ -209,7 +302,8 @@ that is called with the result."
:encoding 'utf-8
:success (cl-function
(lambda (&key data &allow-other-keys)
(funcall cb (reverso--translate-parse data))))
(funcall cb (reverso--alist-remove-empty-values
(reverso--translate-parse data)))))
:error (cl-function
(lambda (&key error-thrown &allow-other-keys)
(message "Error!: %S" error-thrown)))))
@ -246,37 +340,49 @@ that are in tags with `reverso-highlight-face'"
'body)))))
(defun reverso--alist-remove-empty-values (alist)
"Remove empty values from ALIST."
(cl-loop for (key . value) in alist
if value
collect (cons key value)))
(defun reverso--alist-get-inv (alist lookup-value)
"Like `alist-get', but with `car' and `cdr' swapped."
(cl-loop for (key . value) in alist
if (equal lookup-value value)
return key))
(defun reverso--translate-parse (response)
"Convert RESPONSE from the reverso translation API into an alist."
(let ((corrected-text (alist-get 'correctedText response))
(language-from (alist-get 'from response))
(language-to (alist-get 'to response))
(detected-language (alist-get 'detectedLanguage
(alist-get 'languageDetection response)))
(translation (alist-get 'translation response))
(language-from (reverso--alist-get-inv
reverso--language-mapping
(intern (alist-get 'from response))))
(language-to (reverso--alist-get-inv
reverso--language-mapping
(intern (alist-get 'to response))))
(detected-language (reverso--alist-get-inv
reverso--language-mapping
(intern (or
(alist-get 'detectedLanguage
(alist-get 'languageDetection response))
"nil"))))
(translation (seq-elt (alist-get 'translation response) 0))
(context-results
(cl-loop for r across (alist-get 'results (alist-get 'contextResults response))
collect
`((translation . ,(alist-get 'translation r))
(context
`((:translation . ,(alist-get 'translation r))
(:context
. ,(cl-loop for source across (alist-get 'sourceExamples r)
for target across (alist-get 'targetExamples r)
collect
`((source . ,(reverso--convert-string-html source))
(target . ,(reverso--convert-string-html target)))))))))
`((corrected-text . ,corrected-text)
(language-from . ,language-from)
(language-to . ,language-to)
(detected-language
. ,(when (and detected-language
(not (string= detected-language language-from)))
detected-language))
(translation . ,translation)
(context-results . ,context-results))))
`((:source . ,(reverso--convert-string-html source))
(:target . ,(reverso--convert-string-html target)))))))))
`((:corrected-text . ,corrected-text)
(:language-from . ,language-from)
(:language-to . ,language-to)
(:detected-language . ,detected-language)
(:translation . ,translation)
(:context-results . ,context-results))))
(defun reverso--get-context (text source target cb)
"Do a context translation for TEXT from SOURCE to TARGET.
@ -326,8 +432,8 @@ DATA is an html string."
when (string-match-p (rx "example") classes)
collect (let ((src (dom-by-class (dom-by-class child "src") "text"))
(trg (dom-by-class (dom-by-class child "trg") "text")))
`((source . ,(reverso--convert-string src))
(target . ,(reverso--convert-string trg))))))))
`((:source . ,(reverso--convert-string src))
(:target . ,(reverso--convert-string trg))))))))
(defun reverso--get-synomyms (text language cb)
"Get synomyms for TEXT in LANGUAGE.
@ -445,6 +551,150 @@ HTML is a string."
(source-text . ,source-text-hl)
(corrections . ,corrections))))
;;; Buffers
(defvar reverso-result-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") (lambda ()
(interactive)
(quit-window t)))
(when (fboundp #'evil-define-key*)
(evil-define-key* '(normal motion) map
"q" (lambda ()
(interactive)
(quit-window t))))
map)
"Keymap used in `reverso-result-mode' buffers.")
(defvar-local reverso--input nil
"Displayed input for `reverso'.")
(defvar-local reverso--output nil
"Displayed output for `reverso'.")
(defvar-local reverso--data nil
"Received data for `reverso'.")
(define-derived-mode reverso-result-mode special-mode "Reverso results"
"Major mode to display results of `reverso'."
:group 'reverso)
(defun reverso--translate-render (text data)
"Render the translation results.
DATA is an alist as defined in `reverso--translate'. TEXT is the
source text."
(let ((multiline (string-match-p "\n" text)))
(insert (propertize
(symbol-name (alist-get :language-from data))
'face 'reverso-language-face)
" -> "
(propertize
(symbol-name (alist-get :language-to data))
'face 'reverso-language-face))
(when (alist-get :detected-language data)
(insert " [detected: "
(propertize
(symbol-name (alist-get :detected-language data))
'face 'reverso-language-face)
"]"))
(insert "\n\n")
(insert (propertize
"Source text: "
'face 'reverso-heading-face))
(when multiline
(insert "\n")
(when (memq (alist-get :language-from data)
reverso--right-to-left-languages)
(insert "\n")))
(insert text "\n\n")
(setq-local reverso--input text)
(when (alist-get :corrected-text data)
(insert (propertize
"Corrected text: "
'face 'reverso-heading-face))
(when (memq (alist-get :language-from data)
reverso--right-to-left-languages)
(insert "\n"))
(insert (alist-get :corrected-text data) "\n\n"))
(if (alist-get :translation data)
(progn
(setq-local reverso--output (alist-get :translation data))
(insert
(propertize
"Translation: "
'face 'reverso-heading-face))
(when multiline
(insert "\n")
(when (memq (alist-get :language-to data)
reverso--right-to-left-languages)
(insert "\n")))
(insert (alist-get :translation data) "\n\n"))
(insert "No results!"))
(when (alist-get :context-results data)
(insert (propertize
"Context results: "
'face 'reverso-heading-face)
"\n")
(cl-loop for result in (alist-get :context-results data)
for translation = (alist-get :translation result)
when (not (string-empty-p translation))
do (insert
(propertize
translation
'face 'reverso-highlight-face)
"\n")
do (reverso--context-render-list
(alist-get :context result)
(alist-get :language-from data)
(or (alist-get :detected-language data)
(alist-get :language-to data)))))))
(defun reverso--context-render-list (data lang-to lang-from)
"Render the context results."
(cl-loop with lang-to-name = (symbol-name lang-to)
with lang-from-name = (symbol-name lang-from)
with lang-length = (max (length lang-to-name) (length lang-from-name))
for datum in data
for source = (alist-get :source datum)
for target = (alist-get :target datum)
do (insert (propertize
(format (format "%%-%ds: " lang-length) lang-to-name)
'face 'reverso-language-face)
source "\n"
(propertize
(format (format "%%%ds: " lang-length) lang-from-name)
'face 'reverso-language-face)
target "\n\n")))
(defun reverso--translate-render-brief (text data)
(setq-local reverso--input text)
(if (alist-get :translation data)
(progn
(setq-local reverso--output (alist-get :translation data))
(insert (alist-get :translation data)))
(insert "No results!")))
(defmacro reverso--with-buffer (&rest body)
"Execute BODY in the clean `reverso' results buffer."
(declare (indent 0))
`(progn
(let ((buffer (get-buffer-create
(generate-new-buffer-name "*Reverso*"))))
(with-current-buffer buffer
(unless (derived-mode-p 'reverso-result-mode)
(reverso-result-mode))
(let ((inhibit-read-only t))
(erase-buffer)
,@body)
(goto-char (point-min)))
(switch-to-buffer-other-window buffer))))
;;; Transient
(defclass reverso--transient-input (transient-infix)
((format :initform " %k %d: %v"))
"Class used for retrieving the input string.")
@ -457,7 +707,10 @@ HTML is a string."
((region-active-p)
(buffer-substring-no-properties (region-beginning) (region-end)))
((equal current-prefix-arg '(4))
(buffer-substring-no-properties (point-min) (point-max)))
(if reverso--output
reverso--output
(buffer-substring-no-properties (point-min) (point-max))))
(reverso--input reverso--input)
(t ""))))
(cl-defmethod transient-infix-read ((obj reverso--transient-input))
@ -491,6 +744,7 @@ HTML is a string."
(defclass reverso--transient-language (transient-infix)
((format :initform " %k %d %v")
(languages :initarg :languages :initform nil)
(target-languages :initarg :target-languages :initform nil)
(is-target :initarg :is-target :initform nil))
"Class used for switching the language.")
@ -498,7 +752,9 @@ HTML is a string."
(defvar reverso--target-value nil)
(defun reverso--get-available-languages (obj &optional is-target)
(defvar reverso--prefer-brief nil)
(defun reverso--get-available-languages (obj &optional target-languages-list is-target)
(let* ((all-languages
(seq-sort
(lambda (a b) (string-lessp (symbol-name a)
@ -508,6 +764,8 @@ HTML is a string."
(source-language (when is-target
(or reverso--source-value
(car all-languages))))
(target-languages (when (and is-target target-languages-list)
(alist-get source-language target-languages-list)))
(languages (cl-loop for lang in all-languages
if (or (not source-language)
(not (eq source-language lang)))
@ -515,7 +773,10 @@ HTML is a string."
(seq-sort
(lambda (a b) (string-lessp (symbol-name a)
(symbol-name b)))
(seq-intersection languages reverso-languages))))
(let ((intersection-1 (seq-intersection languages reverso-languages)))
(if (not target-languages)
intersection-1
(seq-intersection intersection-1 target-languages))))))
(defun reverso--get-language-variable (obj)
(if (oref obj is-target)
@ -530,7 +791,9 @@ HTML is a string."
((and (symbol-value (reverso--get-language-variable obj)))
(symbol-value (reverso--get-language-variable obj)))
(t (car (reverso--get-available-languages
obj (oref obj is-target)))))))
obj
(oref obj target-languages)
(oref obj is-target)))))))
(set (reverso--get-language-variable obj) value)
(oset obj value value)))
@ -544,12 +807,18 @@ HTML is a string."
(if (eq choice value)
'transient-value
'transient-inactive-value)))
(reverso--get-available-languages obj (oref obj is-target))
(reverso--get-available-languages
obj
(oref obj target-languages)
(oref obj is-target))
(propertize "|" 'face 'transient-inactive-value))
(propertize "]" 'face 'transient-inactive-value))))
(cl-defmethod transient-infix-read ((obj reverso--transient-language))
(let* ((choices (reverso--get-available-languages obj (oref obj is-target)))
(let* ((choices (reverso--get-available-languages
obj
(oref obj target-languages)
(oref obj is-target)))
(current-idx (or (cl-position (oref obj value) choices) -1))
(next-idx (% (1+ current-idx) (length choices)))
(next-choice
@ -566,15 +835,29 @@ HTML is a string."
next-choice))
(cl-defmethod transient-infix-value ((obj reverso--transient-language))
(let* ((choices (reverso--get-available-languages obj (oref obj is-target)))
(let* ((choices (reverso--get-available-languages
obj
(oref obj target-languages)
(oref obj is-target)))
(current-idx (or (cl-position (oref obj value) choices) -1)))
(nth current-idx choices)))
(transient-define-infix reverso--input ()
(defclass reverso--transient-brief (transient-switch) ()
"Toggle brief output.")
(cl-defmethod transient-init-value ((obj reverso--transient-brief))
(oset obj value reverso--prefer-brief))
(cl-defmethod transient-infix-read ((obj reverso--transient-brief))
"Toggle the switch on or off."
(setq reverso--prefer-brief
(null (oref obj value))))
(transient-define-infix reverso--transient-input-infix ()
:class 'reverso--transient-input
:description "Input")
(transient-define-infix reverso--translate-source ()
(transient-define-infix reverso--transient-translate-language-source ()
:class 'reverso--transient-language
:description "Source language"
:key "s"
@ -582,15 +865,16 @@ HTML is a string."
:argument "-s"
:languages (alist-get 'translation reverso--languages))
(transient-define-infix reverso--translate-target ()
(transient-define-infix reverso--transient-translate-language-target ()
:class 'reverso--transient-language
:description "Target language"
:key "t"
:argument "-t"
:languages (alist-get 'translation reverso--languages)
:target-languages (alist-get 'translation reverso--languages-compatible)
:is-target t)
(transient-define-suffix reverso--swap-languages ()
(transient-define-suffix reverso--transient-swap-languages ()
:transient t
:key "S"
:description "Swap languages"
@ -611,16 +895,36 @@ HTML is a string."
(setq reverso--source-value target-value)
(setq reverso--target-value source-value)))
(transient-define-infix reverso--transient-breif-infix ()
:transient t
:class 'reverso--transient-brief
:key "b"
:argument "--brief"
:description "Brief translation output")
(transient-define-suffix reverso--translate-exec-suffix (input source target &optional is-brief)
:key "e"
:description "Translate"
(interactive (transient-args transient-current-command))
(reverso--translate
input source target
(lambda (data)
(reverso--with-buffer
(if is-brief
(reverso--translate-render-brief input data)
(reverso--translate-render input data))
(setq-local reverso--data data)))))
(transient-define-prefix reverso-translate ()
["Input"
("i" "Input" reverso--input)]
("i" "Input" reverso--transient-input-infix)]
["Parameters"
(reverso--translate-source)
(reverso--translate-target)
(reverso--swap-languages)]
(reverso--transient-translate-language-source)
(reverso--transient-translate-language-target)
(reverso--transient-swap-languages)
(reverso--transient-breif-infix)]
["Actions"
("t" "Test" (lambda () (interactive)
(setq my/test (transient-args transient-current-command))))
(reverso--translate-exec-suffix)
("q" "Quit" transient-quit-one)])
(provide 'reverso)