mirror of
https://github.com/SqrtMinusOne/reverso.el.git
synced 2025-12-10 15:53:02 +03:00
1077 lines
42 KiB
EmacsLisp
1077 lines
42 KiB
EmacsLisp
;;; reverso.el --- Client for the https://reverso.net translation service -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2022 Korytov Pavel
|
|
|
|
;; Author: Korytov Pavel <thexcloud@gmail.com>
|
|
;; Maintainer: Korytov Pavel <thexcloud@gmail.com>
|
|
;; Version: 0.1.0
|
|
;; Package-Requires: ((emacs "27.1") (transient "0.3.7") (request "0.3.2"))
|
|
;; Homepage: https://github.com/SqrtMinusOne/reverso.el
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; 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 <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; TODO
|
|
|
|
;;; Code:
|
|
(require 'request)
|
|
(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 underline)))
|
|
"Face for highlighting selected words in translation."
|
|
:group 'reverso)
|
|
|
|
(defface reverso-error-face
|
|
'((t (:inherit error)))
|
|
"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
|
|
:group 'reverso)
|
|
|
|
(defcustom reverso-language-completing-read-threshold 4
|
|
"Minimum number of languages to choose with `completing-read'."
|
|
:type 'integer
|
|
:group 'reverso)
|
|
|
|
(defconst reverso--language-mapping
|
|
'((english . eng)
|
|
(german . ger)
|
|
(spanish . spa)
|
|
(arabic . ara)
|
|
(french . fra)
|
|
(hebrew . heb)
|
|
(italian . ita)
|
|
(japanese . jpn)
|
|
(dutch . dut)
|
|
(polish . pol)
|
|
(portuguese . por)
|
|
(romanian . rum)
|
|
(russian . rus)
|
|
(ukrainian . ukr)
|
|
(turkish . tur)
|
|
(chinese . chi)
|
|
(swedish . swe))
|
|
"Mapping from long language names to short ones.
|
|
|
|
This one is used for the translation queries.")
|
|
|
|
(defconst reverso--language-mapping-1
|
|
'((english . en)
|
|
(german . de)
|
|
(arabic . ar)
|
|
(french . fr)
|
|
(spanish . es)
|
|
(french . fr)
|
|
(hebrew . he)
|
|
(italian . it)
|
|
(japanese . ja)
|
|
(dutch . nl)
|
|
(polish . pl)
|
|
(portuguese . pt)
|
|
(romanian . ro)
|
|
(russian . ru))
|
|
"Mapping from long language names to short ones.
|
|
|
|
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 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 portuguese romanian
|
|
russian swedish turkish ukrainian chinese))
|
|
(grammar . (english french))
|
|
(synonyms . (arabic german english spanish french hebrew italian
|
|
japanese dutch polish portuguese romanian
|
|
russian)))
|
|
"Available languages for diferent operations.")
|
|
|
|
|
|
(defconst reverso--languages-compatible
|
|
`((context
|
|
. ((arabic . (english german spanish french hebrew italian
|
|
portuguese russian turkish ukrainian))
|
|
(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 ukraninan chinese))
|
|
(spanish . (arabic german english french hebrew italian
|
|
japanese dutch polish portuguese romanian
|
|
russian swedish turkish chinese ukrainian))
|
|
(french . (arabic german spanish english 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))))
|
|
(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/")
|
|
(grammar . "https://orthographe.reverso.net/api/v1/Spelling")
|
|
(synomyms . "https://synonyms.reverso.net/synonym/"))
|
|
"URLs with reverso endpoints.")
|
|
|
|
(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")
|
|
"User-Agents to use for reverso.el requests.
|
|
|
|
A random one is be picked at package initialization.")
|
|
|
|
(defvar reverso--user-agent
|
|
(nth (random (length reverso--user-agents))
|
|
reverso--user-agents)
|
|
"User-Agent to use for reverse.el requests.")
|
|
|
|
(defun reverso--translate (text source target cb)
|
|
"Translate TEXT from language SOURCE to TARGET.
|
|
|
|
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)))
|
|
(error "Wrong language: %s" source))
|
|
(unless (and (alist-get target reverso--language-mapping)
|
|
(member source
|
|
(alist-get 'translation reverso--languages)))
|
|
(error "Wrong language: %s" target))
|
|
(unless (member target
|
|
(alist-get source
|
|
(alist-get 'translation reverso--languages-compatible)))
|
|
(error "Language %s is not compatible with %s" target source))
|
|
(request (alist-get 'translation reverso--urls)
|
|
:type "POST"
|
|
:data (json-encode
|
|
`((format . "text")
|
|
(from . ,(alist-get source reverso--language-mapping))
|
|
(input . ,text)
|
|
(options . ((contextResults . t)
|
|
(languageDetection . t)
|
|
(origin . "reversomobile")
|
|
(sentenceSpliiter . :json-false)))
|
|
(to . ,(alist-get target reverso--language-mapping))))
|
|
:headers `(("Content-Type" . "application/json")
|
|
("Accept" . "*/*")
|
|
("Connection" . "keep-alive")
|
|
("User-Agent" . ,reverso--user-agent))
|
|
:parser 'json-read
|
|
:encoding 'utf-8
|
|
:success (cl-function
|
|
(lambda (&key data &allow-other-keys)
|
|
(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)))))
|
|
|
|
(defun reverso--convert-string (dom)
|
|
"Convert html DOM from the reverso API to fontified string.
|
|
|
|
reverso.net uses tags to highlight relevant works, e.g. <em> for the
|
|
selected word in the context search. This function fontifies words
|
|
that are in tags with `reverso-highlight-face'"
|
|
(thread-last
|
|
(mapconcat (lambda (node)
|
|
(let ((text (if (listp node) (dom-texts node) node))
|
|
(is-special (listp node)))
|
|
(if is-special
|
|
(propertize text 'face 'reverso-highlight-face)
|
|
text)))
|
|
(dom-children dom)
|
|
"")
|
|
(string-trim)
|
|
(replace-regexp-in-string
|
|
(rx (+ (syntax whitespace))",") ",")
|
|
(replace-regexp-in-string
|
|
(rx (+ (syntax whitespace))) " ")))
|
|
|
|
(defun reverso--convert-string-html (html)
|
|
"Convert HTML string from the reverso API to fontified string."
|
|
(with-temp-buffer
|
|
(insert "<html><body>" html "<body></html>")
|
|
(reverso--convert-string
|
|
(car
|
|
(dom-by-tag
|
|
(libxml-parse-html-region (point-min) (point-max))
|
|
'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.
|
|
|
|
ALIST is an alist, LOOKUP-VALUE is a value to look in `cdr'."
|
|
(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 (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
|
|
. ,(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 . ,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.
|
|
|
|
SOURCE and TARGET are keys of `reverso--languages'. CB is called with
|
|
the result.
|
|
|
|
The result is a list of alists with the keys:
|
|
- `:source': string in the source language
|
|
- `:target': string in the target language"
|
|
(unless (and (alist-get source reverso--language-mapping)
|
|
(member source
|
|
(alist-get 'context reverso--languages)))
|
|
(error "Wrong language: %s" source))
|
|
(unless (and (alist-get target reverso--language-mapping)
|
|
(member source
|
|
(alist-get 'context reverso--languages)))
|
|
(error "Wrong language: %s" target))
|
|
(unless (member target
|
|
(alist-get source
|
|
(alist-get 'context reverso--languages-compatible)))
|
|
(error "Language %s is not compatible with %s" target source))
|
|
(request (concat (alist-get 'context reverso--urls)
|
|
(symbol-name source) "-" (symbol-name target) "/"
|
|
(replace-regexp-in-string
|
|
"%20" "+" (url-hexify-string text) t t))
|
|
:type "GET"
|
|
:headers `(("Accept" . "*/*")
|
|
("Connection" . "keep-alive")
|
|
("User-Agent" . ,reverso--user-agent))
|
|
:parser 'buffer-string
|
|
:encoding 'utf-8
|
|
:success (cl-function
|
|
(lambda (&key data &allow-other-keys)
|
|
(funcall cb (reverso--alist-remove-empty-values
|
|
(reverso--get-context-parse data)))))
|
|
:error (cl-function
|
|
(lambda (&key error-thrown &allow-other-keys)
|
|
(message "Error!: %S" error-thrown)))))
|
|
|
|
(defun reverso--get-context-parse (data)
|
|
"Parse response from reverso context API into an alist.
|
|
|
|
DATA is an html string."
|
|
(let ((html (with-temp-buffer
|
|
(insert data)
|
|
(libxml-parse-html-region (point-min) (point-max)))))
|
|
(let ((examples (dom-by-id html "examples-content")))
|
|
(cl-loop for child in (dom-non-text-children examples)
|
|
for classes = (alist-get 'class (dom-attributes child))
|
|
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))))))))
|
|
|
|
(defun reverso--get-synomyms (text language cb)
|
|
"Get synomyms for TEXT in LANGUAGE.
|
|
|
|
CB is called with the result.
|
|
|
|
The result is a list of alists with the following keys:
|
|
- `:kind': part of speech
|
|
- `:synonyms': list of alists:
|
|
- `:synonym': word
|
|
- `:relevant': if t considered a \"good match\" by the service
|
|
- `:examples': list of strings with examples
|
|
- `:antonyms': list of alists
|
|
- `:antonym': word"
|
|
(unless (alist-get language reverso--language-mapping-1)
|
|
(error "Wrong language: %s" language))
|
|
(request (concat (alist-get 'synomyms reverso--urls)
|
|
(symbol-name (alist-get language reverso--language-mapping-1)) "/"
|
|
(url-hexify-string text))
|
|
:type "GET"
|
|
:headers `(("Accept" . "*/*")
|
|
("Connection" . "keep-alive")
|
|
("User-Agent" . ,reverso--user-agent))
|
|
:parser 'buffer-string
|
|
:encoding 'utf-8
|
|
:success (cl-function
|
|
(lambda (&key data &allow-other-keys)
|
|
(funcall cb (reverso--alist-remove-empty-values
|
|
(reverso--get-synomyms-parse data)))))
|
|
:error (cl-function
|
|
(lambda (&key error-thrown &allow-other-keys)
|
|
(message "Error!: %S" error-thrown)))))
|
|
|
|
(defun reverso--get-synomyms-parse (html)
|
|
"Parse the reverso synomyms page.
|
|
|
|
HTML is a string."
|
|
(let* ((dom (with-temp-buffer
|
|
(insert html)
|
|
(libxml-parse-html-region (point-min) (point-max)))))
|
|
(cl-loop
|
|
for child in (dom-non-text-children
|
|
(dom-by-id (dom-by-tag dom 'body) "synonyms"))
|
|
if (string-match-p "wrap-hold-prop" (or (dom-attr child 'class) ""))
|
|
collect
|
|
`((:kind . ,(string-trim (dom-texts (dom-by-class child "words-options"))))
|
|
(:synonyms
|
|
. ,(cl-loop
|
|
for synonym in (dom-non-text-children
|
|
(dom-by-class (car (dom-by-class child "word-opt"))
|
|
"word-box"))
|
|
for a = (car (dom-by-tag synonym 'a))
|
|
collect
|
|
`((:synonym . ,(string-trim (dom-texts synonym)))
|
|
(:relevant
|
|
. ,(and (string-match-p "relevant" (or (dom-attr a 'class) "")) t)))))
|
|
(:examples
|
|
. ,(cl-loop
|
|
for example in (dom-non-text-children
|
|
(dom-by-class child "phrases-examples"))
|
|
for span = (car (dom-by-tag example 'span))
|
|
if span
|
|
collect (reverso--convert-string span)))
|
|
(:antonyms
|
|
. ,(cl-loop
|
|
for antonym in (dom-non-text-children
|
|
(dom-by-class (car (dom-by-class child "antonyms-wrapper"))
|
|
"word-box"))
|
|
for a = (car (dom-by-tag antonym 'a))
|
|
for text = (string-trim (dom-texts antonym))
|
|
unless (string-match-p (rx "...") text)
|
|
collect
|
|
`((:antonym . ,text))))))))
|
|
|
|
(defun reverso--get-grammar (text language cb)
|
|
(unless (member language (alist-get 'grammar reverso--languages))
|
|
(error "Wrong language: %s" language))
|
|
(request (concat (alist-get 'grammar reverso--urls)
|
|
"?text=" (url-hexify-string text)
|
|
"&language=" (symbol-name
|
|
(alist-get language reverso--language-mapping))
|
|
"&getCorrectionDetails=true")
|
|
:type "GET"
|
|
:headers `(("Accept" . "*/*")
|
|
("Connection" . "keep-alive")
|
|
("User-Agent" . ,reverso--user-agent))
|
|
:parser 'json-read
|
|
:encoding 'utf-8
|
|
:success (cl-function
|
|
(lambda (&key data &allow-other-keys)
|
|
(funcall cb (reverso--alist-remove-empty-values
|
|
(reverso--get-grammar-parse text data)))))
|
|
:error (cl-function
|
|
(lambda (&key error-thrown &allow-other-keys)
|
|
(message "Error!: %S" error-thrown)))))
|
|
|
|
(defun reverso--get-grammar-parse (source-text data)
|
|
(let* ((corrected-text (alist-get 'text data))
|
|
(source-text-hl
|
|
(with-temp-buffer
|
|
(insert source-text)
|
|
(cl-loop for corr across (alist-get 'corrections data)
|
|
if (alist-get 'startIndex corr)
|
|
do (put-text-property (alist-get 'startIndex corr)
|
|
(alist-get 'endIndex corr)
|
|
'face 'reverso-error-face))
|
|
(buffer-string)))
|
|
(corrections
|
|
(cl-loop
|
|
for corr across (alist-get 'corrections data)
|
|
collect `((type . ,(alist-get 'type corr))
|
|
(short-description . ,(alist-get 'shortDescription corr))
|
|
(long-description . ,(alist-get 'longDescription corr))
|
|
(mistake-text . ,(alist-get 'mistakeText corr))
|
|
(correction-text . ,(alist-get 'correctionText corr))
|
|
(correction-defition . ,(alist-get 'correctionDefinition corr))
|
|
(suggestions
|
|
. ,(cl-loop for s across (alist-get 'suggestions corr)
|
|
collect
|
|
`((text . ,(alist-get 'text s))
|
|
(definition . ,(alist-get 'definition s))
|
|
(category . ,(alist-get 'category s)))))))))
|
|
`((corrected-text . ,corrected-text)
|
|
(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-to data)
|
|
(or (alist-get :detected-language data)
|
|
(alist-get :language-from data)))))))
|
|
|
|
(defun reverso--context-render-list (data lang-to lang-from)
|
|
"Render a list of context translation results.
|
|
|
|
DATA is a list of alists with the following keys:
|
|
- `:source': string in the source language (LANG-FROM)
|
|
- `:target': string in the target language (LANG-TO)"
|
|
(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)
|
|
"Render the translation results in brief format.
|
|
|
|
DATA is an alist as defined in `reverso--translate'. TEXT is the
|
|
source text."
|
|
(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!")))
|
|
|
|
(defun reverso--context-render (input data lang-to lang-from)
|
|
"Render context translation results.
|
|
|
|
INPUT is the input string. DATA is a list as defined in
|
|
`reverso--get-context'. LANG-TO and LANG-FROM and the target and
|
|
source languages."
|
|
(setq-local reverso--input input)
|
|
(insert (propertize
|
|
"Context results: "
|
|
'face 'reverso-heading-face)
|
|
"\n")
|
|
(reverso--context-render-list data lang-to lang-from))
|
|
|
|
(defun reverso--synonyms-render (input data)
|
|
"Render synonym search results.
|
|
|
|
INPUT is the input string. DATA is a list as defined in
|
|
`reverso--get-synomyms'."
|
|
(setq-local reverso--input input)
|
|
(setq my/test data)
|
|
(dolist (datum data)
|
|
(when (alist-get :kind datum)
|
|
(insert (propertize
|
|
"Part of speech: "
|
|
'face 'reverso-language-face)
|
|
(alist-get :kind datum)
|
|
"\n"))
|
|
(when (alist-get :synonyms datum)
|
|
(insert (propertize
|
|
"Synomyms: "
|
|
'face 'reverso-heading-face)
|
|
"\n")
|
|
(dolist (synonym (alist-get :synonyms datum))
|
|
(when (alist-get :relevant synonym)
|
|
(insert "- " (alist-get :synonym synonym) "\n")))
|
|
(insert "\n"))
|
|
(when (alist-get :examples datum)
|
|
(insert (propertize
|
|
"Examples: "
|
|
'face 'reverso-heading-face)
|
|
"\n")
|
|
(dolist (example (alist-get :examples datum))
|
|
(insert example "\n"))
|
|
(insert "\n"))
|
|
(when (alist-get :antonyms datum)
|
|
(insert (propertize
|
|
"Antonyms: "
|
|
'face 'reverso-heading-face)
|
|
"\n")
|
|
(dolist (antonym (alist-get :antonyms datum))
|
|
(insert "- " (alist-get :antonym antonym) "\n"))
|
|
(insert "\n"))))
|
|
|
|
(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.")
|
|
|
|
(cl-defmethod transient-init-value ((obj reverso--transient-input))
|
|
(oset obj value
|
|
(cond
|
|
((and (slot-boundp obj 'value) (oref obj value))
|
|
(oref obj value))
|
|
((region-active-p)
|
|
(buffer-substring-no-properties (region-beginning) (region-end)))
|
|
((equal current-prefix-arg '(4))
|
|
(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))
|
|
(read-from-minibuffer "Input: " (oref obj value)))
|
|
|
|
(cl-defmethod transient-format-value ((obj reverso--transient-input))
|
|
(propertize
|
|
(with-temp-buffer
|
|
(insert (oref obj value))
|
|
(goto-char (point-min))
|
|
(let ((lines (count-lines (point-min) (point-max))))
|
|
(cond
|
|
((= (buffer-size) 0) "(empty)")
|
|
((= lines 1) (buffer-string))
|
|
((> lines reverso-max-display-lines-in-input)
|
|
(concat
|
|
"\n"
|
|
(buffer-substring
|
|
(point-min)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(forward-line (1- reverso-max-display-lines-in-input))
|
|
(point)))
|
|
"\n... (truncated "
|
|
(number-to-string
|
|
(- lines reverso-max-display-lines-in-input))
|
|
" more lines)"))
|
|
(t (concat "\n" (buffer-string))))))
|
|
'face 'transient-value))
|
|
|
|
(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.")
|
|
|
|
(defvar reverso--source-value nil)
|
|
|
|
(defvar reverso--target-value nil)
|
|
|
|
(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)
|
|
(symbol-name b)))
|
|
(or (oref obj languages)
|
|
(mapcar #'car reverso--language-mapping))))
|
|
(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)))
|
|
collect lang)))
|
|
(seq-sort
|
|
(lambda (a b) (string-lessp (symbol-name a)
|
|
(symbol-name b)))
|
|
(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)
|
|
'reverso--target-value
|
|
'reverso--source-value))
|
|
|
|
(cl-defmethod transient-init-value ((obj reverso--transient-language))
|
|
(let ((value
|
|
(cond
|
|
((and (slot-boundp obj 'value) (oref obj value))
|
|
(oref obj value))
|
|
((and (symbol-value (reverso--get-language-variable obj)))
|
|
(symbol-value (reverso--get-language-variable obj)))
|
|
(t (car (reverso--get-available-languages
|
|
obj
|
|
(oref obj target-languages)
|
|
(oref obj is-target)))))))
|
|
(set (reverso--get-language-variable obj) value)
|
|
(oset obj value value)))
|
|
|
|
(cl-defmethod transient-format-value ((obj reverso--transient-language))
|
|
(let ((value (transient-infix-value obj)))
|
|
(concat
|
|
(propertize "[" 'face 'transient-inactive-value)
|
|
(mapconcat
|
|
(lambda (choice)
|
|
(propertize (symbol-name choice) 'face
|
|
(if (eq choice value)
|
|
'transient-value
|
|
'transient-inactive-value)))
|
|
(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 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
|
|
(if (> (length choices) reverso-language-completing-read-threshold)
|
|
(let ((lang (intern
|
|
(completing-read
|
|
"Language: "
|
|
(mapcar #'symbol-name choices) nil t))))
|
|
(unless (member lang choices)
|
|
(user-error "Bad language: %s" lang))
|
|
lang)
|
|
(nth next-idx choices))))
|
|
(set (reverso--get-language-variable obj) next-choice)
|
|
next-choice))
|
|
|
|
(cl-defmethod transient-infix-value ((obj reverso--transient-language))
|
|
(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)))
|
|
|
|
(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--transient-translate-language-source ()
|
|
:class 'reverso--transient-language
|
|
:description "Source language"
|
|
:key "s"
|
|
;; XXX not sure why `:argument' is necessary :(
|
|
:argument "-s"
|
|
:languages (alist-get 'translation reverso--languages))
|
|
|
|
(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--transient-swap-languages ()
|
|
:transient t
|
|
:key "S"
|
|
:description "Swap languages"
|
|
(interactive)
|
|
(let* ((suffixes (transient-suffixes transient-current-command))
|
|
(source (seq-find (lambda (suffix)
|
|
(and (reverso--transient-language-p suffix)
|
|
(not (oref suffix is-target))))
|
|
suffixes))
|
|
(target (seq-find (lambda (suffix)
|
|
(and (reverso--transient-language-p suffix)
|
|
(oref suffix is-target)))
|
|
suffixes))
|
|
(source-value (transient-infix-value source))
|
|
(target-value (transient-infix-value target)))
|
|
(oset source value target-value)
|
|
(oset target value source-value)
|
|
(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))))))
|
|
|
|
(transient-define-prefix reverso-translate ()
|
|
["Input"
|
|
("i" "Input" reverso--transient-input-infix)]
|
|
["Parameters"
|
|
(reverso--transient-translate-language-source)
|
|
(reverso--transient-translate-language-target)
|
|
(reverso--transient-swap-languages)
|
|
(reverso--transient-breif-infix)]
|
|
["Actions"
|
|
(reverso--translate-exec-suffix)
|
|
("q" "Quit" transient-quit-one)])
|
|
|
|
(transient-define-infix reverso--transient-context-language-source ()
|
|
:class 'reverso--transient-language
|
|
:description "Source language"
|
|
:key "s"
|
|
:argument "-s"
|
|
:languages (alist-get 'context reverso--languages))
|
|
|
|
(transient-define-infix reverso--transient-context-language-target ()
|
|
:class 'reverso--transient-language
|
|
:description "Target language"
|
|
:key "t"
|
|
:argument "-t"
|
|
:languages (alist-get 'translation reverso--languages)
|
|
:target-languages (alist-get 'context reverso--languages-compatible)
|
|
:is-target t)
|
|
|
|
(transient-define-suffix reverso--context-exec-suffix (input source target)
|
|
:key "e"
|
|
:description "Find context"
|
|
(interactive (transient-args transient-current-command))
|
|
(reverso--get-context
|
|
input source target
|
|
(lambda (data)
|
|
(reverso--with-buffer
|
|
(reverso--context-render input data source target)
|
|
(setq-local reverso--data data)))))
|
|
|
|
(transient-define-prefix reverso-context ()
|
|
["Input"
|
|
("i" "Input" reverso--transient-input-infix)]
|
|
["Parameters"
|
|
(reverso--transient-context-language-source)
|
|
(reverso--transient-context-language-target)
|
|
(reverso--transient-swap-languages)]
|
|
["Actions"
|
|
(reverso--context-exec-suffix)
|
|
("q" "Quit" transient-quit-one)])
|
|
|
|
(transient-define-infix reverso--transient-synonyms-language ()
|
|
:class 'reverso--transient-language
|
|
:description "Language"
|
|
:key "s"
|
|
:argument "-s"
|
|
:languages (alist-get 'synonyms reverso--languages))
|
|
|
|
(transient-define-suffix reverso--synonyms-exec-suffix (input source)
|
|
:key "e"
|
|
:description "Find synonyms"
|
|
(interactive (transient-args transient-current-command))
|
|
(reverso--get-synomyms
|
|
input source
|
|
(lambda (data)
|
|
(reverso--with-buffer
|
|
(reverso--synonyms-render input data)
|
|
(setq-local reverso--data data)))))
|
|
|
|
(transient-define-prefix reverso-synonyms ()
|
|
["Input"
|
|
("i" "Input" reverso--transient-input-infix)]
|
|
["Parameters"
|
|
(reverso--transient-synonyms-language)]
|
|
["Actions"
|
|
(reverso--synonyms-exec-suffix)
|
|
("q" "Quit" transient-quit-one)])
|
|
|
|
(provide 'reverso)
|
|
;;; reverso.el ends here
|