├── .gitignore ├── LICENSE ├── NEWS ├── README-zh.org ├── README.org ├── go-translate.el ├── gt-core.el ├── gt-engine-bing.el ├── gt-engine-chatgpt.el ├── gt-engine-deepl.el ├── gt-engine-echo.el ├── gt-engine-google-rpc.el ├── gt-engine-google.el ├── gt-engine-libre.el ├── gt-engine-osxdict.el ├── gt-engine-stardict.el ├── gt-engine-youdao.el ├── gt-extension.el ├── gt-faces.el ├── gt-httpx.el ├── gt-tests.el └── gt-text-utility.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | {one line to give the program's name and a brief idea of what it does.} 635 | Copyright (C) {year} {name of author} 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | {project} Copyright (C) {year} {fullname} 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | Version 3.0.10 2 | - Add new engine `gt-osxdict-engine`, translating with Dictionary.app 3 | 4 | Version 3.0.9 5 | - Reimplement http-clients to separate file `gt-httpx.el` 6 | - Make http client supporting both download/upload and so on 7 | 8 | Version 3.0.8 9 | - Remove compact code, no longer support v2 10 | 11 | Version 3.0.7 12 | - Abstract trait `gt-validator` to make taker/render support :if slot 13 | 14 | Version 3.0.6 15 | - Add support for LibreTranslate (`gt-libre-engine`) 16 | 17 | Version 3.0.5 18 | - Add streaming support for ChatGPT engine and Buffer/Posframe/Insert-Render. 19 | 20 | Version 3.0.4 21 | - Add new engine `gt-engine-chatgpt`. 22 | 23 | Version 3.0.3 24 | - Add component `gt-text-utility`, integrated text encode/decode, qrcode and others 25 | 26 | Version 3.0.2 27 | - Improve `gt-stardict-engine` with a better parser 28 | - Update the options and commands used by `gt-stardict-engine` 29 | 30 | Version 3.0.1 31 | - Update `gt-youdao-dict-engine`, now retrieve the html code and parse from DOM 32 | - Add new engine `gt-youdao-suggest-engine` for Chinese word translation 33 | 34 | Version 3.0 35 | - Refactor from v2, almost all APIs have been changed 36 | 37 | Version 2.0 38 | - Refactor from v1, almost all APIs have been changed -------------------------------------------------------------------------------- /README-zh.org: -------------------------------------------------------------------------------- 1 | * Go Translate 2 | 3 | 这是一个翻译框架，其主要特点是高度可配置性和高度可扩展性。 4 | 5 | 作为一个翻译框架，它有很多优点: 6 | - 支持多种翻译引擎，比如 ChatGPT, Bing, Google, DeepL, 有道词典/近义词, StarDict, LibreTranslate 等 7 | - 丰富的渲染方式，可以渲染到 Buffer, Posframe, Overlay, Kill Ring 等。支持流式渲染 8 | - 可以灵活获取需要翻译的内容和语言，内置的 Taker 有丰富的选项适配不同场景 9 | - 支持单词翻译，也支持句子翻译，并支持多段落翻译。可同时使用多个引擎，将多个段落，翻译为多种语言 10 | - 支持不同的 HTTP 后端 (url.el, curl)，请求纯异步和无阻塞，体验良好。支持为不同请求设定不同代理 11 | - 基于 eieio (CLOS) 实现，各种组件，允许用户灵活搭配、自由扩展 12 | 13 | 当然，这不仅是一个翻译框架。它非常灵活，可以轻松扩展到任意文本转换的场合 (Text to Text): 14 | - 比如内置的 Text Utility，集成了文本的加密解密、求取哈希、生成二维码等功能 15 | - 比如可以扩展为 ChatGPT 的客户端 (TODO) 16 | 17 | ** 基本使用 18 | 19 | 首先，需要通过 MELPA 或者其他途径下载并加载本包。 20 | 21 | 对于最基本的使用，添加如下代码到配置文件: 22 | #+begin_src emacs-lisp 23 | (setq gt-langs '(en zh)) 24 | (setq gt-default-translator (gt-translator :engines (gt-youdao-dict-engine))) 25 | 26 | ;; 上述配置的意思是，初始化默认翻译器，让其在 en 和 zh 之间通过有道词典进行翻译， 27 | ;; 结果将显示在 Echo Area 中 28 | #+end_src 29 | 30 | 然后选中某段文本，执行命令 =gt-do-translate= 即可。 31 | 32 | 当然，也可以为翻译器指定更多选项，比如: 33 | #+begin_src emacs-lisp 34 | (setq gt-default-translator 35 | (gt-translator 36 | :taker (gt-taker :text 'buffer :pick 'paragraph) ; 配置拾取器 37 | :engines (list (gt-bing-engine) (gt-youdao-dict-engine)) ; 指定多引擎 38 | :render (gt-buffer-render))) ; 配置渲染器 39 | 40 | ;; 上述配置的意思是，初始化默认翻译器，让其将当前 buffer 中的所有段落交给 Bing 和有道进行翻译， 41 | ;; 并将结果通过一个新的 Buffer 渲染出来 42 | 43 | (setq gt-default-translator 44 | (gt-translator 45 | :taker (gt-taker :langs '(en zh) :text 'word :prompt t) 46 | :engines (list (gt-stardict-engine :exact t) 47 | (gt-youdao-dict-engine) 48 | (gt-youdao-suggest-engine)) 49 | :render (gt-buffer-render))) 50 | 51 | ;; 上面配置适用于中英单词互译，初始化翻译器，让其翻译当前或选中单词，使用 StarDict 和有道进行翻译， 52 | ;; 结果使用新的 Buffer 渲染出来 53 | #+end_src 54 | 55 | 除了通过 =gt-default-translator= 设定默认翻译器，也可以通过 =gt-preset-translators= 配置若干预设翻译器。 56 | 如果 =gt-default-translator= 为 nil，那么 =gt-preset-translators= 中的第一个将会被作为默认翻译器。 57 | 58 | 定义预设翻译器的语法如下: 59 | #+begin_src emacs-lisp 60 | (setq gt-preset-translators 61 | `((ts-1 . ,(gt-translator 62 | :taker (gt-taker :langs '(en zh) :text 'word) 63 | :engines (gt-bing-engine) 64 | :render (gt-overlay-render))) 65 | (ts-2 . ,(gt-translator 66 | :taker (gt-taker :langs '(en fr ru) :text 'sentence) 67 | :engines (gt-google-engine) 68 | :render (gt-insert-render))) 69 | (ts-3 . ,(gt-translator 70 | :taker (gt-taker :langs '(en zh) :text 'buffer 71 | :pick 'word :pick-pred (lambda (w) (length> w 6))) 72 | :engines (gt-google-engine) 73 | :render (gt-overlay-render :type 'help-echo))))) 74 | #+end_src 75 | 76 | 上面预设了三个翻译器： 77 | - *ts-1*: 使用 Bing 在 en 和 zh 间进行翻译，翻译的是光标附近的单词或选中的文本，结果将以 overlay 的方式显示在当前位置 78 | - *ts-2*: 使用 Google 在 en, fr 和 ru 间进行翻译，翻译的是光标附近的句子或选中的文本，结果将插入当前 buffer 79 | - *ts-3*: 使用 Google 翻译 buffer 中所有长度大于 6 的单词，将鼠标放到被翻译的单词上后，翻译结果将以 popup 方式显示 80 | 81 | 随后就可以通过命令 =gt-do-translate= 进行翻译，并可通过 =gt-do-setup= 在不同翻译器间进行切换。 82 | 83 | #+begin_quote 84 | *强烈建议:* 85 | 86 | 安装 curl 程序和 [[https://github.com/alphapapa/plz.el][plz.el]] 包。之后请求将会通过 curl 进行发送，效果比内置的 url.el 好很多! 87 | #+end_quote 88 | 89 | 请通过 =M-x customize-group go-translate= 查看更多配置选项，通过阅读之后的章节了解更多配置细节。 90 | 91 | ** 更多配置 92 | 93 | 翻译框架最核心的组件是翻译器，即 =gt-translator=, 它主要包含如下组件: 94 | - =gt-taker= 组件: 用来捕获用户的输入，包括文本和要翻译的语言 95 | - =gt-engine= 组件: 用于将 taker 捕获的内容翻译成对应的目标文本 96 | - =gt-render= 组件: 用于将 engine 翻译的结果聚合起来，并输出到用户 97 | 98 | 翻译的基本流程 =[输入] -> [翻译/转换] -> [输出]=, 分别对应以上 =[Taker] -> [Engine] -> [Render]= 三种组件。 99 | 对翻译器执行 =gt-start= 方法，就会按照基本流程完成一次完整的翻译。 100 | 101 | 因此，配置的实质就是创建一个翻译器实例，并按需求为其指定不同的组件: 102 | #+begin_src emacs-lisp 103 | ;; 通过 :taker :engines 和 :render 指定组件; 通过 gt-start 方法执行翻译 104 | (gt-start (gt-translator :taker ... :engines ... :render ...)) 105 | 106 | ;; gt-do-translate 命令使用 gt-default-translator 指向的翻译器执行翻译任务 107 | (setq gt-default-translator (gt-translator :taker ... :engines ... :render ..)) 108 | (call-interactively #'gt-do-translate) 109 | #+end_src 110 | 111 | 因此，完善配置之前，需要对组件进行进一步了解。 112 | 113 | *** 用于捕获输入的 =gt-taker= 组件 114 | 115 | | slot | 介绍 | 值 | 116 | |-----------+-----------------------------+------------------------------------------------------------------------------------| 117 | | text | 初始文本 | 字符串或返回字符串的一个函数，也可以是 'buffer 'word 'paragraph 'sentence 等 symbol | 118 | | langs | 要翻译的语言 | 列表，比如 '(en zh), '(en ru it fr)，如果为空，则采用变量 gt-langs 的值 | 119 | | prompt | 交互式确认 | 如果为 t 则通过 Minibuffer 确认，如果为 'buffer 则通过打开一个新 buffer 进行确认 | 120 | | pick | 从文本中挑选段落、句子或单词 | 进行挑选的函数，或者 'word 'paragraph 'sentence 等 symbol | 121 | | pick-pred | 用于过滤 pick 到的文字 | 传入字符串，输出布尔类型 | 122 | | then | take 之后要执行的逻辑，钩子 | 一个以当前 translator 为参数的函数。可以对 take 到的内容进行最后一步修改 | 123 | | if | 过滤 | 函数或字面量表达式，用于根据输入的内容决定 taker 是否适用于当前翻译任务 | 124 | 125 | 当前只内置了一个 Taker 实现，它可以适用大多数场景: 126 | : 通过 text 决定初始文本，通过 langs 判定翻译语言，通过 prompt 进行确认，通过 pick 从中摘取某些段落、句子或单词 127 | 128 | 如果没有为翻译器指定 Taker 或指定了 Taker 但缺乏选项，将使用下面变量的值作为默认选项: 129 | #+begin_src emacs-lisp 130 | (setq gt-langs '(en zh)) ; 默认的翻译语言，至少要指定两个语言 131 | (setq gt-taker-text 'word) ; 默认情况下，初始文本是光标下的单词。如果有文本选中，优先使用选中文本 132 | (setq gt-taker-pick 'paragraph) ; 默认情况下，会按照段落标准分割初始文本。如果不想使用多段翻译，将其设置为 nil 133 | (setq gt-taker-prompt nil) ; 默认情况下，没有 prompt 步骤。如果需要，将其设置为 t 或 'buffer 134 | #+end_src 135 | 136 | 使用 =:taker= 显式为翻译器指定 Taker。比如，下面创建的 Taker 跟上述的配置是一致的: 137 | #+begin_src emacs-lisp 138 | (gt-translator :taker (gt-taker)) 139 | (gt-translator :taker (gt-taker :langs '(en zh) :text 'word :pick 'paragraph :prompt nil)) 140 | (gt-translator :taker (lambda () (gt-taker))) ; 可以是一个函数 141 | 142 | ;; 也可以是一个 taker 列表，那么返回第一个可用的 143 | ;; 结合 :if 判定，如果 taker 没有 :if 则一定是可用的 144 | ;; 比如下面的例子: 如果有文字被选中，prompt; 如果 buffer 只读，翻译当前段落; 否则翻译当前行 145 | (gt-translator :taker (list 146 | (gt-taker :prompt t :if 'selection) 147 | (gt-taker :text 'paragraph :if 'read-only) 148 | (gt-taker :text 'line))) 149 | #+end_src 150 | 151 | Taker 将使用 =text= 决定初始翻译内容。如果当前有文本被选中，则选中的文本被采用。否则使用下面规则: 152 | #+begin_src emacs-lisp 153 | ;; 如果是 symbol 使用 thing-at-thing 的逻辑决定初始文本 154 | (gt-translator :taker (gt-taker :text 'word)) ; 当前单词 (默认值) 155 | (gt-translator :taker (gt-taker :text 'buffer)) ; 当前 buffer 的内容 156 | (gt-translator :taker (gt-taker :text 'paragraph)) ; 当前段落的内容 157 | (gt-translator :taker (gt-taker :text t)) ; 交互式选中一个 symbol，之后根据 symbol 选取 158 | 159 | ;; 如果是一个字符串或返回字符串的函数，则以其作为初始文本 160 | (gt-translator :taker (gt-taker :text "hello world")) ; 固定文本 161 | (gt-translator :taker (gt-taker :text (lambda () (buffer-substring 10 15)))) ; 函数返回值，字符串 162 | (gt-translator :taker (gt-taker :text (lambda () '((10 . 15))))) ; 函数返回值，bounds 163 | #+end_src 164 | 165 | Taker 将从 =langs= 中选取要翻译的语言。默认会结合 =gt-lang-rules= 里的规则进行判定和选取: 166 | #+begin_src emacs-lisp 167 | (gt-translator :taker (gt-taker :langs '(en zh))) ; 在中、英之间进行翻译 168 | (gt-translator :taker (gt-taker :langs '(en zh ru))) ; 在中、英、俄之间进行翻译 169 | (setq gt-polyglot-p t) ; 如果将此变量设置为 t，那么将进行多语言翻译，即一次翻译成多语言并聚合输出 170 | #+end_src 171 | 172 | 通过设定 =prompt= 让用户对初始文本和翻译语言进行交互式修改和确认: 173 | #+begin_src emacs-lisp 174 | ;; 通过 Minibuffer 的方式进行确认。集成了一些快捷键，不仅可以修改文本，也可以切换语言 175 | (gt-translator :taker (gt-taker :prompt t)) 176 | 177 | ;; 通过打开新 Buffer 的方式进行确认。在某些场合，通过新 Buffer 进行某些调整工作是更合适的 178 | (gt-translator :taker (gt-taker :prompt 'buffer)) 179 | #+end_src 180 | 181 | 最后，会根据 =pick= 和 =pick-pred= 对初始文本进行切割和提取。它返回的内容才是最终要被翻译的: 182 | #+begin_src emacs-lisp 183 | ;; pick 可以是类似于 text 的 symbol 184 | (gt-translator :taker (gt-taker ; 翻译整个 buffer 中所有段落 185 | :text 'buffer 186 | :pick 'paragraph)) 187 | (gt-translator :taker (gt-taker ; 翻译当前段落中长度大于 6 的单词 188 | :text 'paragraph 189 | :pick 'word :pick-pred (lambda (w) (length> w 6)))) 190 | 191 | ;; pick 也可以是一个函数。下面例子等同于上面，翻译当前段落中长度大于 6 的单词 192 | ;; 也可以实现更复杂、更智能的选取逻辑。比如，只选取生词进行翻译 193 | (defun my-get-words-length>-6 (text) 194 | (cl-remove-if-not (lambda (bd) (> (- (cdr bd) (car bd)) 6)) 195 | (gt-pick-items-by-thing text 'word))) 196 | (gt-translator :taker (gt-taker :text 'paragraph :pick #'my-get-words-length>-6)) 197 | 198 | ;; 使用 :pick 'fresh-word 实现了“透析翻译”的效果，即结合训练的结果，只显示生僻词 199 | ;; 结合 gt-record-words-as-known/unkown 命令将单词标记(训练)为已经掌握的单词 200 | (gt-translator :taker (gt-taker :text 'paragraph :pick 'fresh-word)) 201 | #+end_src 202 | 203 | *** 用于翻译转换的 =gt-engine= 组件 204 | 205 | | slot | 介绍 | 值 | 206 | |-----------+-------------------------------+-------------------------------------------------------------------------------------| 207 | | parse | 指定解析器 | 解析器或函数 | 208 | | cache | 配置缓存 | 如果设为 nil 则为当前 engine 禁用缓存。也可以为不同 engine 指定不同 cacher 或缓存策略 | 209 | | stream | 是否开启 stream 模式 | 只有引擎支持流式 API 这个设置才有用。比如，ChatGPT 引擎 | 210 | | delimiter | 分隔符 | 如果不为空，则采取「连接-翻译-分割」的翻译策略 | 211 | | then | engine 完成后执行的逻辑，钩子 | 一个以当前 task 为参数的函数。可以用于在渲染之前对返回的内容进行最后一步修改 | 212 | | if | 过滤 | 函数或字面量表达式，用于根据输入的内容决定当前 engine 是否参与当前翻译任务 | 213 | 214 | 内置的 Engine 实现有: 215 | - =gt-deepl-engine=, DeepL 翻译 216 | - =gt-bing-engine=, 微软翻译 217 | - =gt-google-engine/gt-google-rpc-engine=, Google 翻译 218 | - =gt-chatgpt-engine=, 使用 ChatGPT 进行翻译 219 | - =gt-youdao-dict-engine/gt-youdao-suggest-engine=, 有道词典/有道近义词。主要用于中英互译 220 | - =gt-stardict-engine=, StarDict，支持外挂字典，可以用于离线翻译 221 | - =gt-libre-engine=, LibreTranslate, 可以使用网络服务，也可以搭建本地服务 222 | - =gt-osxdict-engine=, 借助命令 osx-dictionary 调用苹果系统内置的翻译 223 | 224 | 通过 =:engines= 为翻译器指定引擎。一个翻译器可以有一个或多个引擎，也可以指定一个返回引擎列表的函数: 225 | #+begin_src emacs-lisp 226 | (gt-translator :engines (gt-google-engine)) 227 | (gt-translator :engines (list (gt-google-engine) (gt-deepl-engine) (gt-chatgpt-engine))) 228 | (gt-translator :engines (lambda () (gt-google-engine))) 229 | #+end_src 230 | 231 | 若引擎存在多个解析器，则可以通过 =parse= 指定某个从而实现特定解析，比如: 232 | #+begin_src emacs-lisp 233 | (gt-translator 234 | :engines (list (gt-google-engine :parse (gt-google-parser)) ; 详细结果 235 | (gt-google-engine :parse (gt-google-summary-parser)))) ; 简约结果 236 | #+end_src 237 | 238 | 可以通过 =if= 为不同引擎指定不同翻译任务，比如： 239 | #+begin_src emacs-lisp 240 | (gt-translator 241 | :engines (list (gt-google-engine :if 'word) ; 只有当翻译内容为单词时启用 242 | (gt-bing-engine :if '(and not-word parts)) ; 只有翻译内容不是单词且是多个段落时启用 243 | (gt-deepl-engine :if 'not-word :cache nil) ; 只有翻译内容不是单词时启用; 不缓存 244 | (gt-youdao-dict-engine :if '(or src:zh tgt:zh)) ; 只有翻译中文时启用 245 | (gt-youdao-suggest-engine :if '(and word src:en)))) ; 只有翻译英文单词时启用 246 | #+end_src 247 | 248 | 可以通过 =cache= 为不同引擎指定不同的缓存策略: 249 | #+begin_src emacs-lisp 250 | (gt-translator 251 | :engines (list (gt-youdao-dict-engine) ; 默认缓存机制 252 | (gt-google-engine :cache nil) ; 禁用缓存 253 | (gt-bing-engine :cache 'word) ; 只缓存单词 254 | (gt-deepl-engine :cache (gt-xxx-cacher)))) ; 指定其他缓存器 255 | #+end_src 256 | 257 | #+begin_quote 258 | *注意:* 259 | 260 | 如果是多段落或多单词翻译，默认将会采取: 261 | 1. 先将翻译的内容连成一个字符串， 262 | 2. 通过一次翻译得到结果， 263 | 3. 之后再将结果分割开来的翻译策略。 264 | 265 | 这时传递给 Engine 翻译的文本是一个单独的字符串。 266 | 267 | 如果将 delimiter 设定为 nil 那么传递给 Engine 的将是一个字符串列表，这时将需要 Engine 有处理列表的能力。 268 | #+end_quote 269 | 270 | *** 用于渲染输出的 =gt-render= 组件 271 | 272 | | slot | 介绍 | 值 | 273 | |--------+---------------------------+-----------------------------------------------------------------------------| 274 | | prefix | 定制输出中的 Prefix 内容 | 函数或字符串。定制 Prefix 显示格式。Prefix 是输出结果中的语言、引擎提示的文本 | 275 | | then | 渲染完成后执行的逻辑，钩子 | 函数或另一个渲染器。可以将渲染任务传递给下一个渲染器，实现多渲染器输出的效果 | 276 | | if | 过滤 | 函数或字面量表达式，用于根据输入的内容决定 render 是否适用于当前翻译任务 | 277 | 278 | 内置的 Render 实现有: 279 | - =gt-render=, 默认实现，会将结果输出到 Echo Area 280 | - =gt-buffer-render=, 打开一个在新 Buffer 来渲染结果 (*推荐使用*) 281 | - =gt-posframe-pop-render=, 在当前位置打开一个 childframe 弹窗来渲染结果 282 | - =gt-posframe-pin-render=, 使用屏幕固定位置的 childframe 窗口来渲染结果 283 | - =gt-insert-render=, 将翻译结果插入到当前 buffer，可设定插入的位置、样式等 284 | - =gt-overlay-render=, 将翻译结果通过 Overlay 的方式进行显示，可设定显示的位置、样式等 285 | - =gt-kill-ring-render=, 将翻译结果保存到 Kill Ring 中 286 | - =gt-alert-render=, 借助 [[https://github.com/jwiegley/alert][alert]] 包将结果显示为系统消息 287 | 288 | 通过 =:render= 为翻译器配置渲染器。可以通过 =:then= 将多个渲染器串起来搭配使用: 289 | #+begin_src emacs-lisp 290 | (gt-translator :render (gt-alert-render)) 291 | (gt-translator :render (gt-alert-render :then (gt-kill-ring-render))) ; 以系统消息方式展示，并保存进 kill-ring 292 | (gt-translator :render (lambda () (if buffer-read-only (gt-buffer-render) (gt-insert-render)))) ; 可以指定函数 293 | #+end_src 294 | 295 | 可以结合 =:if= 选择使用列表中的第一个可用 render。这可以灵活配置不同情况下 render 的使用。比如: 296 | #+begin_src emacs-lisp 297 | (gt-translator 298 | :render (list (gt-overlay-render :if 'selection) ; 如果翻译的是选中的文字，那么通过 overlay 方式渲染 299 | (gt-posframe-pop-render :if 'word) ; 如果翻译的是单词，那么通过 posframe 方式渲染 300 | (gt-alert-render :if '(and read-only not-word)) ; 如果翻译的是只读 buffer 中的非单词，那么通过 alert 渲染 301 | (gt-buffer-render))) ; 默认，使用新 buffer 进行渲染 302 | #+end_src 303 | 304 | ** 常用组件/补充说明 305 | *** gt-memory-cacher (gt-default-cacher) 306 | 307 | =gt-memory-cacher= 是内置的缓存实现，功能简单直接。只需要将 =gt-cache-p= 设置为 t 即可使用。 308 | 309 | 可以通过 =gt-default-cacher= 对缓存进行配置或切换其他缓存实现: 310 | #+begin_src emacs-lisp 311 | (setq gt-default-cacher (gt-memory-cacher :if 'word)) ; 只缓存单词 312 | (setq gt-default-cacher (gt-memory-cacher :if '(or word not-src:zh))) ; 只缓存单词和非中文翻译 313 | (setq gt-default-cacher (gt-xxxxxx-cacher)) ; 使用其他缓存实现 314 | #+end_src 315 | 316 | 要关闭缓存，可以将总开关 =gt-cache-p= 设为 nil，也可以单独关闭某引擎的缓存: 317 | #+begin_src emacs-lisp 318 | (gt-translator :engines (gt-google-engine :cache nil)) 319 | #+end_src 320 | 321 | #+begin_quote 322 | 可以通过扩展将翻译结果缓存进文件、SQLite 或 Redis 等。但感觉没必要。 323 | #+end_quote 324 | 325 | *** gt-url-http-client/gt-plz-http-client (gt-default-http-client) 326 | 327 | 某些引擎需要通过网络获取翻译结果，这需要借助 =gt-http-client= 组件进行网络处理。 328 | 329 | 默认情况下网络请求是通过 =gt-url-http-client= 处理的，它的底层是 url.el，效率很低。 330 | 331 | 组件 =gt-plz-http-client= 实现了通过 curl 进行 http 请求的目的，效果好很多很多。 332 | 333 | 可以通过 =gt-default-http-client= 对请求客户端进行配置。当然，如果检测到系统内已经存在 curl 程序并安装了 [[https://github.com/alphapapa/plz.el][plz]] 包，组件 =gt-plz-http-client= 将自动设定为默认请求器。 334 | 335 | 如果想让请求走代理，这样设置: 336 | #+begin_src emacs-lisp 337 | ;; 如果是 gt-url-http-client 338 | (setq gt-default-http-client 339 | (gt-url-http-client :proxies '(("http" . "host:9999") ("https" . "host:9999")))) 340 | 341 | ;; 如果是 gt-plz-http-client 342 | (setq gt-default-http-client 343 | (gt-plz-http-client :args '("--proxy" "socks5://127.0.0.1:9999"))) 344 | #+end_src 345 | 346 | 若想让不同请求走不同代理，可以仿照下面方式设置: 347 | #+begin_src emacs-lisp 348 | (setq gt-default-http-client 349 | (lambda (host) 350 | (if (string-match-p "google\\|deepl\\|openai" host) 351 | (gt-plz-http-client :args '("--proxy" "socks5://127.0.0.1:9999")) 352 | (gt-plz-http-client)))) 353 | 354 | (setq gt-default-http-client 355 | (lambda (host) 356 | (let ((proxy? (string-match-p "google\\|deepl\\|openai" host))) 357 | (if (require 'plz nil t) 358 | (if proxy? 359 | (gt-plz-http-client :args '("--proxy" "socks5://127.0.0.1:9999")) 360 | (gt-plz-http-client)) 361 | (if proxy? 362 | (gt-url-http-client :proxies '(("http" . "host:9999") ("https" . "host:9999"))) 363 | (gt-url-http-client)))))) 364 | #+end_src 365 | 366 | *** gt-taker 367 | 368 | 如果通过 minibuffer 进行 prompt，那么在 minibuffer 中存在如下快捷键: 369 | - =C-n= 和 =C-p= 切换语言 370 | - =C-l= 清空输入 371 | - =C-g= 取消翻译 372 | 373 | 如果通过 buffer 进行 prompt，那么在打开的 buffer 中默认存在如下快捷键: 374 | - =C-c C-c= 提交修改，进行翻译 375 | - =C-c C-k= 取消翻译 376 | - 也可以切换语言、切换组件，通过 mode-line 获取更多信息 377 | 378 | 可以通过 pick 的 =fresh-word= 选项实现只翻译生僻词的目的。基本步骤: 379 | 1. 配置要使用的翻译器，将 pick 指定为 fresh-word, 比如: 380 | #+begin_src emacs-lisp 381 | (setq gt-default-translator 382 | (gt-translator :taker (gt-taker :text 'paragraph :pick 'fresh-word) 383 | :engines (gt-bing-engine) 384 | :render (gt-overlay-render :sface nil))) 385 | #+end_src 386 | 2. 对文本进行翻译，默认会对目标文本中的所有单词进行翻译 387 | 3. 执行 =gt-record-words-as-known= 命令，按提示将已经掌握的单词记录在案 388 | 4. 持续执行 2/3 步骤，训练掌握单词的量。已记录单词作为非生僻词将不会出现在之后的翻译中 389 | 5. 可执行 =gt-record-words-as-unknown= 将某单词重新设定为生僻词 390 | 6. 本功能有很大的优化提升空间。比如换作用数据库记录，统计单词的翻译次数等，按下不提 391 | 392 | *** gt-stardict-engine 393 | 394 | 这是个支持外挂字典的离线翻译引擎。 395 | 396 | 首先，需要确保你的系统中已经安装了 [[https://github.com/Dushistov/sdcv][sdcv]]: 397 | : sudo pacman -S sdcv 398 | 399 | 另外，需要下载字典文件放入到相关目录。比如下面是在 Linux 下安装朗道字典文件的示例: 400 | #+begin_src shell 401 | mkdir -p ~/.stardict/dic 402 | cd ~/.stardict/dic 403 | wget http://download.huzheng.org/zh_CN/stardict-langdao-ce-gb-2.4.2.tar.bz2 404 | wget http://download.huzheng.org/zh_CN/stardict-langdao-ce-gb-2.4.2.tar.bz2 405 | tar xvf stardict-langdao-ec-gb-2.4.2.tar.bz2 406 | tar xvf stardict-langdao-ce-gb-2.4.2.tar.bz2 407 | sdcv -l 408 | #+end_src 409 | 410 | 之后，你就可以配置使用此引擎了: 411 | #+begin_src emacs-lisp 412 | ;; 基本配置 413 | (setq gt-default-translator 414 | (gt-translator :engines (gt-stardict-engine) 415 | :render (gt-buffer-render))) 416 | 417 | ;; 可以指定更多选项 418 | (setq gt-default-translator 419 | (gt-translator :engines (gt-stardict-engine 420 | :dir "~/.stardict/dic" ; 指定数据文件位置 421 | :dict "朗道英汉字典5.0" ; 可以指定具体使用的字典 422 | :exact t) ; do not fuzzy-search, only return exact matches 423 | :render (gt-buffer-render))) 424 | #+end_src 425 | 426 | *注意*: 如果是通过 Buffer-Render 等渲染，可以通过点击字典名或错误提示实现字典切换 (快捷键: =C-c C-c=)。 427 | 428 | *** gt-deepl-engine 429 | 430 | DeepL 需要 auth-key 才能正常使用，首先需要通过官网进行获取。 431 | 432 | 然后，可以通过下列方法对 auth-key 进行设置: 433 | 434 | 1. 在 engine 定义中直接指定: 435 | 436 | #+begin_example 437 | (gt-translator :engines (gt-deepl-engine :key "***")) 438 | #+end_example 439 | 440 | 2. 将 auth-key 存进系统的 =.authinfo= 文件中: 441 | 442 | #+begin_example 443 | machine api.deepl.com login auth-key password *** 444 | #+end_example 445 | 446 | *** gt-chatgpt-engine 447 | 448 | ChatGPT 需要 apikey 才能正常使用: 449 | #+begin_src emacs-lisp 450 | ;; 提供 apikey 有很多方式 451 | (setq gt-chatgpt-key "YOUR-KEY") 452 | (gt-chatgpt-engine :key "YOUR_KEY") 453 | (find-file "~/.authinfo") ; machine api.openai.com login apikey password [YOUR_KEY] 454 | 455 | ;; 其他配置 456 | (setq gt-chatgpt-host "YOUR-HOST") 457 | (setq gt-chatgpt-model "gpt-3.5-turbo") 458 | (setq gt-chatgpt-temperature 0.7) 459 | #+end_src 460 | 461 | 可以自定义翻译的 prompt。比如: 462 | #+begin_src emacs-lisp 463 | (setq gt-chatgpt-user-prompt-template 464 | (lambda (text lang) 465 | (format "将文本翻译成 %s 然后将结果复制3份返回。文本如下: \n%s" 466 | (alist-get lang gt-lang-codes) text))) 467 | #+end_src 468 | 469 | 甚至可以基于其它自定义 Prompt，借助 ChatGPT 完成其他任务。比如下面的命令用于润色句子: 470 | #+begin_src emacs-lisp 471 | (defun my-command-polish-using-ChatGPT () 472 | (interactive) 473 | (let ((gt-chatgpt-system-prompt "你是一个优秀的网文写手") 474 | (gt-chatgpt-user-prompt-template (lambda (text _) 475 | (read-string 476 | "Prompt: " 477 | (format "润色句子，要求只返回生成的句子: %s" text))))) 478 | (gt-start (gt-translator 479 | :engines (gt-chatgpt-engine :cache nil) 480 | :render (gt-insert-render))))) 481 | #+end_src 482 | 483 | 可以通过设置 =:stream t= 让引擎返回流式 (stream) 结果，即内容一点点返回并输出。下面是例子: 484 | #+begin_src emacs-lisp 485 | ;; 下面配置了三个引擎，第一个是流式的，另外两个是普通的 486 | ;; 其中 Buffer Render, Posframe Render 和 Insert Render 可以进行流式渲染 487 | (setq gt-default-translator 488 | (gt-translator :taker (gt-taker :pick nil) 489 | :engines (list (gt-chatgpt-engine :stream t) 490 | (gt-chatgpt-engine :stream nil) 491 | (gt-google-engine)) 492 | :render (gt-buffer-render))) 493 | 494 | ;; 下面配置，将查询的内容一点点插入到 buffer 当前位置 495 | (setq gt-default-translator 496 | (gt-translator :taker (gt-taker :pick nil :prompt t) 497 | :engines (gt-chatgpt-engine :stream t) 498 | :render (gt-insert-render))) 499 | #+end_src 500 | 501 | 另外，可以通过 =gt-do-speak= 尝试其语音播报。 502 | 503 | *** gt-buffer-render 504 | 505 | 打开一个新的 buffer 来展示翻译结果。这是非常通用的一种展示结果的方式。 506 | 507 | 在弹出的 buffer 中，存在若干快捷键 (可以通过 =?= 获取到相关提示)，比如: 508 | - 通过 =t= 切换语言 509 | - 通过 =T= 切换多语言模式 510 | - 通过 =C= 清除缓存 511 | - 通过 =g= 刷新 512 | - 通过 =q= 退出 513 | 514 | 另外，通过 =y= (命令 =gt-do-speak=) 播放语音。可以先选中文本，然后通过 =y= 只播放选取片段的语音。 515 | 这需要这些引擎已经实现了语音播放的功能。另外，在其他任何地方调用 =gt-do-speak= 命令，将会尝试 516 | 使用操作系统本身的 TTS 功能对当前的文本进行语音播报。 517 | 518 | 可以通过 =buffer-name/window-config/split-threshold= 等对弹出的窗口进行设定: 519 | #+begin_src emacs-lisp 520 | (gt-translator :render (gt-buffer-render 521 | :buffer-name "abc" 522 | :window-config '((display-buffer-at-bottom)) 523 | :then (lambda (_) (pop-to-buffer "abc")))) 524 | #+end_src 525 | 526 | 下面是若干使用示例: 527 | #+begin_src emacs-lisp 528 | ;; 捕获光标下的单词或选区，使用 Google 翻译单词，使用 DeepL 翻译句子，使用 Buffer 展示结果 529 | ;; 这是非常通用的一种配置方式 530 | (setq gt-default-translator 531 | (gt-translator 532 | :taker (gt-taker :langs '(en zh) :text 'word) 533 | :engines (list (gt-google-engine :if 'word) (gt-deepl-engine :if 'not-word)) 534 | :render (gt-buffer-render))) 535 | 536 | ;; 封装了一个命令，用于将 Buffer 中的多个段落翻译为多种语言，并渲染到新的 Buffer 中 537 | ;; 这主要展示了命令的封装，以及多引擎多段落多语言的聚合显示效果 538 | (defun demo-translate-multiple-langs-and-multiple-parts () 539 | (interactive) 540 | (let ((gt-polyglot-p t) 541 | (translator (gt-translator 542 | :taker (gt-taker :langs '(en zh ru ja) :text 'buffer :pick 'paragraph) 543 | :engines (list (gt-google-engine) (gt-deepl-engine)) 544 | :render (gt-buffer-render)))) 545 | (gt-start translator))) 546 | #+end_src 547 | 548 | *** gt-posframe-pop-render/gt-posframe-pin-render 549 | 550 | 需要安装 [[https://github.com/tumashu/posframe][posframe]] 之后才能使用。 551 | 552 | 这两个 Render 的效果跟 =gt-buffer-render= 类似，只不过它的窗口是浮动的。 553 | 快捷键也是一致的，比如 =q= 表示退出。 554 | 555 | 可以通过 =:frame-params= 向 posframe 传递任意需要的参数: 556 | #+begin_src emacs-lisp 557 | (gt-posframe-pin-render :frame-params (list :border-width 20 :border-color "red")) 558 | #+end_src 559 | 560 | *** gt-insert-render 561 | 562 | 将翻译结果插入到当前 buffer。 563 | 564 | 可以指定如下类型 (=type=): 565 | - =after=, 默认类型，将结果插入到光标之后 566 | - =replace=, 用翻译结果替换被翻译的源文本 567 | 568 | 如果对默认的输出格式和样式不满意，可以通过如下选项进行调整: 569 | - =sface=, 翻译完成后，被翻译的源文本的 face 570 | - =rfmt=, 翻译结果的输出格式 571 | - =rface=, 为翻译结果指定特定样式 572 | 573 | 选项 =rfmt= 是一个包含控制字符 =%s= 的字符串，也可以是一个函数: 574 | #+begin_src emacs-lisp 575 | ;; %s 是翻译结果的占位符 576 | (gt-insert-render :rfmt " [%s]") 577 | ;; 一个参数，传入的是翻译结果字符串 578 | (gt-insert-render :rfmt (lambda (res) (concat " [" res "]"))) 579 | ;; 两个参数，则第一个是源文本 580 | (gt-insert-render :rfmt (lambda (stext res) 581 | (if (length< stext 3) 582 | (concat "\n" res) 583 | (propertize res 'face 'font-lock-warning-face))) 584 | :rface 'font-lock-doc-face) 585 | #+end_src 586 | 587 | 下面是若干使用示例: 588 | #+begin_src emacs-lisp 589 | ;; 按段落进行翻译，将每一段翻译的结果，插入到段落后面 590 | ;; 这种配置适合文章的翻译工作。基本流程是: 翻译 -> 修改 -> 保存 591 | (setq gt-default-translator 592 | (gt-translator 593 | :taker (gt-taker :text 'buffer :pick 'paragraph) 594 | :engines (gt-google-engine) 595 | :render (gt-insert-render :type 'after))) 596 | 597 | ;; 翻译当前段落，并使用翻译的结果替换掉被翻译的段落 598 | ;; 这种配置适合即时聊天等场合。输入文本，翻译得到译文，执行发送 599 | (setq gt-default-translator 600 | (gt-translator 601 | :taker (gt-taker :text 'paragraph :pick nil) 602 | :engines (gt-google-engine) 603 | :render (gt-insert-render :type 'replace))) 604 | 605 | ;; 将当前段落中符合条件的单词进行翻译，并将结果插入到单词之后 606 | ;; 这种配置方式，可以辅助阅读有生僻字的文章 607 | (setq gt-default-translator 608 | (gt-translator 609 | :taker (gt-taker :text 'paragraph 610 | :pick 'word 611 | :pick-pred (lambda (w) (length> w 6))) 612 | :engines (gt-google-engine) 613 | :render (gt-insert-render :type 'after 614 | :rfmt " (%s)" 615 | :rface '(:foreground "grey")))) 616 | #+end_src 617 | 618 | *** gt-overlay-render 619 | 620 | 使用 Overlay 显示翻译结果。 621 | 622 | 通过 =type= 设置显示的方式: 623 | - =after=, 默认类型，将翻译结果显示在源文本后面 624 | - =before=, 将翻译结果显示在源文本前面 625 | - =replace=, 将翻译结果覆盖显示到源文本上面 626 | - =help-echo=, 鼠标移动到源文本上时，翻译结果才弹出显示 627 | 628 | 它在很多方面跟 =gt-insert-render= 很像，包括选项: 629 | - =sface=, 翻译完成后，被翻译的源文本的 face 630 | - =rfmt=, 翻译结果的输出格式 631 | - =rface/rdisp=, 为翻译结果指定特定样式 632 | - =pface/pdisp=, 单独为翻译后的 Prefix (语言、引擎的提示) 设定样式 633 | 634 | 下面是若干使用示例: 635 | #+begin_src emacs-lisp 636 | ;; 翻译 buffer 中所有段落，将结果通过指定格式显示在原段落之后 637 | ;; 这是一种适合阅读 Info, News 等只读内容的配置 638 | (setq gt-default-translator 639 | (gt-translator 640 | :taker (gt-taker :text 'buffer :pick 'paragraph) 641 | :engines (gt-google-engine) 642 | :render (gt-overlay-render :type 'after 643 | :sface nil 644 | :rface 'font-lock-doc-face))) 645 | 646 | ;; 将 Buffer 中所有符合条件的单词做标记，当鼠标移上去的时候显示翻译结果 647 | ;; 这是一种实用的配置，适合阅读存在某些生僻词的文章 648 | (setq gt-default-translator 649 | (gt-translator 650 | :taker (gt-taker :text 'buffer :pick 'word :pick-pred (lambda (w) (length> w 5))) 651 | :engines (gt-google-engine) 652 | :render (gt-overlay-render :type 'help-echo))) 653 | 654 | ;; 也可以将符合条件单词的翻译直接显示在原单词后面 655 | (setq gt-default-translator 656 | (gt-translator 657 | :taker (gt-taker :text 'buffer :pick 'word :pick-pred (lambda (w) (length> w 5))) 658 | :engines (gt-google-engine) 659 | :render (gt-overlay-render :type 'after 660 | :sface nil 661 | :rfmt "%s" 662 | :rdisp '(space (:width 0.3) raise 0.6) 663 | :rface '(:foreground "grey" :height 0.5)))) 664 | 665 | ;; 使用 Overlay 把翻译的结果直接覆盖到原文之上 666 | ;; 对于某篇文章，如果想通过速览的方式获取其大致意思，适合使用这种配置 667 | (setq gt-default-translator 668 | (gt-translator 669 | :taker (gt-taker :text 'buffer) 670 | :engines (gt-google-engine) 671 | :render (gt-overlay-render :type 'replace))) 672 | #+end_src 673 | 674 | *** gt-text-utility 675 | 676 | 派生自 =gt-translator= 的一个组件，集成了很多文本转换和处理方面的功能。 677 | 678 | 这展示了本框架的扩展性，它不仅可以应用在翻译方面，其 taker 和 render 具备普适性。 679 | 680 | 如果要生成二维码，需要在系统中安装 =qrencode= 程序或通过 MELPA 安装 =qrencode= 包: 681 | #+begin_src sh 682 | pacman -S qrencode 683 | brew install qrencode 684 | 685 | # or in Emacs 686 | M-x package-install qrencode 687 | #+end_src 688 | 689 | 另外，可以通过扩展 generic 方法 =gt-text-util= 集成其他想要的功能。 690 | 691 | 下面是若干使用示例: 692 | #+begin_src emacs-lisp 693 | ;; 默认情况下，通过 completing-read 选择如何进行文本处理 694 | ;; 注意：无需为其指定 engines 695 | (setq gt-default-translator 696 | (gt-text-utility :render (gt-buffer-render))) 697 | 698 | ;; 为当前文本生成二维码 (通过 :langs 指定 utility) 699 | ;; 实用的配置，适用于电脑向手机传递文本片段 700 | (setq gt-default-translator 701 | (gt-text-utility 702 | :taker (gt-taker :langs '(qrcode) :pick nil) 703 | :render (gt-buffer-render))) 704 | 705 | ;; 为 buffer 中的每段文字都生成 TTS 按钮以及其 md5 值 706 | (setq gt-default-translator 707 | (gt-text-utility 708 | :taker (gt-taker :langs '(speak md5) :text 'buffer :pick 'paragraph) 709 | :render (gt-posframe-pin-render))) 710 | #+end_src 711 | 712 | *** gt-validator (:if) 713 | 714 | 组件 =gt-taker=, =gt-engine= 和 =gt-render= 等都继承了 =gt-validator=, 它通过 =:if= 提供了判定组件可用性的方式, 715 | 因此可以大大简化不同场景下 translator 的配置。 716 | 717 | 槽 =:if= 的值可以是函数，也可以是内置实现的一些 symbol, 或者通过 and/or 连接起来的 form 列表。 718 | 另外, symbol 可以使用 =not-= 或 =no-= 为前缀表示反向判定。 719 | 720 | 部分内置 symbol: 721 | - =word= 翻译的文本是单词 722 | - =src:en= 翻译的源语言是英语 723 | - =tgt:en= 翻译的目的语言是英语 724 | - =parts= 翻译的是分段的文本 725 | - =read-only= 当前 buffer 是只读的 726 | - =selection= 当前翻译的是选中的文本 727 | - =emacs-lisp-mode= 以 mode 结尾，表示须匹配当前模式 728 | - =not-word= or =no-word= 反向判定，翻译的文本 *不是* 单词 729 | 730 | 一个粗糙的配置示例: 731 | #+begin_src emacs-lisp 732 | ;; 对于选中的文本，不分段，并使用 posframe 渲染 733 | ;; 对于 Info，翻译当前段落，使用 overlay 显示结果 734 | ;; 对于只读文本，翻译整个 buffer 中的生词，并使用 overlay 渲染 735 | ;; 对于 Magit commit buffer，将翻译结果插入到光标位置 736 | ;; 对于单词，使用 google 引擎翻译; 其他使用 deepl 引擎 737 | (setq gt-default-translator 738 | (gt-translator 739 | :taker (list (gt-taker :pick nil :if 'selection) 740 | (gt-taker :text 'paragraph :if '(Info-mode help-mode)) 741 | (gt-taker :text 'buffer :pick 'fresh-word :if 'read-only) 742 | (gt-taker :text 'word)) 743 | :engines (list (gt-google-engine :if 'word) 744 | (gt-deepl-engine :if 'no-word)) 745 | :render (list (gt-posframe-pop-render :if 'selection) 746 | (gt-overlay-render :if 'read-only) 747 | (gt-insert-render :if (lambda (translator) (member (buffer-name) '("COMMIT_EDITMSG")))) 748 | (gt-alert-render :if '(and xxx-mode (or not-selection (and read-only parts)))) 749 | (gt-buffer-render)))) 750 | #+end_src 751 | 752 | ** 定制与扩展 753 | 754 | 代码基于 eieio (CLOS) 编写，所有的组件都是类，因此几乎每一部分都是可以扩展或替换的。 755 | 756 | 比如，要实现一个引擎，让它将捕获的文本倒序输出。实现起来很简单: 757 | #+begin_src emacs-lisp 758 | ;; 首先，定义引擎，继承自 gt-engine 759 | (defclass my-reverse-engine (gt-engine) 760 | ((delimiter :initform nil))) 761 | 762 | ;; 其次，为引擎实现 gt-translate 方法 763 | (cl-defmethod gt-translate ((_ my-reverse-engine) task next) 764 | (with-slots (text res) task 765 | (setf res (cl-loop for c in text collect (reverse c))) 766 | (funcall next task))) 767 | 768 | ;; 最后，配置使用 769 | (setq gt-default-translator (gt-translator :engines (my-reverse-engine))) 770 | #+end_src 771 | 772 | 比如，想扩展 Taker，让它能够捕获 org mode 中所有的标题。也很简单: 773 | #+begin_src emacs-lisp 774 | ;; [实现] 让 Taker 的 text 支持 org-headline，只需要对方法进行特化 775 | (cl-defmethod gt-thing-at-point ((_ (eql 'org-headline)) (_ (eql 'org-mode))) 776 | (let (bds) 777 | (org-element-map (org-element-parse-buffer) 'headline 778 | (lambda (h) 779 | (save-excursion 780 | (goto-char (org-element-property :begin h)) 781 | (skip-chars-forward "* ") 782 | (push (cons (point) (line-end-position)) bds)))))) 783 | 784 | ;; [使用] 通过 :text org-headline 捕获所有 headline; 通过 overlay 展示结果 785 | (setq gt-default-translator (gt-translator 786 | :taker (gt-taker :text 'org-headline) 787 | :engines (gt-google-engine) 788 | :render (gt-overlay-render :rfmt " (%s)" :sface nil))) 789 | #+end_src 790 | 791 | 如此这般，只要发挥想象，将可以做到很多。 792 | 793 | ** 欢迎提供反馈跟建议 794 | 795 | 要打开调试，需要将 =gt-debug-p= 设为 t。之后将能在 =*gt-log*= 中查看日志内容。 796 | 797 | 我使用翻译不多，这个框架纯粹是兴趣使然。因为对翻译工作的认知有限，某些功能设置未必合理。 798 | 因此若有同学和专业人士提出好的想法和建议，必欣然受之。请不吝赐教，谢谢。 799 | 800 | -------------------------------------------------------------------------------- /go-translate.el: -------------------------------------------------------------------------------- 1 | ;;; go-translate.el --- Translation framework, configurable and scalable -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | 5 | ;; Author: lorniu 6 | ;; URL: https://github.com/lorniu/go-translate 7 | ;; Package-Requires: ((emacs "28.1")) 8 | ;; Keywords: convenience 9 | ;; Version: 3.0.10 10 | 11 | ;; SPDX-License-Identifier: GPL-3.0-or-later 12 | 13 | ;; This program is free software; you can redistribute it and/or modify 14 | ;; it under the terms of the GNU General Public License as published by 15 | ;; the Free Software Foundation, either version 3 of the License, or 16 | ;; (at your option) any later version. 17 | 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | 23 | ;; You should have received a copy of the GNU General Public License 24 | ;; along with this program. If not, see . 25 | 26 | ;; This file is NOT part of GNU Emacs. 27 | 28 | ;;; Commentary: 29 | 30 | ;; Translation framework on Emacs, with high configurability and extensibility. 31 | ;; 32 | ;; - Support multiple translation engines, such as Google, Bing, DeepL, ChatGPT... 33 | ;; - With variety of output styles, such as Buffer, Overlay, Childframe and so on. 34 | ;; - With a flexible taker for easy retrieval of translated content and targets. 35 | ;; - Support multiple paragraphs/parts and multi-language translation. 36 | ;; - Support different http backends, such as url.el, curl. Async and non-blocking. 37 | ;; - Support caches, proxy and more. 38 | ;; 39 | ;; Notice, it is not limited to just being a translation framework. It can fulfill 40 | ;; any text transformation tasks, such as ChatGPT and more. 41 | ;; 42 | ;; Custom it as you need, extend it using your creativity. 43 | 44 | ;; You can install it via MELPA or from github. Make sure it is on your `load-path'. 45 | ;; 46 | ;; For the most basic use, add the following configuration: 47 | ;; 48 | ;; (require 'go-translate) 49 | ;; 50 | ;; (setq gt-default-translator 51 | ;; (gt-translator 52 | ;; :taker (gt-taker :langs '(en zh)) 53 | ;; :engines (list (gt-google-engine) (gt-bing-engine)) 54 | ;; :render (gt-buffer-render))) 55 | ;; 56 | ;; Then start your translate with command `gt-do-translate'. 57 | ;; 58 | ;; See README.org for details. 59 | 60 | ;;; Code: 61 | 62 | (require 'transient) 63 | (require 'gt-core) 64 | (require 'gt-extension) 65 | (require 'gt-engine-bing) 66 | (require 'gt-engine-google) 67 | (require 'gt-engine-google-rpc) 68 | (require 'gt-engine-deepl) 69 | (require 'gt-engine-stardict) 70 | (require 'gt-engine-osxdict) 71 | (require 'gt-engine-youdao) 72 | (require 'gt-engine-chatgpt) 73 | (require 'gt-engine-libre) 74 | (require 'gt-engine-echo) 75 | (require 'gt-text-utility) 76 | 77 | ;;; Mask these commands in M-x 78 | (dolist (cmd '(gt-prompt-next-target 79 | gt-buffer-render--cycle-next 80 | gt-buffer-render--refresh 81 | gt-buffer-render--browser 82 | gt-buffer-render--keyboard-quit 83 | gt-buffer-render--toggle-readonly 84 | gt-buffer-render--toggle-polyglot 85 | gt-buffer-render--delete-cache 86 | gt-buffer-render--show-tips 87 | gt-buffer-render--unfold-source-text 88 | gt-posframe-render-auto-close-handler 89 | gt-stardict-switch-dict 90 | gt-overlay-render-save-to-kill-ring)) 91 | (put cmd 'completion-predicate #'ignore)) 92 | 93 | 94 | ;;; Presets 95 | 96 | (defun gt-define-custom-taker () 97 | (let ((text (completing-read "Initial text: " 98 | (gt-make-completion-table `(,@gt-taker-text-things nil)))) 99 | (pick (completing-read "Pick style: " 100 | (gt-make-completion-table `(nil ,@gt-taker-pick-things)))) 101 | (prompt (completing-read "Prompt style: " 102 | (gt-make-completion-table (list 'disable 'buffer 'minibuffer)) nil t))) 103 | (gt-taker :text (intern text) :pick (intern pick) 104 | :prompt (pcase prompt ("buffer" 'buffer) ("minibuffer" t) (_ nil))))) 105 | 106 | (defcustom gt-preset-takers 107 | (lambda () 108 | `((,(gt-face-lazy "new..." 'bold) . ,#'gt-define-custom-taker) 109 | (default . ,(gt-taker)) 110 | (interactively . ,(gt-taker :text t :pick t :prompt t)) 111 | (paragraph-at-point . ,(gt-taker :text 'paragraph :pick nil)) 112 | (whole-buffer . ,(gt-taker :text 'buffer :pick 'nil)) 113 | (whole-buffer-by-paragraph . ,(gt-taker :text 'buffer :pick 'paragraph)))) 114 | "Preset takers. 115 | 116 | It is an alist or a function return the alist, which the value is a valid 117 | instance of `gt-taker' and the key is a string or symbol, representing the 118 | display label of the taker. 119 | 120 | Custom your own takers and put them into this list, then change the taker 121 | of `gt-default-translator' at any time in `gt-do-setup'." 122 | :type '(choice function 123 | (alist :key-type (choice string symbol) 124 | :value-type (sexp :tag "Instance of gt-taker"))) 125 | :group 'gt-do-translate) 126 | 127 | (defcustom gt-preset-engines 128 | (lambda () 129 | `((Bing . ,(gt-bing-engine)) 130 | (DeepL . ,(gt-deepl-engine)) 131 | (Google . ,(gt-google-engine)) 132 | (ChatGPT . ,(gt-chatgpt-engine)) 133 | (ChatGPT-Stream . ,(gt-chatgpt-engine :stream t)) 134 | (Youdao-Dict . ,(gt-youdao-dict-engine)) 135 | (Youdao-Suggest . ,(gt-youdao-suggest-engine)) 136 | (StarDict . ,(gt-stardict-engine)) 137 | (LibreTranslate . ,(gt-libre-engine)) 138 | (GoogleRPC . ,(gt-google-rpc-engine)) 139 | (Google-Summary . ,(gt-google-engine :parse (gt-google-summary-parser))) 140 | (OSX-Dictionary . ,(gt-osxdict-engine)) 141 | (Bionic_Reading . ,(gt-echo-engine :do '(clean br) :tag "Bionic Reading")))) 142 | "Preset engines. 143 | 144 | It is an alist or a function return the alist, which the value is a valid 145 | instance of `gt-engine' and the key is a string or symbol, representing the 146 | display label of the engine. 147 | 148 | Custom your own engines and put them into this list, then change the engines 149 | of `gt-default-translator' at any time in `gt-do-setup'." 150 | :type '(choice function 151 | (alist :key-type (choice string symbol) 152 | :value-type (sexp :tag "Instance of gt-engine"))) 153 | :group 'gt-do-translate) 154 | 155 | (defcustom gt-preset-renders 156 | (lambda () 157 | `((,gt-buffer-render-buffer-name . ,(gt-buffer-render)) 158 | (insert/after . ,(gt-insert-render :type 'after)) 159 | (insert/replace . ,(gt-insert-render :type 'replace)) 160 | (overlay/after . ,(gt-overlay-render :type 'after)) 161 | (overlay/help-echo . ,(gt-overlay-render :type 'help-echo)) 162 | (message->echo-area . ,(gt-render)) 163 | (save->kill-ring . ,(gt-kill-ring-render)) 164 | (Pop-Posframe . ,(gt-posframe-pop-render)) 165 | (Pin-Posframe . ,(gt-posframe-pin-render)) 166 | (overlay-or-insert . ,(lambda () 167 | (if buffer-read-only 168 | (gt-overlay-render :type 'after :then (gt-kill-ring-render)) 169 | (gt-insert-render :type 'after)))) 170 | (system-notification . ,(gt-alert-render)))) 171 | "Preset renders. 172 | 173 | It is an alist or a function return the alist, which the value is a valid 174 | instance of `gt-render' and the key is a string or symbol, representing the 175 | display label of the render. 176 | 177 | Custom your own render and put them into this list, then change the render 178 | of `gt-default-translator' at any time in `gt-do-setup'." 179 | :type '(choice function 180 | (alist :key-type (choice string symbol) 181 | :value-type (sexp :tag "Instance of gt-render"))) 182 | :group 'gt-do-translate) 183 | 184 | (defcustom gt-preset-translators 185 | (lambda () 186 | `((default . ,(gt-translator :taker (cdar (gt-ensure-plain gt-preset-takers)) 187 | :engines (cdar (gt-ensure-plain gt-preset-engines)) 188 | :render (cdar (gt-ensure-plain gt-preset-renders)))) 189 | (Text-Utility . ,(gt-text-utility 190 | :taker (gt-taker :pick nil) 191 | :render (gt-buffer-render))))) 192 | "Preset translators. 193 | 194 | It is an alist or a function return the alist, which the value is a valid 195 | instance of `gt-translator' and the key is a string or symbol, representing the 196 | display label of the translator. 197 | 198 | Custom your own translator and put them into this list, then change the the 199 | default translator to one of them at any time in `gt-do-setup'." 200 | :type '(choice function 201 | (alist :key-type (choice string symbol) 202 | :value-type (sexp :tag "Instance of gt-translator"))) 203 | :group 'gt-do-translate) 204 | 205 | (defcustom gt-default-translator nil 206 | "The translator used by `gt-do-translate'. 207 | 208 | If you leave this nil, then the first translator in `gt-preset-translators' 209 | will be used as the default translator." 210 | :type '(restricted-sexp :match-alternatives (gt-translator-p 'nil)) 211 | :group 'gt-do-translate) 212 | 213 | (defun gt-ensure-default-translator () 214 | "Initial `gt-default-translator' if possible and make sure it's valid." 215 | (unless gt-default-translator 216 | (setq gt-default-translator (cdar (gt-ensure-plain gt-preset-translators)))) 217 | (if (cl-typep gt-default-translator 'gt-translator) 218 | (let (gt-debug-p) (gt-reset gt-default-translator)) 219 | (user-error "The `gt-default-translator' is unavailable")) 220 | gt-default-translator) 221 | 222 | (defun gt-translator-info (translator) 223 | "Return TRANSLATOR's basic info for displaying." 224 | (with-slots (taker engines render _taker _engines _render) translator 225 | (cl-macrolet ((desc1 (name &rest body) 226 | `(if (not (slot-boundp translator ',(intern (format "_%s" name)))) "unbound" 227 | (when-let* ((,name (or ,name ,(intern (format "_%s" name))))) 228 | (if (gt-functionp ,name) 229 | (replace-regexp-in-string "[ \n\t]+" " " (format "%s" ,name)) 230 | ,@body))))) 231 | (list (desc1 taker (if (consp taker) (format "%s" taker) 232 | (cl-flet ((desc2 (slot) (when (slot-boundp taker slot) 233 | (format "%s: %s" slot (slot-value taker slot))))) 234 | (format "<%s> %s" (gt-desc taker) 235 | (string-join (remove nil (mapcar #'desc2 '(langs text pick prompt))) ", "))))) 236 | (desc1 engines (mapconcat (lambda (en) (concat (format "%s" (oref en tag)) (if (gt-stream-p en) " (stream)"))) 237 | (ensure-list (gt-ensure-plain engines)) ", ")) 238 | (desc1 render (if (consp render) (format "%s" render) 239 | (gt-desc (gt-ensure-plain render)))))))) 240 | 241 | (defun gt-set-taker (&optional translator taker) 242 | "Set TRANSLATOR's TAKER to one from `gt-preset-takers'." 243 | (interactive) 244 | (unless translator (setq translator gt-default-translator)) 245 | (unless taker 246 | (let ((cands (gt-ensure-plain gt-preset-takers))) 247 | (setq taker (gt-ensure-plain 248 | (alist-get 249 | (completing-read "Taker to use: " (gt-make-completion-table cands) nil t) 250 | cands nil nil #'string-equal))))) 251 | (oset translator taker nil) 252 | (oset translator _taker taker) 253 | (message "Changed taker done.")) 254 | 255 | (defun gt-set-engines (&optional translator engines) 256 | "Set TRANSLATOR's ENGINES to ones from `gt-preset-engines'." 257 | (interactive) 258 | (unless translator (setq translator gt-default-translator)) 259 | (unless engines 260 | (let ((cands (gt-ensure-plain gt-preset-engines))) 261 | (setq engines 262 | (mapcar (lambda (item) 263 | (let ((engine (gt-ensure-plain (alist-get item cands nil nil #'string-equal)))) 264 | (if (cl-typep engine 'gt-engine) engine 265 | (user-error "Invalid engine detected. Abort")))) 266 | (completing-read-multiple "Engines to use (can choose multiple): " 267 | (gt-make-completion-table cands)))))) 268 | (oset translator engines nil) 269 | (oset translator _engines engines) 270 | (message "Changed engines done.")) 271 | 272 | (defun gt-set-render (&optional translator render) 273 | "Set TRANSLATOR's RENDER to one from `gt-preset-renders'." 274 | (interactive) 275 | (unless translator (setq translator gt-default-translator)) 276 | (unless render 277 | (let ((cands (gt-ensure-plain gt-preset-renders))) 278 | (setq render (gt-ensure-plain 279 | (alist-get 280 | (completing-read "Render to use: " (gt-make-completion-table cands) nil t) 281 | cands nil nil #'string-equal))))) 282 | (oset translator render nil) 283 | (oset translator _render render) 284 | (message "Changed render done.")) 285 | 286 | (defun gt-translator-copy-of-presets () 287 | (let* ((tss (gt-ensure-plain gt-preset-translators)) 288 | (tsn (completing-read "Preset translator: " tss nil t)) 289 | (translator (alist-get tsn tss nil nil #'string-equal))) 290 | (list (clone translator) tsn))) 291 | 292 | (defun gt-switch-translator () 293 | "Switch `gt-default-translator' to another defined in `gt-preset-translators'." 294 | (interactive) 295 | (cl-destructuring-bind (translator name) 296 | (gt-translator-copy-of-presets) 297 | (setq gt-default-translator translator) 298 | (gt-ensure-default-translator) 299 | (message "Switch default translator to: %s" name))) 300 | 301 | (transient-define-prefix gt-do-setup () 302 | "Setup `gt-default-translator' in user interface provided by transient." 303 | :transient-non-suffix #'transient--do-exit 304 | [:description 305 | (lambda () 306 | (format "Current Default Translator:\n\n %s\n" 307 | (condition-case err 308 | (apply #'format "Taker: %s\n Engines: %s\n Render: %s" (gt-translator-info (gt-ensure-default-translator))) 309 | (error (format "%s" err))))) 310 | [("t" "Set taker..." gt-set-taker :transient t)] 311 | [("e" "Set engines..." gt-set-engines :transient t)] 312 | [("r" "Set render..." gt-set-render :transient t)] 313 | [("c" "Switch preset translator..." gt-switch-translator)]] 314 | (interactive) 315 | (gt-ensure-default-translator) 316 | (transient-setup 'gt-do-setup)) 317 | 318 | 319 | ;;; Entrance 320 | 321 | ;;;###autoload 322 | (defun gt-do-translate (&optional arg) 323 | "Translate using `gt-default-translator'. 324 | 325 | Define your default translator like this: 326 | 327 | (setq gt-default-translator 328 | (gt-translator :engines (gt-bing-engine))) 329 | 330 | (setq gt-default-translator 331 | (gt-translator :taker (gt-taker :langs \='(en fr) :text \='sentence :prompt t) 332 | :engines (list (gt-google-engine) (gt-deepl-engine)) 333 | :render (gt-buffer-render))) 334 | 335 | Or define several different translators and put them in `gt-preset-translators', 336 | and switch with `gt-do-setup' at any time. 337 | 338 | This is just a simple wrapper of `gt-start' method. Create other translate 339 | commands in the same way using your creativity. 340 | 341 | If ARG is not nil, translate with translator select by `gt-preset-translators'." 342 | (interactive "P") 343 | (let ((gt-default-translator (if arg (car (gt-translator-copy-of-presets)) gt-default-translator))) 344 | (gt-ensure-default-translator) 345 | (gt-start gt-default-translator))) 346 | 347 | (provide 'go-translate) 348 | 349 | ;;; go-translate.el ends here 350 | -------------------------------------------------------------------------------- /gt-engine-bing.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-bing.el --- Microsoft Translate -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; https://bing.com/translator 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-extension) 30 | 31 | (defgroup go-translate-bing nil 32 | "Configs for Bing engine." 33 | :group 'go-translate) 34 | 35 | 36 | 37 | (defclass gt-bing-parser (gt-parser) ()) 38 | 39 | (defclass gt-bing-engine (gt-engine) 40 | ((tag :initform 'Bing) 41 | (host :initform "https://www.bing.com") 42 | (host-tld :initform nil) 43 | (ig :initform nil) 44 | (key :initform nil) 45 | (token :initform nil) 46 | (last-time :initform nil) 47 | (expired-time :initform (* 30 60)) 48 | (parse :initform (gt-bing-parser)))) 49 | 50 | 51 | ;;; Translate 52 | 53 | (defvar gt-bing-extra-langs-mapping '((zh . "zh-Hans"))) 54 | 55 | (defvar gt-bing-token-maybe-invalid nil) 56 | 57 | (defun gt-bing-get-lang (lang) 58 | (or (cdr-safe (assoc lang gt-bing-extra-langs-mapping)) lang)) 59 | 60 | (defun gt-bing-with-token (engine done) 61 | (declare (indent 1)) 62 | (with-slots (ig key token host host-tld last-time expired-time) engine 63 | (if (and token key ig last-time (not gt-bing-token-maybe-invalid) 64 | (< (- (time-to-seconds) last-time) expired-time)) 65 | (funcall done) 66 | (gt-request :url (concat host "/translator") 67 | :done (lambda (raw) 68 | (with-temp-buffer 69 | (insert raw) 70 | (goto-char (point-min)) 71 | (re-search-forward "IG:\"\\([A-Za-z0-9]+\\)\"") 72 | (setf ig (match-string 1)) 73 | (re-search-forward "curUrl=\"\\(http[a-z]*\\).*?\\([a-zA-Z]+\\.bing.com\\)") 74 | (setf host-tld (concat (match-string 1) "://" (match-string 2))) 75 | (re-search-forward "var params_AbusePreventionHelper = \\[\\([0-9]+\\), *\"\\([^\"]+\\)") 76 | (setf key (match-string 1) token (match-string 2)) 77 | (setf last-time (time-to-seconds)) 78 | (setq gt-bing-token-maybe-invalid nil) 79 | (gt-log 'bing (format "url: %s\nkey: %s\ntoken: %s\nig: %s" host-tld key token ig)) 80 | (funcall done))) 81 | :fail (lambda (err) (user-error "[BING] Get Token failed. %s" err)))))) 82 | 83 | (cl-defmethod gt-translate ((engine gt-bing-engine) task next) 84 | (gt-bing-with-token engine 85 | (lambda () 86 | (with-slots (text src tgt res) task 87 | (with-slots (host-tld ig key token) engine 88 | (gt-request :url (format "%s/ttranslatev3?isVertical=1&IID=translator.5022.1&IG=%s" host-tld ig) 89 | :headers `(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8")) 90 | :data `(("fromLang" . ,(gt-bing-get-lang src)) 91 | ("to" . ,(gt-bing-get-lang tgt)) 92 | ("text" . ,text) 93 | ("key" . ,key) 94 | ("token" . ,token)) 95 | :done (lambda (raw) 96 | (setf res raw) 97 | (funcall next task)) 98 | :fail (lambda (err) 99 | (gt-fail task 100 | (pcase (car-safe (cdr-safe err)) 101 | (429 "[429] Too many requests! Please try later") 102 | (_ err)))))))))) 103 | 104 | (cl-defmethod gt-parse ((_ gt-bing-parser) task) 105 | (with-slots (res err) task 106 | (if-let* ((json (json-read-from-string (decode-coding-string res 'utf-8))) 107 | (result (ignore-errors (cdr (assoc 'text (aref (cdr (assoc 'translations (aref json 0))) 0)))))) 108 | (setf res result) 109 | (setq gt-bing-token-maybe-invalid t) ; refresh token when error occurred 110 | (setf err res) 111 | (error "error %s" res)))) 112 | 113 | 114 | ;;; Text to Speech 115 | 116 | (defcustom gt-bing-tts-speed 1.0 117 | "Playing speed of TTS audio, 1.0 is normal speed." 118 | :type 'number 119 | :group 'go-translate-bing) 120 | 121 | (defvar gt-bing-tts-mapping '((zh . ("zh-CN" "Female" "zh-CN-XiaoxiaoNeural")) 122 | (en . ("en-US" "Female" "en-US-AriaNeural")) 123 | (af . ("af-ZA" "Female" "af-ZA-AdriNeural")) 124 | (am . ("am-ET" "Female" "am-ET-MekdesNeural")) 125 | (ar . ("ar-SA" "Male" "ar-SA-HamedNeural")) 126 | (bn . ("bn-IN" "Female" "bn-IN-TanishaaNeural")) 127 | (bg . ("bg-BG" "Male" "bg-BG-BorislavNeural")) 128 | (ca . ("ca-ES" "Female" "ca-ES-JoanaNeural")) 129 | (cs . ("cs-CZ" "Male" "cs-CZ-AntoninNeural")) 130 | (cy . ("cy-GB" "Female" "cy-GB-NiaNeural")) 131 | (da . ("da-DK" "Female" "da-DK-ChristelNeural")) 132 | (de . ("de-DE" "Female" "de-DE-KatjaNeural")) 133 | (el . ("el-GR" "Male" "el-GR-NestorasNeural")) 134 | (es . ("es-ES" "Female" "es-ES-ElviraNeural")) 135 | (et . ("et-EE" "Female" "et-EE-AnuNeural")) 136 | (fa . ("fa-IR" "Female" "fa-IR-DilaraNeural")) 137 | (fi . ("fi-FI" "Female" "fi-FI-NooraNeural")) 138 | (fr . ("fr-FR" "Female" "fr-FR-DeniseNeural")) 139 | (ga . ("ga-IE" "Female" "ga-IE-OrlaNeural")) 140 | (gu . ("gu-IN" "Female" "gu-IN-DhwaniNeural")) 141 | (he . ("he-IL" "Male" "he-IL-AvriNeural")) 142 | (hi . ("hi-IN" "Female" "hi-IN-SwaraNeural")) 143 | (hr . ("hr-HR" "Male" "hr-HR-SreckoNeural")) 144 | (hu . ("hu-HU" "Male" "hu-HU-TamasNeural")) 145 | (id . ("id-ID" "Male" "id-ID-ArdiNeural")) 146 | (is . ("is-IS" "Female" "is-IS-GudrunNeural")) 147 | (it . ("it-IT" "Male" "it-IT-DiegoNeural")) 148 | (ja . ("ja-JP" "Female" "ja-JP-NanamiNeural")) 149 | (kk . ("kk-KZ" "Female" "kk-KZ-AigulNeural")) 150 | (km . ("km-KH" "Female" "km-KH-SreymomNeural")) 151 | (kn . ("kn-IN" "Female" "kn-IN-SapnaNeural")) 152 | (ko . ("ko-KR" "Female" "ko-KR-SunHiNeural")) 153 | (lo . ("lo-LA" "Female" "lo-LA-KeomanyNeural")) 154 | (lv . ("lv-LV" "Female" "lv-LV-EveritaNeural")) 155 | (lt . ("lt-LT" "Female" "lt-LT-OnaNeural")) 156 | (mk . ("mk-MK" "Female" "mk-MK-MarijaNeural")) 157 | (ml . ("ml-IN" "Female" "ml-IN-SobhanaNeural")) 158 | (mr . ("mr-IN" "Female" "mr-IN-AarohiNeural")) 159 | (ms . ("ms-MY" "Male" "ms-MY-OsmanNeural")) 160 | (mt . ("mt-MT" "Female" "mt-MT-GraceNeural")) 161 | (my . ("my-MM" "Female" "my-MM-NilarNeural")) 162 | (nl . ("nl-NL" "Female" "nl-NL-ColetteNeural")) 163 | (nb . ("nb-NO" "Female" "nb-NO-PernilleNeural")) 164 | (pl . ("pl-PL" "Female" "pl-PL-ZofiaNeural")) 165 | (ps . ("ps-AF" "Female" "ps-AF-LatifaNeural")) 166 | (pt . ("pt-BR" "Female" "pt-BR-FranciscaNeural")) 167 | (ro . ("ro-RO" "Male" "ro-RO-EmilNeural")) 168 | (ru . ("ru-RU" "Female" "ru-RU-DariyaNeural")) 169 | (sk . ("sk-SK" "Male" "sk-SK-LukasNeural")) 170 | (sl . ("sl-SI" "Male" "sl-SI-RokNeural")) 171 | (sv . ("sv-SE" "Female" "sv-SE-SofieNeural")) 172 | (ta . ("ta-IN" "Female" "ta-IN-PallaviNeural")) 173 | (te . ("te-IN" "Male" "te-IN-ShrutiNeural")) 174 | (th . ("th-TH" "Male" "th-TH-NiwatNeural")) 175 | (tr . ("tr-TR" "Female" "tr-TR-EmelNeural")) 176 | (uk . ("uk-UA" "Female" "uk-UA-PolinaNeural")) 177 | (ur . ("ur-IN" "Female" "ur-IN-GulNeural")) 178 | (uz . ("uz-UZ" "Female" "uz-UZ-MadinaNeural")) 179 | (vi . ("vi-VN" "Male" "vi-VN-NamMinhNeural")) 180 | (yue . ("zh-HK" "Female" "zh-HK-HiuGaaiNeural")))) 181 | 182 | (cl-defmethod gt-bing-tts-payload (lang text) 183 | (let ((lm (assoc lang gt-bing-tts-mapping))) 184 | (unless lm (user-error "Add the mapping of your language into `gt-bing-tts-langs-mapping' :)")) 185 | (format "%s" 186 | (cadr lm) (caddr lm) (cadr lm) (cadddr lm) 187 | gt-bing-tts-speed (encode-coding-string text 'utf-8)))) 188 | 189 | (cl-defmethod gt-speak ((engine gt-bing-engine) text lang) 190 | (with-slots (host host-tld ig key token) engine 191 | (message "Requesting from %s for %s..." (or host-tld host) lang) 192 | (gt-bing-with-token engine 193 | (lambda () 194 | (gt-request :url (format "%s/tfettts?isVertical=1&IID=translator.5022.2&IG=%s" host-tld ig) 195 | :headers '(("content-type" . "application/x-www-form-urlencoded")) 196 | :data `(("token" . ,token) ("key" . ,key) ("ssml" . ,(gt-bing-tts-payload lang text))) 197 | :cache (length text) 198 | :done #'gt-play-audio 199 | :fail (lambda (err) (message "[BING-TTS] error in request, %s" err))))))) 200 | 201 | (provide 'gt-engine-bing) 202 | 203 | ;;; gt-engine-bing.el ends here 204 | -------------------------------------------------------------------------------- /gt-engine-chatgpt.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-chatgpt.el --- Engine for ChatGPT -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; https://platform.openai.com/docs/api-reference 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-extension) 30 | 31 | (defgroup go-translate-chatgpt nil 32 | "Configs for ChatGPT engine." 33 | :group 'go-translate) 34 | 35 | 36 | ;;; Components 37 | 38 | (defclass gt-chatgpt-engine (gt-engine) 39 | ((tag :initform 'ChatGPT) 40 | (host :initarg :host :initform nil) 41 | (path :initarg :path :initform nil) 42 | (model :initarg :model :initform nil) 43 | (temperature :initarg :temperature :initform nil) 44 | (key :initarg :key :initform 'apikey 45 | :documentation "The apikey of ChatGPT. 46 | Can also put into .authinfo file as: 47 | machine api.openai.com login apikey password ***"))) 48 | 49 | 50 | ;;; Translate 51 | 52 | (defcustom gt-chatgpt-host "https://api.openai.com" 53 | "API host of ChatGPT." 54 | :type 'string 55 | :group 'go-translate-chatgpt) 56 | 57 | (defcustom gt-chatgpt-path "/v1/chat/completions" 58 | "API endpoint of ChatGPT." 59 | :type 'string 60 | :group 'go-translate-chatgpt) 61 | 62 | (defcustom gt-chatgpt-key nil 63 | "Auth Key of ChatGPT. Recommend to save in .authinfo file instead." 64 | :type 'string 65 | :group 'go-translate-chatgpt) 66 | 67 | (defcustom gt-chatgpt-model "gpt-3.5-turbo" 68 | "Model to be used in chat." 69 | :type 'string 70 | :group 'go-translate-chatgpt) 71 | 72 | (defcustom gt-chatgpt-temperature 0.8 73 | "Temperature of ChatGPT." 74 | :type 'number 75 | :group 'go-translate-chatgpt) 76 | 77 | (defcustom gt-chatgpt-system-prompt "You are a translation assistant" 78 | "System prompt send to server when translation." 79 | :type 'string 80 | :group 'go-translate-chatgpt) 81 | 82 | (defcustom gt-chatgpt-user-prompt-template "Translate the text to %s, text is: \n%s" 83 | "Template for user prompt when translation. 84 | When it is string, %s is placeholders of lang and text. 85 | When it is function, arguments passed to it should be text and lang." 86 | :type '(choice string function) 87 | :group 'go-translate-chatgpt) 88 | 89 | (declare-function pulse-momentary-highlight-region "pulse") 90 | 91 | (defvar gt-chatgpt-streaming-finished-hook #'pulse-momentary-highlight-region 92 | "The logic runs after all streams finished. 93 | With two arguments BEG and END, which are the marker bounds of the result.") 94 | 95 | (cl-defmethod gt-ensure-key ((engine gt-chatgpt-engine)) 96 | (with-slots (host key) engine 97 | (unless (stringp key) 98 | (if-let* ((apikey (or (gt-lookup-password 99 | :user (if key (format "%s" key) "apikey") 100 | :host (url-host (url-generic-parse-url (or host gt-chatgpt-host)))) 101 | gt-chatgpt-key))) 102 | (setf key apikey) 103 | (user-error "You should provide a apikey for gt-chatgpt-engine"))))) 104 | 105 | (cl-defmethod gt-translate ((engine gt-chatgpt-engine) task next) 106 | (gt-ensure-key engine) 107 | (with-slots (text src tgt res translator markers) task 108 | (with-slots (host path key model temperature stream) engine 109 | (when (and stream (cdr (oref translator text))) 110 | (user-error "Multiple parts not support streaming")) 111 | (gt-request :url (concat (or host gt-chatgpt-host) (or path gt-chatgpt-path)) 112 | :headers `(("Content-Type" . "application/json") 113 | ("Authorization" . ,(concat "Bearer " (encode-coding-string key 'utf-8)))) 114 | :data (encode-coding-string 115 | (json-encode 116 | `((model . ,(or model gt-chatgpt-model)) 117 | (temperature . ,(or temperature gt-chatgpt-temperature)) 118 | (stream . ,stream) 119 | (messages . [((role . system) 120 | (content . ,gt-chatgpt-system-prompt)) 121 | ((role . user) 122 | (content . ,(if (functionp gt-chatgpt-user-prompt-template) 123 | (funcall gt-chatgpt-user-prompt-template text tgt) 124 | (format gt-chatgpt-user-prompt-template (alist-get tgt gt-lang-codes) text))))]))) 125 | 'utf-8) 126 | :filter (when stream 127 | (lambda () 128 | (unless gt-tracking-marker 129 | (setq gt-tracking-marker (make-marker)) 130 | (set-marker gt-tracking-marker (point-min))) 131 | (goto-char gt-tracking-marker) 132 | (condition-case err 133 | (while (re-search-forward "^data: +\\({.+}\\)" nil t) 134 | (let* ((json (json-read-from-string (decode-coding-string (match-string 1) 'utf-8))) 135 | (choice (aref (alist-get 'choices json) 0)) 136 | (content (alist-get 'content (alist-get 'delta choice))) 137 | (finish (alist-get 'finish_reason choice))) 138 | (if finish 139 | (progn (message "") 140 | (when gt-chatgpt-streaming-finished-hook 141 | (with-current-buffer (marker-buffer (car markers)) 142 | (funcall gt-chatgpt-streaming-finished-hook (car markers) (cdr markers))))) 143 | (setf res (concat res content)) 144 | (set-marker gt-tracking-marker (point)) 145 | (unless (string-blank-p (concat res)) 146 | (funcall next task))))) 147 | (error (unless (string-prefix-p "json" (format "%s" (car err))) 148 | (signal (car err) (cdr err))))))) 149 | :done (unless stream 150 | (lambda (raw) 151 | (with-slots (res) task 152 | (let* ((json (json-read-from-string raw)) 153 | (str (alist-get 'content (alist-get 'message (let-alist json (aref .choices 0)))))) 154 | (setf res str)) 155 | (funcall next task)))) 156 | :fail (lambda (err) (gt-fail task err)))))) 157 | 158 | (cl-defmethod gt-stream-p ((engine gt-chatgpt-engine)) 159 | (oref engine stream)) 160 | 161 | 162 | ;;; Text to Speech 163 | 164 | (defcustom gt-chatgpt-tts-model "tts-1" 165 | "Model used by TTS of ChatGPT." 166 | :type 'string 167 | :group 'go-translate-chatgpt) 168 | 169 | (defcustom gt-chatgpt-tts-speed 1.0 170 | "Speech speed of return audio from ChatGPT." 171 | :type 'number 172 | :group 'go-translate-chatgpt) 173 | 174 | (defcustom gt-chatgpt-tts-voice "alloy" 175 | "Which voice to use by ChatGPT Speech. 176 | alloy, echo, fable, onyx, nova, or shimmer." 177 | :type 'string 178 | :group 'go-translate-chatgpt) 179 | 180 | (cl-defmethod gt-speak ((engine gt-chatgpt-engine) text _lang) 181 | (gt-ensure-key engine) 182 | (with-slots (host key) engine 183 | (gt-request :url (concat (or host gt-chatgpt-host) "/v1/audio/speech") 184 | :headers `(("Content-Type" . "application/json") 185 | ("Authorization" . ,(concat "Bearer " key))) 186 | :data (json-encode 187 | `((input . ,text) 188 | (model . ,gt-chatgpt-tts-model) 189 | (speed . ,gt-chatgpt-tts-speed) 190 | (voice . ,gt-chatgpt-tts-voice))) 191 | :done #'gt-play-audio 192 | :cache (length text)))) 193 | 194 | (provide 'gt-engine-chatgpt) 195 | 196 | ;;; gt-engine-chatgpt.el ends here 197 | -------------------------------------------------------------------------------- /gt-engine-deepl.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-deepl.el --- Translate Engine for DeepL -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; https://www.deepl.com 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-extension) 30 | 31 | (defgroup go-translate-deepl nil 32 | "Configs for DeepL engine." 33 | :group 'go-translate) 34 | 35 | 36 | ;;; Components 37 | 38 | (defclass gt-deepl-parser (gt-parser) ()) 39 | 40 | (defclass gt-deepl-engine (gt-engine) 41 | ((tag :initform 'DeepL) 42 | (host :initform "https://api.deepl.com") 43 | (host-free :initform "https://api-free.deepl.com") 44 | (path :initform "/v2/translate") 45 | (parse :initform (gt-deepl-parser)) 46 | 47 | (pro :initform nil 48 | :initarg :pro 49 | :documentation "Set t when use PRO version.") 50 | 51 | (key :initform 'auth-key 52 | :initarg :key 53 | :documentation "The auth-key of DeepL. 54 | You can also put it into .authinfo file as: 55 | machine api.deepl.com login auth-key password ***"))) 56 | 57 | 58 | ;;; Utils 59 | 60 | (defcustom gt-deepl-fill-enable t 61 | "Controller whether try to improve the input and output. 62 | Default behavior is removing excess linebreaks in input for better 63 | translation effect, and filling the output for better reading experience. 64 | You can override the behaviors by :around the method `gt-deepl-fill-input' 65 | or `gt-deepl-fill-output'." 66 | :type 'boolean 67 | :group 'go-translate-deepl) 68 | 69 | (cl-defmethod gt-deepl-fill-input (text) 70 | "Improve the input TEXT for better translation effect. 71 | Mainly remove excess linebreaks. I want to skip unfill on comments and codes, 72 | but don't know how to implement easily. To make it better later, maybe." 73 | (if gt-deepl-fill-enable 74 | (with-temp-buffer 75 | (insert text) 76 | (let ((fill-column (* 2 (point-max)))) 77 | (fill-region (point-min) (point-max))) 78 | (buffer-string)) 79 | text)) 80 | 81 | (cl-defmethod gt-deepl-fill-output (text) 82 | "Improve the output TEXT for better reading experience. 83 | Mainly fill the text to suitable length." 84 | (if gt-deepl-fill-enable 85 | (with-temp-buffer 86 | (insert text) 87 | (fill-region (point-min) (point-max)) 88 | (buffer-string)) 89 | text)) 90 | 91 | 92 | ;;; Engine 93 | 94 | (defcustom gt-deepl-extra-params '(("split_sentences" . "1") 95 | ("preserve_formatting" . "1")) 96 | "Extra translation params send to DeepL server." 97 | :type '(alist :key-type (string :tag "Key") 98 | :value-type (string :tag "Value")) 99 | :group 'go-translate-deepl) 100 | 101 | (defvar gt-deepl-langs-mapping '((en . "EN") 102 | (zh . "ZH") 103 | (de . "DE") ; German 104 | (fr . "FR") ; French 105 | (it . "IT") ; Italian 106 | (ja . "JA") ; Japanese 107 | (es . "ES") ; Spanish 108 | (nl . "NL") ; Dutch 109 | (pl . "PL") ; Polish 110 | (pt . "PT") ; Portuguese (all Portuguese varieties mixed) 111 | (ru . "RU") ; Russian 112 | )) 113 | 114 | (defun gt-deepl-get-lang (lang) 115 | (if-let* ((mapping (assoc lang gt-deepl-langs-mapping))) 116 | (cdr mapping) 117 | (user-error "Language %s is not supported by DeepL. 118 | Supported list: %s" lang (mapconcat #'car gt-deepl-langs-mapping ", ")))) 119 | 120 | (cl-defmethod gt-ensure-key ((engine gt-deepl-engine)) 121 | (with-slots (key) engine 122 | (unless (stringp key) 123 | (if-let* ((auth-key (gt-lookup-password 124 | :user (if key (format "%s" key) "auth-key") 125 | :host "api.deepl.com"))) 126 | (setf key auth-key) 127 | (user-error "You should provide a auth-key for gt-deepl-engine"))))) 128 | 129 | (cl-defmethod gt-translate ((engine gt-deepl-engine) task next) 130 | (gt-ensure-key engine) 131 | (with-slots (text src tgt res) task 132 | (with-slots (host host-free path pro key) engine 133 | (gt-request :url (concat (if pro host host-free) path) 134 | :headers `(("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8") 135 | ("Authorization" . ,(concat "DeepL-Auth-Key " key))) 136 | :data `(("text" . ,(gt-deepl-fill-input text)) 137 | ("target_lang" . ,(gt-deepl-get-lang tgt)) 138 | ,(if-let* ((src (gt-deepl-get-lang src))) `("source_lang" . ,src)) 139 | ,@gt-deepl-extra-params) 140 | :done (lambda (raw) 141 | (setf res raw) 142 | (funcall next task)) 143 | :fail (lambda (err) 144 | (gt-fail task (pcase (car-safe (cdr-safe err)) 145 | (403 "[403] Authorization failed. Please supply a valid auth_key parameter") 146 | (413 "[413] The request size exceeds the limit") 147 | (414 "[414] Request-URI Too Long") 148 | (429 "[429] Too many requests. Please wait and resend your request") 149 | (456 "[456] Quota exceeded. The character limit has been reached") 150 | (_ err)))))))) 151 | 152 | 153 | ;;; Parser 154 | 155 | (cl-defmethod gt-parse ((_ gt-deepl-parser) task) 156 | (with-slots (res meta) task 157 | (let* ((json (json-read-from-string res)) 158 | (str (decode-coding-string (mapconcat #'cdadr (cdar json) "\n") 'utf-8)) 159 | (hook (lambda (rs) (mapcar #'gt-deepl-fill-output rs)))) 160 | (setf res str meta (plist-put meta :res-hook hook))))) 161 | 162 | (provide 'gt-engine-deepl) 163 | 164 | ;;; gt-engine-deepl.el ends here 165 | -------------------------------------------------------------------------------- /gt-engine-echo.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-echo.el --- Echo Translate -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; For simple transform, and for test. 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-extension) 30 | 31 | (defclass gt-echo-engine (gt-engine) 32 | ((tag :initform 'Echo) 33 | (do :initform nil :initarg :do))) 34 | 35 | (cl-defmethod initialize-instance :after ((engine gt-echo-engine) &rest _) 36 | (with-slots (cache delimiter) engine 37 | (setf cache nil delimiter nil))) 38 | 39 | (cl-defmethod gt-translate ((engine gt-echo-engine) task next) 40 | (with-slots (text res) task 41 | (with-slots (do) engine 42 | (setf res text) 43 | (cl-labels ((process (sym) 44 | (cond ((eq sym 'clean) 45 | (setf res (mapcar #'substring-no-properties res))) 46 | ((eq sym 'br) 47 | (setf res (mapcar #'gt-prop-for-bionic-reading res))) 48 | ((functionp sym) 49 | (setf res (funcall sym res))) 50 | ((consp sym) 51 | (cl-loop for o in sym do (process o)))))) 52 | (process do) 53 | (funcall next task))))) 54 | 55 | 56 | 57 | (defun gt-prop-for-bionic-reading (text) 58 | (with-temp-buffer 59 | (insert text) 60 | (goto-char (point-min)) 61 | (skip-chars-forward " \t\n\r\f") 62 | (while (forward-word) 63 | (cl-destructuring-bind (beg . end) (bounds-of-thing-at-point 'word) 64 | (setq end (+ beg (/ (- end beg) 2))) 65 | (put-text-property beg end 'font-lock-face 'gt-bionic-reading-face))) 66 | (buffer-string))) 67 | 68 | (provide 'gt-engine-echo) 69 | 70 | ;;; gt-engine-echo.el ends here 71 | -------------------------------------------------------------------------------- /gt-engine-google-rpc.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-google-rpc.el --- Google translation with RPC API -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; http://translate.google.com, new RPC API 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-engine-google) 30 | 31 | (defgroup go-translate-google-rpc nil 32 | "Configs for GoogleRPC engine." 33 | :group 'go-translate) 34 | 35 | (defcustom gt-google-rpc-host "https://translate.google.com" 36 | "The base url of Google translate used by google-rpc engine. 37 | you can customize it according to your country region." 38 | :type 'string 39 | :group 'go-translate-google-rpc) 40 | 41 | 42 | ;;; Components 43 | 44 | (defclass gt-google-rpc-parser (gt-google-parser) 45 | ((tag :initform "Detail"))) 46 | 47 | (defclass gt-google-rpc-summary-parser (gt-google-summary-parser gt-google-rpc-parser) 48 | ((tag :initform "Summary"))) 49 | 50 | (defclass gt-google-rpc-engine (gt-engine) 51 | ((tag :initform 'GoogleRPC) 52 | (host :initform nil) 53 | (path :initform "/_/TranslateWebserverUi/data/batchexecute") 54 | (parse :initform (gt-google-rpc-parser)) 55 | 56 | (rpc-translate :initform "MkEWBc") 57 | (rpc-tts :initform "jQ1olc") 58 | (rpc-sid :initform "FdrFJe") 59 | (rpc-bl :initform "cfb2h"))) 60 | 61 | 62 | ;;; Engine 63 | 64 | (defcustom gt-google-rpc-request-headers 65 | '(("Connection" . "Keep-Alive") 66 | ("Content-Type" . "application/x-www-form-urlencoded;charset=UTF-8")) 67 | "Extra request headers send to google-rpc server." 68 | :type '(alist :key-type (string :tag "Key") :value-type (string :tag "Value")) 69 | :group 'go-translate-google-rpc) 70 | 71 | (defun gt-google-rpc-with-token (engine done fail) 72 | (declare (indent 1)) 73 | (with-slots (host path rpc-sid rpc-bl) engine 74 | (gt-request :url (or host gt-google-rpc-host) 75 | :done (lambda (raw) 76 | (with-temp-buffer 77 | (insert raw) 78 | (goto-char (point-min)) 79 | (let* ((f-sid (progn 80 | (re-search-forward (format "\"%s\":\"\\([^\"]*\\)\"" rpc-sid)) 81 | (match-string 1))) 82 | (bl (progn (re-search-forward (format "\"%s\":\"\\([^\"]*\\)\"" rpc-bl)) 83 | (match-string 1))) 84 | (url-tpl (lambda (rpcid lang) 85 | (format "%s%s?%s" (or host gt-google-rpc-host) path 86 | (gt-format-params 87 | `(("rpcids" . ,rpcid) 88 | ("f.sid" . ,f-sid) 89 | ("bl" . ,bl) 90 | ("hl" . ,lang) 91 | ("soc-app" . 1) 92 | ("soc-platform" . 1) 93 | ("soc-device" . 1) 94 | ("_reqid" . ,(+ 1000 (random 9000))) 95 | ("rt" . "c"))))))) 96 | (funcall done url-tpl)))) 97 | :fail fail))) 98 | 99 | (cl-defmethod gt-translate ((engine gt-google-rpc-engine) task next) 100 | (gt-google-rpc-with-token engine 101 | (lambda (url-tpl) 102 | (with-slots (text src tgt res) task 103 | (with-slots (rpc-translate) engine 104 | (gt-request :url (funcall url-tpl rpc-translate tgt) 105 | :headers gt-google-rpc-request-headers 106 | :data (format 107 | "f.req=%s&" 108 | (url-hexify-string 109 | (json-encode `[[[,rpc-translate ,(json-encode `[[,text ,src ,tgt 1][]]) nil "generic"]]]))) 110 | :done (lambda (raw) (setf res raw) (funcall next task)) 111 | :fail (lambda (err) (gt-fail task err)))))) 112 | (lambda (err) 113 | (gt-fail task (format "Take token failed, %s" err))))) 114 | 115 | (cl-defmethod gt-speak ((engine gt-google-rpc-engine) text lang) 116 | (with-slots (host rpc-tts) engine 117 | (message "Requesting %s for %s..." (or host gt-google-rpc-host) lang) 118 | (gt-google-rpc-with-token engine 119 | (lambda (url-tpl) 120 | (gt-request :url (funcall url-tpl rpc-tts "en-US") 121 | :headers gt-google-rpc-request-headers 122 | :data (format 123 | "f.req=%s&" 124 | (url-hexify-string 125 | (json-encode `[[[,rpc-tts ,(json-encode `[,text ,lang nil "undefined" [0]]) nil "generic"]]]))) 126 | :done (lambda (raw) 127 | (with-temp-buffer 128 | (insert raw) 129 | (goto-char (point-min)) 130 | (let (beg end json code) 131 | (re-search-forward "^[0-9]+$") 132 | (setq beg (point)) 133 | (re-search-forward "^\\([0-9]+\\)$") 134 | (setq end (- (point) (length (match-string 1)))) 135 | (setq json (json-read-from-string (string-trim (buffer-substring-no-properties beg end)))) 136 | (if-let* ((data (and (string= (gt-aref json 0 0) "wrb.fr") (gt-aref json 0 2)))) 137 | (progn (setq code (aref (json-read-from-string data) 0)) 138 | (erase-buffer) 139 | (insert code) 140 | (base64-decode-region (point-min) (point-max)) 141 | (gt-play-audio (current-buffer))) 142 | (message "[GoogleRPC-TTS] No tts data responsed"))))) 143 | :fail (lambda (err) (message "[GoogleRPC-TTS] Error, %s" err)))) 144 | (lambda (err) (message "[GoogleRPC-TTS] Take token failed, %s" err))))) 145 | 146 | 147 | ;;; Parser 148 | 149 | (cl-defmethod gt-resp-to-json ((_ gt-google-rpc-parser) resp) 150 | "Convert the buffer RESP into JSON format." 151 | (condition-case err 152 | (with-temp-buffer 153 | (let (beg end str json) 154 | (insert resp) 155 | (goto-char (point-min)) 156 | (re-search-forward "^[0-9]+$") 157 | (setq beg (point)) 158 | (re-search-forward "^\\([0-9]+\\)$") 159 | (setq end (- (point) (length (match-string 1)))) 160 | (setq str 161 | (decode-coding-string 162 | (string-trim (buffer-substring-no-properties beg end)) 163 | 'utf-8)) 164 | (setq json (json-read-from-string str)) 165 | (if (string= (aref (aref json 0) 0) "wrb.fr") 166 | (let ((json-str (aref (aref json 0) 2))) 167 | (json-read-from-string json-str)) 168 | (error "No results found")))) 169 | (error (user-error "Result conversion error (%s)" err)))) 170 | 171 | (cl-defmethod gt-result--brief ((_ gt-google-rpc-parser) json) 172 | "Get the translation text from JSON." 173 | (mapconcat 174 | (lambda (item) 175 | (if (ignore-errors (aref item 2)) 176 | (format " %s" (aref item 0)) 177 | (aref item 0))) 178 | (gt-aref json 1 0 0 5) 179 | "")) 180 | 181 | (cl-defmethod gt-result--sphonetic ((_ gt-google-rpc-parser) json) 182 | "Get the text phonetic from JSON." 183 | (gt-aref json 0 0)) 184 | 185 | (cl-defmethod gt-result--tphonetic ((_ gt-google-rpc-parser) json) 186 | "Get the translation phonetic from JSON." 187 | (gt-aref json 1 0 0 1)) 188 | 189 | (cl-defmethod gt-result--details ((_ gt-google-rpc-parser) json) 190 | "Get the details from JSON. 191 | Result style: ((noun (a (x y z))) (verb (b (m n o))))." 192 | (cl-loop with dts = (ignore-errors (gt-aref json 3 5 0)) 193 | for i across dts 194 | collect 195 | (cons 196 | (aref i 0) 197 | (cl-loop for j across (aref i 1) 198 | collect 199 | (cons 200 | (aref j 0) 201 | (cl-loop for k across (aref j 2) collect k)))))) 202 | 203 | (cl-defmethod gt-result--definitions ((_ gt-google-rpc-parser) json) 204 | "Get the definitions from JSON. 205 | Result style: ((noun (a b)) (verb (c d)))." 206 | (cl-loop with defs = (ignore-errors (gt-aref json 3 1 0)) 207 | for i across defs 208 | collect 209 | (cons 210 | (aref i 0) 211 | (cl-loop for j across (aref i 1) 212 | collect 213 | (cons (aref j 0) 214 | (ignore-errors (aref j 1))))))) 215 | 216 | (cl-defmethod gt-result--suggestion ((_ gt-google-rpc-parser) json) 217 | "Get the suggestion from JSON." 218 | (ignore-errors 219 | (replace-regexp-in-string "\\|\\|\\|" "" (gt-aref json 0 1 0 0 1)))) 220 | 221 | (provide 'gt-engine-google-rpc) 222 | 223 | ;;; gt-engine-google-rpc.el ends here 224 | -------------------------------------------------------------------------------- /gt-engine-google.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-google.el --- Google translate -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; http://translate.google.com 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-extension) 30 | 31 | (defgroup go-translate-google nil 32 | "Configs for Google engine." 33 | :group 'go-translate) 34 | 35 | (defcustom gt-google-host "http://translate.googleapis.com" 36 | "The base url of Google translate used by google engine. 37 | you can customize it according to your country region." 38 | :type 'string 39 | :group 'go-translate-google) 40 | 41 | 42 | ;;; Components 43 | 44 | (defclass gt-google-parser (gt-parser) 45 | ((tag :initform "Detail"))) 46 | 47 | (defclass gt-google-summary-parser (gt-google-parser) 48 | ((tag :initform "Summary"))) 49 | 50 | (defclass gt-google-engine (gt-engine) 51 | ((tag :initform 'Google) 52 | (host :initform nil) 53 | (path :initform "/translate_a/single") 54 | (token :initform (cons 430675 2721866130) :initarg token) ; hard code 55 | (token-time :initform t) 56 | (token-expired-time :initform (* 30 60)) 57 | (parse :initform (gt-google-parser)))) 58 | 59 | 60 | ;;; Engine 61 | 62 | (defcustom gt-google-request-headers '(("Connection" . "Keep-Alive")) 63 | "Extra request headers send to google server." 64 | :type '(alist :key-type (string :tag "Key") :value-type (string :tag "Value")) 65 | :group 'go-translate-google) 66 | 67 | (defun gt-google-gen-url (engine text src tgt) 68 | "Generate url for google ENGINE with TEXT, SRC and TGT." 69 | (with-slots (host path token) engine 70 | (format "%s%s?%s" 71 | (or host gt-google-host) path 72 | (mapconcat (lambda (p) 73 | (format "%s=%s" 74 | (url-hexify-string (car p)) 75 | (url-hexify-string (format "%s" (cdr p))))) 76 | `(("client" . "gtx") 77 | ("ie" . "UTF-8") 78 | ("oe" . "UTF-8") 79 | ("dt" . "bd") 80 | ("dt" . "ex") 81 | ("dt" . "ld") 82 | ("dt" . "md") 83 | ("dt" . "qc") 84 | ("dt" . "rw") 85 | ("dt" . "rm") 86 | ("dt" . "ss") 87 | ("dt" . "t") 88 | ("dt" . "at") 89 | ("pc" . "1") 90 | ("otf" . "1") 91 | ("srcrom" . "1") 92 | ("ssel" . "0") 93 | ("tsel" . "0") 94 | ("q" . ,text) 95 | ("sl" . ,src) 96 | ("tl" . ,tgt) 97 | ("hl" . ,tgt) 98 | ("tk" . ,(gt-google-tkk token text))) 99 | "&")))) 100 | 101 | (defun gt-google-token-available-p (engine) 102 | (with-slots (token token-time token-expired-time) engine 103 | (and token 104 | (or (eq token-time t) 105 | (and token-time 106 | (<= (float-time (time-subtract (current-time) token-time)) 107 | token-expired-time)))))) 108 | 109 | (defun gt-google-with-token (engine done fail) 110 | (declare (indent 1)) 111 | (with-slots (host token token-time) engine 112 | (if (gt-google-token-available-p engine) 113 | (funcall done) 114 | (gt-request :url (or host gt-google-host) 115 | :headers gt-google-request-headers 116 | :done (lambda (raw) 117 | (with-temp-buffer 118 | (insert raw) 119 | (goto-char (point-min)) 120 | (let ((tk (progn 121 | (re-search-forward ",tkk:'\\([0-9]+\\)\\.\\([0-9]+\\)") 122 | (cons (string-to-number (match-string 1)) 123 | (string-to-number (match-string 2)))))) 124 | (setf token tk) 125 | (setf token-time (current-time)) 126 | (funcall done)))) 127 | :fail fail)))) 128 | 129 | (cl-defmethod gt-translate ((engine gt-google-engine) task next) 130 | (gt-google-with-token engine 131 | (lambda () 132 | (with-slots (text src tgt res) task 133 | (gt-request :url (gt-google-gen-url engine text src tgt) 134 | :headers gt-google-request-headers 135 | :done (lambda (raw) (setf res raw) (funcall next task)) 136 | :fail (lambda (err) (gt-fail task err))))) 137 | (lambda (err) 138 | (gt-fail task (format "Take token failed, %s" err))))) 139 | 140 | ;; tts 141 | 142 | (defun gt-google-tts-split-text (text) 143 | "Split TEXT by maxlen at applicable point for translating. 144 | Code from `google-translate', maybe improve it someday." 145 | (let (result (maxlen 200)) 146 | (if (or (null maxlen) (<= maxlen 0)) 147 | (push text result) 148 | ;; split long text? 149 | (with-temp-buffer 150 | (save-excursion (insert text)) 151 | ;; strategy to split at applicable point 152 | ;; 1) fill-region remaining text by maxlen 153 | ;; 2) find end of sentence, end of punctuation, word boundary 154 | ;; 3) consume from remaining text between start and (2) 155 | ;; 4) repeat 156 | (let ((fill-column (* maxlen 3)) 157 | (sentence-end-double-space nil) 158 | (pos (point-min))) 159 | (while (< pos (point-max)) 160 | (save-restriction 161 | (narrow-to-region pos (point-max)) 162 | (fill-region pos (point-max)) 163 | (let ((limit (+ pos maxlen))) 164 | (if (>= limit (point-max)) 165 | (setq limit (point-max)) 166 | (goto-char limit) 167 | ;; try to split at end of sentence 168 | (if (> (backward-sentence) pos) 169 | (setq limit (point)) 170 | ;; try to split at end of punctuation 171 | (goto-char limit) 172 | (if (re-search-backward "[,、]" pos t) 173 | (setq limit (1+ (point))) ; include punctuation 174 | (goto-char limit) 175 | ;; try to split at word boundary 176 | (forward-word-strictly -1) 177 | (when (> (point) pos) 178 | (setq limit (point)))))) 179 | (push (buffer-substring-no-properties pos limit) result) 180 | (goto-char limit) 181 | (setq pos limit))))))) 182 | (reverse result))) 183 | 184 | (cl-defmethod gt-speak ((engine gt-google-engine) text lang) 185 | (message "Requesting from %s for %s..." (or (oref engine host) gt-google-host) lang) 186 | (cl-loop with texts = (gt-google-tts-split-text text) 187 | with total = (length texts) 188 | for c in texts 189 | for i from 0 190 | for ps = `(("ie" . "UTF-8") 191 | ("client" . "gtx") 192 | ("prev" . "input") 193 | ("tl" . ,lang) 194 | ("q" . ,(string-trim c)) 195 | ("total" . ,total) 196 | ("idx" . ,i) 197 | ("textlen" . ,(length c)) 198 | ("tk" . ,(gt-google-tkk (oref engine token) c))) 199 | for url = (format "%s/translate_tts?%s" 200 | (or (oref engine host) gt-google-host) 201 | (mapconcat (lambda (p) 202 | (format "%s=%s" (url-hexify-string (car p)) (url-hexify-string (format "%s" (cdr p))))) 203 | ps "&")) 204 | do (gt-play-audio url 'wait))) 205 | 206 | 207 | ;;; Parser 208 | 209 | ;; detail-mode, use as default 210 | 211 | (cl-defmethod gt-parse ((parser gt-google-parser) task) 212 | (with-slots (res translator) task 213 | (let* ((json (gt-resp-to-json parser res)) 214 | (brief-result (gt-result--brief parser json))) 215 | (if (cdr (oref translator text)) ; multi-parts 216 | (setf res (string-trim (gt-result--brief parser json) "\n+")) 217 | (let* ((sphonetic (gt-result--sphonetic parser json)) 218 | (tphonetic (gt-result--tphonetic parser json)) 219 | (details (gt-result--details parser json)) 220 | (definitions (gt-result--definitions parser json)) 221 | (suggestion (gt-result--suggestion parser json)) 222 | (suggestionp (> (length suggestion) 0)) pt) 223 | (cl-flet ((phonetic (ph) 224 | (if (and (or definitions definitions) (> (length ph) 0)) 225 | (propertize (format " [%s]" ph) 'face 'gt-google-buffer-phonetic-face) 226 | "")) 227 | (headline (line) 228 | (propertize (format "[%s]\n" line) 'face 'gt-google-buffer-headline-face))) 229 | (with-temp-buffer 230 | ;; suggestion 231 | (when suggestionp 232 | (insert (propertize "Do you mean:" 'face 'gt-google-buffer-suggestion-desc-face) " " 233 | (propertize suggestion 'face 'gt-google-buffer-suggestion-text-face) "?\n\n")) 234 | ;; phonetic & translate 235 | (if (or details definitions) 236 | (progn 237 | (insert (if suggestionp suggestion 238 | (setq pt (point)) 239 | (substring-no-properties (oref task text)))) 240 | (insert (phonetic sphonetic) " ") 241 | (insert (propertize brief-result 'face 'gt-google-buffer-brief-result-face)) 242 | (insert (phonetic tphonetic) "\n\n")) 243 | (insert brief-result)) 244 | ;; details 245 | (when details 246 | (insert (headline "Details")) 247 | (cl-loop for (label . items) in details 248 | unless (= 0 (length label)) 249 | do (insert (format "\n%s:\n" label)) 250 | do (cl-loop with index = 0 251 | for trans in items 252 | do (insert 253 | (format "%2d. " (cl-incf index)) 254 | (car trans) 255 | " (" (mapconcat #'identity (cdr trans) ", ") ")" 256 | "\n"))) 257 | (insert "\n")) 258 | ;; definitions 259 | (when definitions 260 | (insert (headline "Definitions")) 261 | (cl-loop for (label . items) in definitions 262 | unless (= 0 (length label)) 263 | do (insert (format "\n%s:\n" label)) 264 | do (cl-loop with index = 0 265 | for (exp . eg) in items 266 | do (insert (format "%2d. " (cl-incf index)) exp) 267 | when (> (length eg) 0) 268 | do (insert 269 | "\n > " 270 | (propertize (or eg "") 'face 'gt-google-buffer-detail-demo-face)) 271 | do (insert "\n")))) 272 | ;; at last, return 273 | (add-text-properties (point-min) (point-max) (list 'gt-mark pt 'gt-brief brief-result)) 274 | (setf res (buffer-string))))))))) 275 | 276 | ;; summary-mode 277 | 278 | (cl-defmethod gt-parse ((parser gt-google-summary-parser) task) 279 | (let* ((json (gt-resp-to-json parser (oref task res))) 280 | (result (string-trim (gt-result--brief parser json) "\n+"))) 281 | (oset task res result))) 282 | 283 | ;; Extract results from response 284 | 285 | (cl-defmethod gt-resp-to-json ((_ gt-google-parser) resp) 286 | "Convert the buffer RESP into JSON." 287 | (condition-case err 288 | (json-read-from-string (decode-coding-string resp 'utf-8)) 289 | (error (user-error "Result conversion error: %s" err)))) 290 | 291 | (cl-defmethod gt-result--brief ((_ gt-google-parser) json) 292 | "Get the translation text from JSON." 293 | (mapconcat (lambda (item) (aref item 0)) (aref json 0) "")) 294 | 295 | (cl-defmethod gt-result--sphonetic ((_ gt-google-parser) json) 296 | "Get the text phonetic from JSON." 297 | (mapconcat (lambda (item) (if (> (length item) 3) (aref item 3) "")) (aref json 0) "")) 298 | 299 | (cl-defmethod gt-result--tphonetic ((_ gt-google-parser) json) 300 | "Get the translation phonetic from JSON." 301 | (mapconcat (lambda (item) (if (> (length item) 2) (aref item 2) "")) (aref json 0) "")) 302 | 303 | (cl-defmethod gt-result--details ((_ gt-google-parser) json) 304 | "Get the details from JSON. 305 | Result style: ((noun (a (x y z))) (verb (b (m n o))))." 306 | (cl-loop for i across (aref json 1) 307 | collect 308 | (cons 309 | (aref i 0) 310 | (cl-loop for j across (aref i 2) 311 | collect 312 | (cons 313 | (aref j 0) 314 | (cl-loop for k across (aref j 1) collect k)))))) 315 | 316 | (cl-defmethod gt-result--definitions ((_ gt-google-parser) json) 317 | "Get the definitions from JSON. 318 | Result style: ((noun (a b)) (verb (c d)))." 319 | (cl-loop with defs = (ignore-errors (aref json 12)) 320 | for i across defs 321 | collect 322 | (cons 323 | (aref i 0) 324 | (cl-loop for j across (aref i 1) 325 | collect 326 | (cons 327 | (aref j 0) 328 | (ignore-errors (aref j 2))))))) 329 | 330 | (cl-defmethod gt-result--suggestion ((_ gt-google-parser) json) 331 | "Get the suggestion from JSON." 332 | (let ((info (aref json 7))) (unless (seq-empty-p info) (aref info 1)))) 333 | 334 | 335 | ;;; Token Key algorithm (deprecated) 336 | 337 | ;; This algorithm is from `google-translate' project. 338 | ;; https://github.com/atykhonov/google-translate/blob/master/google-translate-tk.el 339 | 340 | (defvar gt-google-token--bit-v-len 32) 341 | 342 | (defun gt-google-token--bit-v-2comp (v) 343 | "Return the two's complement of V." 344 | (let* ((vc (vconcat v)) 345 | (len (length vc))) 346 | ;; Complement of v 347 | (cl-loop for i from 0 below len do 348 | (aset vc i (logxor (aref vc i) 1))) 349 | ;; vc = complement of v + 1 350 | (cl-loop for i downfrom (1- len) to 0 351 | do (aset vc i (logxor (aref vc i) 1)) 352 | when (> (aref vc i) 0) return nil) 353 | vc)) 354 | 355 | (defun gt-google-token--number-to-bit-v (n) 356 | "Return a bit vector from N." 357 | (if (< n 0) (gt-google-token--bit-v-2comp 358 | (gt-google-token--number-to-bit-v (abs n))) 359 | (let ((v (make-vector gt-google-token--bit-v-len 0))) 360 | (cl-loop for i downfrom (1- gt-google-token--bit-v-len) to 0 361 | with q 362 | when (< n 1) return nil do 363 | (setq q (ffloor (* n 0.5))) 364 | (aset v i (floor (- n (* 2.0 q)))) 365 | (setq n q)) 366 | v))) 367 | 368 | (defun gt-google-token--bit-v-to-number (v) 369 | "Return a floating-point number from V." 370 | (if (and (> (aref v 0) 0) 371 | ;; Exclude [1 0 ... 0] 372 | (cl-loop for i from 1 below gt-google-token--bit-v-len 373 | thereis (> (aref v i) 0))) 374 | (- (gt-google-token--bit-v-to-number (gt-google-token--bit-v-2comp v))) 375 | (funcall (if (> (aref v 0) 0) #'- #'+) 376 | (cl-reduce (lambda (acc e) (+ (* acc 2.0) e)) 377 | v :initial-value 0.0)))) 378 | 379 | (defun gt-google-token--logfn (fn n1 n2) 380 | "Helper function for logical FN with N1 and N2." 381 | (let ((v1 (gt-google-token--number-to-bit-v n1)) 382 | (v2 (gt-google-token--number-to-bit-v n2)) 383 | (v (make-vector gt-google-token--bit-v-len 0))) 384 | (cl-loop for i from 0 below gt-google-token--bit-v-len do 385 | (aset v i (funcall fn (aref v1 i) (aref v2 i)))) 386 | (gt-google-token--bit-v-to-number v))) 387 | 388 | (defun gt-google-token--logand (n1 n2) 389 | "Return a floating-point number from N1 and N2." 390 | (gt-google-token--logfn #'logand n1 n2)) 391 | 392 | (defun gt-google-token--logxor (n1 n2) 393 | "Return a floating-point number from N1 and N2." 394 | (gt-google-token--logfn #'logxor n1 n2)) 395 | 396 | (defun gt-google-token--lsh (n d) 397 | "Return a floating-point number. 398 | Shift the bits in N to the left or rihgt D places. 399 | D is an integer." 400 | (let ((v (gt-google-token--number-to-bit-v n)) 401 | (v-result (make-vector gt-google-token--bit-v-len 0))) 402 | (if (< d 0) 403 | ;; Shift Right Logical 404 | (cl-loop for i from (abs d) below gt-google-token--bit-v-len 405 | for j from 0 do 406 | (aset v-result i (aref v j))) 407 | ;; Shift Left Logical 408 | (cl-loop for i from d below gt-google-token--bit-v-len 409 | for j from 0 do 410 | (aset v-result j (aref v i)))) 411 | (gt-google-token--bit-v-to-number v-result))) 412 | 413 | (defun gt-google-token--gen-rl (a b) 414 | "Gen rl from A and B." 415 | (cl-loop for c from 0 below (- (length b) 2) by 3 416 | for d = (aref b (+ c 2)) do 417 | (setq d (if (>= d ?a) (- d 87) (- d ?0))) 418 | (setq d (if (= (aref b (1+ c)) ?+) 419 | (gt-google-token--lsh a (- d)) 420 | (gt-google-token--lsh a d))) 421 | (setq a (if (= (aref b c) ?+) 422 | (gt-google-token--logand (+ a d) 4294967295.0) 423 | (gt-google-token--logxor a d)))) 424 | a) 425 | 426 | (defun gt-google-tkk (token text) 427 | "Calculate the TOKEN for search TEXT." 428 | (let* ((b (car token)) 429 | (d1 (cdr token)) 430 | (ub "+-3^+b+-f") 431 | (vb "+-a^+6") 432 | (a (cl-loop for c across (encode-coding-string text 'utf-8) 433 | for rr = (gt-google-token--gen-rl (+ (or rr b) c) vb) 434 | finally (return rr)))) 435 | (setq a (gt-google-token--gen-rl a ub)) 436 | (setq a (gt-google-token--logxor a d1)) 437 | (if (< a 0) (setq a (+ (gt-google-token--logand a 2147483647.0) 2147483648.0))) 438 | (setq a (ffloor (mod a 1e6))) 439 | (format "%s.%s" 440 | (car (split-string (number-to-string a) "\\.")) 441 | (car (split-string (number-to-string 442 | (gt-google-token--logxor a b)) 443 | "\\."))))) 444 | 445 | (provide 'gt-engine-google) 446 | 447 | ;;; gt-engine-google.el ends here 448 | -------------------------------------------------------------------------------- /gt-engine-libre.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-libre.el --- Engine for LibreTranslate -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; https://github.com/LibreTranslate/LibreTranslate 26 | ;; https://libretranslate.com/ 27 | 28 | ;;; Code: 29 | 30 | (require 'gt-extension) 31 | 32 | (defgroup go-translate-libre nil 33 | "Configs for LibreTranslate engine." 34 | :group 'go-translate) 35 | 36 | (defcustom gt-libre-host "https://translate.disroot.org/" 37 | "API host of LibreTranslate. 38 | 39 | The official host is: https://libretranslate.com/, you can config this 40 | to use third-party or your local service." 41 | :type 'string 42 | :group 'go-translate-libre) 43 | 44 | 45 | ;;; Components 46 | 47 | (defclass gt-libre-parser (gt-parser) ()) 48 | 49 | (defclass gt-libre-engine (gt-engine) 50 | ((tag :initform 'LibreTranslate) 51 | (host :initform nil :initarg :host) 52 | (path :initform "/translate") 53 | (parse :initform (gt-libre-parser)) 54 | (delimiter :initform "21597" 55 | ;; Any way to force specific segment not be changed after translate? 56 | ;; I don't know! Just set this a random number, to make it work...sometimes. 57 | ;; So this maybe failed in translating multiple parts text. 58 | ) 59 | (cache :initform nil) 60 | (key :initform 'api-key 61 | :initarg :key 62 | :documentation "The api-key of LibreTranslate. 63 | You can also put it into .authinfo file as: 64 | machine [HOST like libretranslate.com] login api-key password [***]"))) 65 | 66 | 67 | ;;; Translate 68 | 69 | (cl-defmethod gt-ensure-key ((engine gt-libre-engine)) 70 | (with-slots (host key) engine 71 | (unless (stringp key) 72 | (setf key 73 | (gt-lookup-password 74 | :user (if key (format "%s" key) "api-key") 75 | :host (url-host (url-generic-parse-url (or host gt-libre-host)))))))) 76 | 77 | (cl-defmethod gt-translate ((engine gt-libre-engine) task next) 78 | (gt-ensure-key engine) 79 | (with-slots (text src tgt res) task 80 | (with-slots (host path key) engine 81 | (gt-request :url (concat (or host gt-libre-host) path) 82 | :data `(("q" . ,text) 83 | ("source" . ,src) 84 | ("target" . ,tgt) 85 | ("format" . "text") 86 | ("alternatives" . 1) 87 | ,(if key `("api_key" . ,key))) 88 | :done (lambda (raw) 89 | (setf res raw) 90 | (funcall next task)) 91 | :fail (lambda (err) 92 | (gt-fail task err)))))) 93 | 94 | (cl-defmethod gt-parse ((_ gt-libre-parser) task) 95 | (with-slots (res) task 96 | (let ((json (json-read-from-string (decode-coding-string res 'utf-8)))) 97 | (setf res (cdr (assoc 'translatedText json)))))) 98 | 99 | (provide 'gt-engine-libre) 100 | 101 | ;;; gt-engine-libre.el ends here 102 | -------------------------------------------------------------------------------- /gt-engine-osxdict.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-osxdict.el --- OSX-Dictionary -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; Engine for osx-dictionary (macOS only). 26 | ;; 27 | ;; osx-dictionary, a program written by itchyny, is Dictionary.app interface for macOS. 28 | ;; I know it from https://github.com/xuchunyang/osx-dictionary.el. This engine is working 29 | ;; with it, and can be used offline for macOS user. 30 | ;; 31 | ;; Make sure program `osx-dictionary' is on your PATH, or config it with `gt-osxdict-program'. 32 | ;; 33 | ;; Source: https://github.com/itchyny/dictionary.vim/tree/master/autoload/dictionary.m 34 | ;; Build: clang -framework CoreServices -framework Foundation dictionary.m -o osx-dictionary 35 | ;; 36 | ;;; Code: 37 | 38 | (require 'gt-extension) 39 | 40 | (defclass gt-osxdict-parser (gt-parser) ()) 41 | 42 | (defclass gt-osxdict-engine (gt-engine) 43 | ((tag :initform 'osx-dictionary) 44 | (program :initarg :program :initform nil :documentation "Path of osx-dictionary") 45 | (delimiter :initform nil) 46 | (cache :initform nil) 47 | (parse :initform (gt-osxdict-parser)))) 48 | 49 | (defvar gt-osxdict-program "osx-dictionary" 50 | "Executable command or full path of osx-dictionary.") 51 | 52 | (cl-defmethod gt-translate ((engine gt-osxdict-engine) task next) 53 | (let ((program (or (oref engine program) gt-osxdict-program))) 54 | (unless (executable-find program) 55 | (user-error (format "[gt-osxdict-engine] Make sure executable `%s' is available'.\n 56 | Source: https://github.com/itchyny/dictionary.vim/tree/master/autoload/dictionary.m 57 | Build: clang -framework CoreServices -framework Foundation dictionary.m -o %s 58 | " program program))) 59 | (with-slots (text res) task 60 | (when (cdr text) 61 | (user-error "[gt-osxdict-engine] Multiple parts translation is not supported")) 62 | (with-temp-buffer 63 | (ignore-errors 64 | (apply #'call-process program nil t nil text) 65 | (setf res (buffer-string)))) 66 | (if (string-empty-p res) (setf res nil)) 67 | (funcall next task)))) 68 | 69 | (cl-defmethod gt-parse ((_ gt-osxdict-parser) task) 70 | (with-slots (res) task 71 | (with-temp-buffer 72 | (insert res) 73 | ;; This is written casually, should be improved. 74 | ;; https://github.com/itchyny/dictionary.vim/blob/master/syntax/dictionary.vim 75 | (cl-loop for (regexp . face) in 76 | '(("|.+|" . font-lock-comment-face) 77 | ("^ *▸.*" . font-lock-string-face) 78 | ("^ *[A-Z]\\..*" . bold-italic)) 79 | do (goto-char (point-min)) 80 | do (while (re-search-forward regexp nil t) 81 | (put-text-property (match-beginning 0) (match-end 0) 'face face))) 82 | (setf res (buffer-string))))) 83 | 84 | (provide 'gt-engine-osxdict) 85 | 86 | ;;; gt-engine-osxdict.el ends here 87 | -------------------------------------------------------------------------------- /gt-engine-stardict.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-stardict.el --- StarDict -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; Engine for sdcv (StarDict Console Version). 26 | ;; 27 | ;; sdcv is an offline translate software. It can be used when no network. 28 | ;; 29 | ;; Make sure sdcv is installed on your system: 30 | ;; 31 | ;; sudo pacman -S sdcv 32 | ;; 33 | ;; Then download dictionary data to ~/.stardict/dic or /usr/share/stardict/dic: 34 | ;; 35 | ;; # For example from http://download.huzheng.org: 36 | ;; 37 | ;; mkdir -p ~/.stardict/dic 38 | ;; cd ~/.stardict/dic 39 | ;; wget http://download.huzheng.org/zh_CN/stardict-langdao-ce-gb-2.4.2.tar.bz2 40 | ;; wget http://download.huzheng.org/zh_CN/stardict-langdao-ce-gb-2.4.2.tar.bz2 41 | ;; tar xvf stardict-langdao-ec-gb-2.4.2.tar.bz2 42 | ;; tar xvf stardict-langdao-ce-gb-2.4.2.tar.bz2 43 | ;; sdcv -l 44 | ;; 45 | ;; Also, you can specify the dictionary and data-dir in `gt-stardict-engine' definition: 46 | ;; 47 | ;; (gt-stardict-engine :dict "a-dictionary" :dir "~/.stardict/dic" :dir-only t) 48 | ;; 49 | ;;; Code: 50 | 51 | (require 'gt-extension) 52 | 53 | (defclass gt-stardict-parser (gt-parser) ()) 54 | 55 | (defclass gt-stardict-engine (gt-engine) 56 | ((tag :initform 'StarDict) 57 | (dict 58 | :initarg :dict 59 | :initform nil 60 | :type (or string null) 61 | :documentation "Search only this dictionary if not nil.") 62 | (dir 63 | :initarg :dir 64 | :initform nil 65 | :type (or string null) 66 | :documentation "Use this dir as data directory if not nil.") 67 | (dir-only 68 | :initarg :dir-only 69 | :initform nil 70 | :type boolean 71 | :documentation "Only use dictionaries in `dir'.") 72 | (exact 73 | :initarg :exact 74 | :initform nil 75 | :type boolean 76 | :documentation "Exact search, that is disable fuzzy-search.") 77 | (cache :initform nil) 78 | (parse :initform (gt-stardict-parser)))) 79 | 80 | (defvar gt-stardict-program "sdcv" 81 | "Executable command of sdcv (StarDict Console Version).") 82 | 83 | (defconst gt-stardict-args '("--non-interactive" "--json-output" "-0" "-1")) 84 | 85 | (defvar gt-stardict-map 86 | (let ((map (make-sparse-keymap))) 87 | (define-key map [mouse-1] #'gt-stardict-switch-dict) 88 | (define-key map (kbd "C-c C-c") #'gt-stardict-switch-dict) 89 | map) 90 | "The keymap used by StarDict.") 91 | 92 | (defun gt-stardict-build-args (engine) 93 | (with-slots (dict dir dir-only exact) engine 94 | (let ((args gt-stardict-args)) 95 | (if dict (setq args `("--use-dict" ,dict ,@args))) 96 | (if dir (setq args `("--data-dir" ,dir ,@args))) 97 | (if dir-only (setq args `("--only-data-dir" ,@args))) 98 | (if exact (setq args `("--exact-search" ,@args))) 99 | (gt-log 'gt-stardict (format "[sdcv arguments]: %s" args)) 100 | args))) 101 | 102 | (defun gt-stardict-list-dicts (engine) 103 | (with-temp-buffer 104 | (apply #'call-process gt-stardict-program nil t nil 105 | (cons "--list-dicts" (gt-stardict-build-args engine))) 106 | (goto-char (point-min)) 107 | (cl-loop for d across (json-read) 108 | collect (cons (alist-get 'name d) (alist-get 'wordcount d))))) 109 | 110 | (defun gt-stardict-switch-dict () 111 | (interactive) 112 | (let* ((task (get-char-property (point) 'gt-task)) 113 | (engine (and task (oref task engine))) 114 | (dicts (and engine (gt-stardict-list-dicts engine)))) 115 | (when (= (length dicts) 0) (user-error "No dict found, nothing can do")) 116 | (let ((dict (completing-read "Dictionary to use: " 117 | (gt-make-completion-table (cons 'ALL dicts)) 118 | nil t nil nil (oref engine dict)))) 119 | (oset engine dict (unless (string= dict "ALL") dict)) 120 | (oset gt-buffer-render-translator keep t) 121 | (gt-start gt-buffer-render-translator)))) 122 | 123 | (cl-defgeneric gt-stardict-pretty-definition (dictionary definition) 124 | "Try to pretty the DEFINITION part of DICTIONARY for output." 125 | (:method ((_ (eql '朗道)) definition) 126 | (with-temp-buffer 127 | (insert definition) 128 | ;; phonetic 129 | (goto-char (point-min)) 130 | (while (re-search-forward "^\\*\\(\\[.+\\]\\)" nil t) 131 | (replace-match (propertize (match-string 1) 'face 'gt-stardict-phonetic-face))) 132 | ;; related 133 | (goto-char (point-min)) 134 | (while (re-search-forward "^相关词组:" nil t) 135 | (replace-match (concat "\n" (propertize (match-string 0) 'face 'bold)))) 136 | ;; word class 137 | (goto-char (point-min)) 138 | (while (re-search-forward 139 | (format "^\\(%s\\)\\. " (mapconcat (lambda (v) (format "%s" v)) gt-word-classes "\\|")) nil t) 140 | (put-text-property (match-beginning 0) (match-end 0) 'face 'gt-stardict-word-class-face)) 141 | (buffer-string))) 142 | (cond ((string-match-p "^朗道.+字典" (format "%s" dictionary)) 143 | (gt-stardict-pretty-definition '朗道 definition)) 144 | (t definition))) 145 | 146 | (cl-defmethod gt-translate ((engine gt-stardict-engine) task next) 147 | (unless (executable-find gt-stardict-program) 148 | (user-error "You should install `sdcv' first before use `gt-stardict-engine'")) 149 | (with-slots (text res) task 150 | (with-temp-buffer 151 | (apply #'call-process gt-stardict-program nil t nil 152 | (append (gt-stardict-build-args engine) (list text))) 153 | (setf res (buffer-string)) 154 | (funcall next task)))) 155 | 156 | (cl-defmethod gt-parse ((_ gt-stardict-parser) task) 157 | (with-slots (res) task 158 | (let ((json (condition-case _ (json-read-from-string res) 159 | (error (user-error res)))) 160 | (props `(pointer hand help-echo "Click to switch dictionary" keymap ,gt-stardict-map))) 161 | (when (= (length json) 0) 162 | (user-error (apply #'propertize "No translation result found, sorry :(" props))) 163 | (with-temp-buffer 164 | (cl-loop for d in (cl-remove-duplicates (mapcar #'cdar json) :test #'string=) 165 | do (insert (apply #'propertize d 'display '(height 0.6) 'face 'gt-stardict-dict-face props) "\n\n") 166 | collect (cl-loop for r across (cl-remove-if-not 167 | (lambda (item) (string= (cdar item) d)) json) 168 | for i from 1 169 | for word = (propertize (alist-get 'word r) 170 | 'face 'gt-stardict-word-face 171 | 'display '(raise 0.6)) 172 | for definition = (propertize (gt-stardict-pretty-definition (intern d) (alist-get 'definition r)) 173 | 'display '(raise 0.3) 174 | 'line-prefix " " 175 | 'wrap-prefix " ") 176 | collect (concat (if (= i 0) (gt-line-height-separator 10)) word definition) into r1 177 | finally (return (string-join r1 "\n"))) 178 | into rs finally (insert (string-join rs "\n\n"))) 179 | (setf res (buffer-string)))))) 180 | 181 | (provide 'gt-engine-stardict) 182 | 183 | ;;; gt-engine-stardict.el ends here 184 | -------------------------------------------------------------------------------- /gt-engine-youdao.el: -------------------------------------------------------------------------------- 1 | ;;; gt-engine-youdao.el --- YouDao Dict -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; 有道词典 (https://dict.youdao.com), A Chinese translation website. 26 | ;; 27 | ;; This engine is only for Chinese user. 28 | ;; 29 | ;; > 此引擎仅供中文翻译使用 30 | ;; 31 | ;; There are two engine implements here, one is `gt-youdao-dict-engine' and another is `gt-youdao-suggest-engine'. 32 | ;; 33 | ;; > 这里为有道实现了两个引擎： 34 | ;; > 1. `gt-youdao-dict-engine'，基于网页翻译接口，具备基本的翻译能力 35 | ;; > 2. `gt-youdao-suggest-engine', 用于展示输入单词的同义词及相关词汇 36 | ;; > 37 | ;; > 另外，有道还提供 API 接口，罢了，要收费的。 38 | 39 | ;;; Code: 40 | 41 | (require 'gt-extension) 42 | 43 | 44 | ;;; 有道词典 45 | 46 | (defclass gt-youdao-dict-parser (gt-parser) ()) 47 | 48 | (defclass gt-youdao-dict-engine (gt-engine) 49 | ((tag :initform '有道词典) 50 | (url :initform "https://dict.youdao.com/result?lang=%s&word=%s") 51 | (parse :initform (gt-youdao-dict-parser)))) 52 | 53 | (cl-defmethod gt-translate ((engine gt-youdao-dict-engine) task next) 54 | (with-slots (text src tgt res meta translator) task 55 | (let* ((lang (cond ((equal src 'zh) tgt) 56 | ((equal tgt 'zh) src) 57 | (t (user-error "只支持中文跟其他语言之间的翻译")))) 58 | (url (if (cdr (oref translator text)) 59 | (user-error "不支持分段翻译") 60 | (format (oref engine url) 61 | (url-hexify-string (format "%s" lang)) 62 | (url-hexify-string text))))) 63 | (gt-request :url url 64 | :done (lambda (raw) 65 | (setf res (gt-parse-html-dom raw) meta url) 66 | (funcall next task)) 67 | :fail (lambda (err) (gt-fail task err)))))) 68 | 69 | (defun gt-youdao-dict--extract (dom) 70 | "从 DOM 中解析结果。" 71 | (let* ((phonetic (cl-loop for p in (dom-by-class dom "per-phone") 72 | collect (cons (nth 2 (nth 2 p)) (nth 2 (nth 3 p))))) 73 | (node (dom-by-id dom "catalogue_author")) 74 | (exp-ce (cl-loop for n in (dom-by-class node "word-exp-ce") 75 | for s = (car (dom-by-class n "point")) 76 | for r = (car (dom-by-class n "word-exp_tran")) 77 | collect (cons (nth 2 s) (nth 2 r)))) 78 | (exp-nw (unless exp-ce 79 | (cl-loop for n in (dom-by-class node "trans-content") 80 | collect (nth 2 n)))) 81 | (exp-ec (unless (or exp-nw exp-ce) 82 | (cl-loop for n in (dom-by-class node "word-exp") 83 | collect (cons (nth 2 (nth 2 n)) (nth 2 (nth 3 n)))))) 84 | (exam-type (mapcar #'caddr (dom-by-class node "exam_type-value"))) 85 | (word-wfs (cl-loop for n in (dom-by-class node "word-wfs-cell-less") 86 | collect (cons (nth 2 (nth 2 (nth 2 n))) (nth 2 (nth 3 n)))))) 87 | (list :exp-nw exp-nw :exp-ce exp-ce :exp-ec exp-ec :phonetic phonetic 88 | :exam-type exam-type :word-wfs word-wfs))) 89 | 90 | (defun gt-youdao-dict--filter (result) 91 | "对 RESULT 进行某些美化。" 92 | (string-replace "】" "]" (string-replace "【" "[" result))) 93 | 94 | (defun gt-youdao-dict--tts-url (word &optional lang) 95 | (format "http://dict.youdao.com/dictvoice?audio=%s&type=%s" 96 | (url-hexify-string word) 97 | (if (member lang '("英" 1 "1")) 1 0))) 98 | 99 | (cl-defmethod gt-parse ((_ gt-youdao-dict-parser) task) 100 | (with-slots (res meta) task 101 | (gt-plist-let ((gt-youdao-dict--extract res)) 102 | (with-temp-buffer 103 | ;; 音标 104 | (when .phonetic 105 | (insert (substring-no-properties (oref task text)) " " 106 | (propertize (if .exp-ce 107 | (propertize (caar .phonetic) 'face 'gt-youdao-dict-phonetic-face) 108 | (mapconcat (lambda (p) 109 | (concat (propertize (car p) 'face 'gt-youdao-dict-label-face) " " 110 | (propertize (cdr p) 111 | 'face 'gt-youdao-dict-phonetic-face 112 | 'mouse-face 'bold 113 | 'gt-tts-url (gt-youdao-dict--tts-url (oref task text) (car p)) 114 | 'keymap (gt-simple-keymap [mouse-1] #'gt-do-speak)))) 115 | .phonetic " ")) 116 | 'display '(height 0.7)) 117 | "\n\n")) 118 | ;; 释义 119 | (insert (cond 120 | (.exp-nw (mapconcat #'identity .exp-nw "\n")) 121 | (.exp-ce (mapconcat (lambda (exp) 122 | (concat (propertize (car exp) 'face 'gt-youdao-dict-entry-face) "\n\n " (cdr exp))) 123 | .exp-ce "\n\n")) 124 | (.exp-ec (mapconcat (lambda (exp) 125 | (if (cdr exp) 126 | (concat (propertize (car exp) 'face 'gt-youdao-dict-entry-face) " " (cdr exp)) 127 | (gt-youdao-dict--filter (car exp)))) 128 | .exp-ec "\n\n")) 129 | (t (user-error "也许没有翻译结果?"))) 130 | "\n\n") 131 | ;; 相关 132 | (cl-loop for wf in .word-wfs 133 | for i from 1 134 | do (insert (propertize (car wf) 'face 'gt-youdao-dict-label-face) " " (cdr wf)) 135 | do (insert (if (= (length .word-wfs) i) "\n\n" (if (> (current-column) fill-column) "\n" "\t")))) 136 | ;; 考试 137 | (when-let* ((et (and .exam-type (mapconcat #'identity .exam-type " / ")))) 138 | (insert (propertize et 'face 'gt-youdao-dict-phonetic-face 'display '(height 0.7)))) 139 | ;; 返回 140 | (setf res (if (or .exp-ce .exp-ec) 141 | (propertize (buffer-string) 'gt-url meta) 142 | (buffer-string))))))) 143 | 144 | 145 | ;;; 有道同义词 146 | 147 | (defclass gt-youdao-suggest-parser (gt-parser) ()) 148 | 149 | (defclass gt-youdao-suggest-engine (gt-engine) 150 | ((tag :initform '有道同义词) 151 | (url :initform "https://dict.youdao.com/suggest?q=%s&num=%s&doctype=json") 152 | (limit :initform 9 :initarg :limit) 153 | (delimiter :initform nil) 154 | (parse :initform (gt-youdao-suggest-parser)))) 155 | 156 | (cl-defmethod gt-translate ((engine gt-youdao-suggest-engine) task next) 157 | (with-slots (text res meta) task 158 | (when (cdr text) 159 | (user-error "不支持一次翻译多个单词或句子")) 160 | (let ((url (format (oref engine url) (url-hexify-string (car text)) (oref engine limit)))) 161 | (gt-request :url url 162 | :done (lambda (raw) (setf res raw meta url) (funcall next task)) 163 | :fail (lambda (err) (gt-fail task err)))))) 164 | 165 | (cl-defmethod gt-parse ((_ gt-youdao-suggest-parser) task) 166 | (with-slots (res meta) task 167 | (let ((json (json-read-from-string res))) 168 | (unless (= (alist-get 'code (alist-get 'result json)) 200) 169 | (user-error (alist-get 'msg (alist-get 'result json)))) 170 | (let ((lst (cl-loop 171 | for item across (alist-get 'entries (alist-get 'data json)) 172 | for i from 1 173 | for ent = (propertize (alist-get 'entry item) 'face 'gt-youdao-suggest-entry-face) 174 | for exp = (if-let* ((ex (alist-get 'explain item))) (propertize (concat " " ex) 'wrap-prefix " ")) 175 | collect (concat (if (> i 1) (gt-line-height-separator 18)) ent 176 | (if exp (concat "\n" (gt-line-height-separator 8) exp)))))) 177 | (with-temp-buffer 178 | (insert (string-join lst "\n")) 179 | (goto-char (point-min)) 180 | (while (re-search-forward (format "\\(%s\\)\\(\\. \\|．\\)" 181 | (mapconcat (lambda (v) (format "%s" v)) gt-word-classes "\\|")) 182 | nil t) 183 | (put-text-property (match-beginning 0) (match-end 0) 'face 'gt-youdao-suggest-cixing-face)) 184 | (setf res (propertize (buffer-string) 'gt-url meta))))))) 185 | 186 | (provide 'gt-engine-youdao) 187 | 188 | ;;; gt-engine-youdao.el ends here 189 | -------------------------------------------------------------------------------- /gt-faces.el: -------------------------------------------------------------------------------- 1 | ;;; gt-faces.el --- Face definitions -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; The faces and colors. 26 | 27 | ;;; Code: 28 | 29 | (require 'gt-core) 30 | 31 | (defgroup go-translate-faces nil 32 | "The faces for this framework." 33 | :group 'go-translate) 34 | 35 | 36 | ;;; Common 37 | 38 | (defface gt-logger-buffer-tag-face '((t :inherit font-lock-comment-face)) 39 | "Used in the logger buffer tag keyword." 40 | :group 'go-translate-faces) 41 | 42 | (defface gt-logger-buffer-timestamp-face '((t :foreground "grey")) 43 | "Used in the logger buffer timestamp keyword." 44 | :group 'go-translate-faces) 45 | 46 | (defface gt-render-prefix-face '((t :foreground "grey")) 47 | "Used in the buffer's block prefix." 48 | :group 'go-translate-faces) 49 | 50 | 51 | ;;; Buffer Render 52 | 53 | (defface gt-buffer-render-header-lang-face '((t :inherit font-lock-keyword-face)) 54 | "Used in the buffer's `header-line-format' for langs." 55 | :group 'go-translate-faces) 56 | 57 | (defface gt-buffer-render-header-desc-face '((t :inherit font-lock-variable-name-face)) 58 | "Used in the buffer's `header-line-format' for description." 59 | :group 'go-translate-faces) 60 | 61 | (defface gt-buffer-render-source-face 62 | '((((background light)) :background "ivory") 63 | (((background dark)) :background "gray20" :foreground "gray" :weight light)) 64 | "Used in the buffer's source text." 65 | :group 'go-translate-faces) 66 | 67 | (defface gt-buffer-render-inline-prefix-face 68 | '((((background light)) :height 0.8 :foreground "grey") 69 | (((background dark)) :height 0.8 :foreground "grey30")) 70 | "Used in the buffer's inline prefix." 71 | :group 'go-translate-faces) 72 | 73 | (defface gt-buffer-render-block-prefix-face '((t :background "slategray" :foreground "white" :extend t)) 74 | "Used in the buffer's block prefix." 75 | :group 'go-translate-faces) 76 | 77 | (defface gt-buffer-render-error-face '((t :weight bold :inherit font-lock-comment-face)) 78 | "Used in the buffer's error text." 79 | :group 'go-translate-faces) 80 | 81 | (defface gt-buffer-render-loading-face '((t :inherit font-lock-comment-face)) 82 | "Used in the buffer's loading messaget." 83 | :group 'go-translate-faces) 84 | 85 | 86 | ;;; Google Buffer Render 87 | 88 | (defface gt-google-buffer-headline-face '((t :inherit font-lock-function-name-face :weight bold)) 89 | "Propertize the headline in buffer rendering." 90 | :group 'go-translate-faces) 91 | 92 | (defface gt-google-buffer-phonetic-face '((t :inherit font-lock-string-face :slant normal)) 93 | "Propertize the phonetic in buffer rendering." 94 | :group 'go-translate-faces) 95 | 96 | (defface gt-google-buffer-suggestion-desc-face '((t :inherit font-lock-warning-face)) 97 | "Propertize the suggestion description in buffer rendering." 98 | :group 'go-translate-faces) 99 | 100 | (defface gt-google-buffer-suggestion-text-face '((t :slant italic :underline t)) 101 | "Propertize the phonetic text in buffer rendering." 102 | :group 'go-translate-faces) 103 | 104 | (defface gt-google-buffer-brief-result-face '((t :weight bold)) 105 | "Propertize the brief result in buffer rendering." 106 | :group 'go-translate-faces) 107 | 108 | (defface gt-google-buffer-source-face '((t :inherit font-lock-string-face)) 109 | "Propertize the source in buffer rendering." 110 | :group 'go-translate-faces) 111 | 112 | (defface gt-google-buffer-detail-demo-face '((t :inherit font-lock-doc-face)) 113 | "Propertize the detail demo in buffer rendering." 114 | :group 'go-translate-faces) 115 | 116 | 117 | ;;; Posframe Render 118 | 119 | (defcustom gt-pop-posframe-forecolor "white" 120 | "Default foreground color of pop posframe." 121 | :type 'string 122 | :group 'go-translate-faces) 123 | 124 | (defcustom gt-pop-posframe-backcolor "black" 125 | "Default background color of pop posframe." 126 | :type 'string 127 | :group 'go-translate-faces) 128 | 129 | (defcustom gt-pin-posframe-forecolor nil 130 | "Default foreground color of pin posframe." 131 | :type 'string 132 | :group 'go-translate-faces) 133 | 134 | (defcustom gt-pin-posframe-backcolor nil 135 | "Default background color of pin posframe." 136 | :type 'string 137 | :group 'go-translate-faces) 138 | 139 | (defcustom gt-pin-posframe-bdcolor "#000000" 140 | "Default border color of pin posframe." 141 | :type 'string 142 | :group 'go-translate-faces) 143 | 144 | (defcustom gt-pin-posframe-fringe-color nil 145 | "Used in the posframe pip buffer fringe color." 146 | :type 'string 147 | :group 'go-translate-faces) 148 | 149 | 150 | ;;; Overlay Render 151 | 152 | (defface gt-overlay-source-face '((t :underline (:color "grey" :style wave))) 153 | "Used in the overlay's source." 154 | :group 'go-translate-faces) 155 | 156 | (defface gt-overlay-result-face '((t :inherit font-lock-string-face)) 157 | "Used in the overlay's result." 158 | :group 'go-translate-faces) 159 | 160 | (defface gt-overlay-prefix-face '((t :inherit font-lock-comment-face)) 161 | "Used in the overlay's prefix." 162 | :group 'go-translate-faces) 163 | 164 | 165 | ;; Youdao 166 | 167 | (defface gt-youdao-dict-label-face '((((background light)) :foreground "lightblue") 168 | (((background dark)) :foreground "darkcyan")) 169 | "Face for label of youdao-dict." 170 | :group 'go-translate-faces) 171 | 172 | (defface gt-youdao-dict-phonetic-face '((((background light)) :foreground "grey") 173 | (((background dark)) :foreground "darkgray")) 174 | "Face for phonetic of youdao-dict." 175 | :group 'go-translate-faces) 176 | 177 | (defface gt-youdao-dict-entry-face '((t :bold t)) 178 | "Face for entry of youdao-dict." 179 | :group 'go-translate-faces) 180 | 181 | (defface gt-youdao-suggest-entry-face '((t :bold t)) 182 | "Face for entry of youdao-suggest." 183 | :group 'go-translate-faces) 184 | 185 | (defface gt-youdao-suggest-cixing-face '((((background light)) :foreground "grey") 186 | (((background dark)) :foreground "grey")) 187 | "Face for cixing of youdao-suggest." 188 | :group 'go-translate-faces) 189 | 190 | 191 | ;;; StarDict 192 | 193 | (defface gt-stardict-dict-face '((((background light)) :foreground "grey") 194 | (((background dark)) :foreground "darkcyan")) 195 | "Face for dict of StarDict." 196 | :group 'go-translate-faces) 197 | 198 | (defface gt-stardict-word-face '((((background light)) :bold t :foreground "darkblue") 199 | (((background dark)) :bold t)) 200 | "Face for word of StarDict." 201 | :group 'go-translate-faces) 202 | 203 | (defface gt-stardict-phonetic-face '((((background light)) :foreground "lightblue") 204 | (((background dark)) :foreground "darkcyan")) 205 | "Face for phonetic of StarDict." 206 | :group 'go-translate-faces) 207 | 208 | (defface gt-stardict-word-class-face '((t :bold t)) 209 | "Face for cixing of StarDict." 210 | :group 'go-translate-faces) 211 | 212 | 213 | ;;; Misc 214 | 215 | (defface gt-bionic-reading-face '((t :weight bold)) 216 | "Face for bionic reading word." 217 | :group 'go-translate-faces) 218 | 219 | (provide 'gt-faces) 220 | 221 | ;;; gt-faces.el ends here 222 | -------------------------------------------------------------------------------- /gt-httpx.el: -------------------------------------------------------------------------------- 1 | ;;; gt-httpx.el --- Http Client -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | ;; Package-Requires: ((emacs "28.1")) 6 | 7 | ;; SPDX-License-Identifier: GPL-3.0-or-later 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;; This file is NOT part of GNU Emacs. 23 | 24 | ;;; Commentary: 25 | 26 | ;; Http client components used by the framework. With unified interface to 27 | ;; compact different http backends. 28 | ;; 29 | ;; - Support both sync/async request 30 | ;; - Support streaming request 31 | ;; - Support retry for timeout 32 | ;; - Support config proxies for backends 33 | ;; - Support file upload/download 34 | ;; 35 | 36 | ;;; Code: 37 | 38 | (require 'cl-lib) 39 | (require 'eieio) 40 | (require 'url) 41 | 42 | (if (fboundp 'gt-log) 43 | (declare-function gt-log "ext:gt-core") 44 | (defalias 'gt-log 'ignore)) 45 | 46 | (if (fboundp 'gt-single) 47 | (declare-function gt-single--eieio-childp "ext:gt-core") 48 | (defclass gt-single () () :abstract t)) 49 | 50 | (defun gt-http-binary-p (content-type) 51 | "Check if current CONTENT-TYPE is binary." 52 | (if (null content-type) nil 53 | (cl-destructuring-bind (mime sub) (string-split content-type "/" nil "[ \n\r\t]") 54 | (not (or (equal mime "text") 55 | (and (equal mime "application") 56 | (string-match-p "json\\|xml\\|php" sub))))))) 57 | 58 | (defun gt-format-params (alist) 59 | "Format ALIST to k=v style query string." 60 | (mapconcat (lambda (arg) 61 | (format "%s=%s" 62 | (url-hexify-string (format "%s" (car arg))) 63 | (url-hexify-string (format "%s" (or (cdr arg) 1))))) 64 | (delq nil alist) "&")) 65 | 66 | (defvar gt-multipart-boundary "gt-boundary-O0o0O69Oo") 67 | 68 | (defun gt-format-formdata (alist) 69 | "Generate multipart/formdata string from ALIST." 70 | (with-temp-buffer 71 | (set-buffer-multibyte nil) 72 | (cl-loop for (key . value) in alist for i from 1 73 | for filep = nil for contentype = nil 74 | do (setq key (format "%s" key)) 75 | do (if (consp value) ; ((afile "~/aaa.jpg" "image/jpeg")) 76 | (setq contentype (or (cadr value) "application/octet-stream") 77 | value (format "%s" (car value)) filep t) 78 | (setq value (format "%s" value))) 79 | for newline = "\r\n" 80 | do (insert "--" gt-multipart-boundary newline) 81 | if filep do (let ((fn (url-encode-url (url-file-nondirectory value)))) 82 | (insert "Content-Disposition: form-data; name=\"" key "\" filename=\"" fn "\"" newline) 83 | (insert "Content-Type: " contentype newline newline) 84 | (insert-file-contents-literally value) 85 | (goto-char (point-max))) 86 | else do (insert "Content-Disposition: form-data; name=\"" key "\"" newline newline value) 87 | if (< i (length alist)) do (insert newline) 88 | else do (insert newline "--" gt-multipart-boundary "--")) 89 | (buffer-substring-no-properties (point-min) (point-max)))) 90 | 91 | 92 | ;;; Http Client 93 | 94 | (defclass gt-http-client (gt-single) 95 | ((user-agent :initarg :user-agent :initform nil :type (or string null))) 96 | "Used to send http request." 97 | :abstract t) 98 | 99 | (defvar gt-http-client-max-retry 3) 100 | 101 | (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") 102 | 103 | (defvar-local gt-http-client-stream-abort-flag nil 104 | "Non-nil means to ignore following stream progress in callback of http filter.") 105 | 106 | (cl-defgeneric gt-request (http-client &rest _args &key url method headers data filter done fail sync retry &allow-other-keys) 107 | "Send HTTP request using the given HTTP-CLIENT. 108 | 109 | Keyword arguments: 110 | - URL: The URL to send the request to. 111 | - METHOD: Request method, symbol like \\='post. If nil guess by data. 112 | - HEADERS: Additional headers to include in the request. Alist. 113 | - DATA: The data to include in the request. If this is a string, it will be 114 | sent directly as request body. If this is a list and every element 115 | is (key . value) then this will be joined to a string like a=1&b=2 and 116 | then be sent. If this is a list and some element is (key filename) 117 | format, then the list will be normalized as multipart formdata string 118 | and be sent. 119 | - FILTER: A function to be called every time when some data returned. 120 | - DONE: A function to be called when the request succeeds. 121 | - FAIL: A function to be called when the request fails. 122 | - RETRY: How many times it can retry for timeout. Number. 123 | - SYNC: Non-nil means request synchronized. Boolean. 124 | 125 | If request async, return the process behind the request." 126 | (:method :around ((client gt-http-client) &rest args &key url method _headers data filter done fail sync retry) 127 | ;; normalize and validate 128 | (if (and (null filter) (null done)) (setq sync t args `(:sync t ,@args))) 129 | (cl-assert (and url (or (and sync (not filter)) (and (not sync) (or filter done))))) 130 | (if (null method) (setq args `(:method ,(if data 'post 'get) ,@args))) 131 | ;; sync 132 | (if sync (apply #'cl-call-next-method client args) 133 | ;; async 134 | (let* ((tag (eieio-object-class client)) 135 | (failfn (lambda (status) 136 | ;; retry for timeout 137 | (unless retry (setq retry gt-http-client-max-retry)) 138 | (if (and (string-match-p "Operation timeout" (format "%s" status)) (cl-plusp retry)) 139 | (progn (gt-log tag (format "request timeout, retrying (remains %d times)..." retry)) 140 | (apply #'gt-request client `(:retry ,(1- retry) ,@args))) 141 | ;; failed finally 142 | (gt-log tag (format "Request FAIL: (%s) %s" url status)) 143 | (if fail (funcall fail status) 144 | (signal (car status) (cdr status)))))) 145 | (filterfn (when filter 146 | (lambda () 147 | ;; abort action and error case 148 | (unless gt-http-client-stream-abort-flag 149 | (condition-case err 150 | (funcall filter) 151 | (error 152 | (setq gt-http-client-stream-abort-flag t) 153 | (gt-log tag (format "Error in filter: (%s) %s" url err)) 154 | (funcall failfn err))))))) 155 | (donefn (lambda (raw) 156 | (gt-log tag (format "✓ %s" url)) 157 | (when done (funcall done raw))))) 158 | (apply #'cl-call-next-method client `(:fail ,failfn :filter ,filterfn :done ,donefn ,@args)))))) 159 | 160 | 161 | ;; http client implemented using `url.el' 162 | 163 | (defclass gt-url-http-client (gt-http-client) 164 | ((proxy-services 165 | :initarg :proxies 166 | :initform nil 167 | :type (or list null) 168 | :documentation "Proxy services passed to `url.el', see `url-proxy-services' for details.")) 169 | :documentation "Http Client implemented using `url.el'.") 170 | 171 | (defvar url-http-content-type) 172 | (defvar url-http-end-of-headers) 173 | (defvar url-http-transfer-encoding) 174 | 175 | (defvar gt-url-extra-filter nil) 176 | 177 | (defun gt-url-http-extra-filter (beg end len) 178 | (when (and gt-url-extra-filter (bound-and-true-p url-http-end-of-headers) 179 | (if (equal url-http-transfer-encoding "chunked") (= beg end) ; when delete 180 | (= len 0))) ; when insert 181 | (save-excursion 182 | (save-restriction 183 | (narrow-to-region url-http-end-of-headers (point-max)) 184 | (funcall gt-url-extra-filter))))) 185 | 186 | (cl-defmethod gt-request ((client gt-url-http-client) &key url method headers data filter done fail sync retry) 187 | (ignore retry) 188 | (let* ((inhibit-message t) 189 | (message-log-max nil) 190 | (url-user-agent (or (oref client user-agent) gt-user-agent)) 191 | (url-proxy-services (or (oref client proxy-services) url-proxy-services)) 192 | (formdatap (and (consp data) 193 | (or (string-match-p "multipart/formdata" 194 | (or (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) "")) 195 | (cl-some (lambda (x) (consp (cdr x))) data)))) 196 | (url-request-data (funcall (if (atom data) #'identity ; string 197 | (if formdatap #'gt-format-formdata #'gt-format-params)) ; alist 198 | data)) 199 | (url-request-extra-headers (progn 200 | (when formdatap 201 | (setf (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) 202 | (concat "multipart/form-data; boundary=" gt-multipart-boundary))) 203 | headers)) 204 | (url-request-method (string-to-unibyte (upcase (format "%s" method)))) 205 | (url-mime-encoding-string "identity") 206 | (get-resp-content (lambda () 207 | (set-buffer-multibyte (not (gt-http-binary-p url-http-content-type))) 208 | (buffer-substring-no-properties (min (1+ url-http-end-of-headers) (point-max)) (point-max))))) 209 | ;; log 210 | (gt-log (eieio-object-class client) 211 | (format "> %s\n> %s" client url) 212 | (if url-request-extra-headers (format "> HEADER: %S" url-request-extra-headers)) 213 | (if url-request-data (format "> DATA: %s" url-request-data))) 214 | ;; sync 215 | (if sync 216 | (condition-case err 217 | (let ((buf (url-retrieve-synchronously url nil t))) 218 | (unwind-protect 219 | (with-current-buffer buf 220 | (let ((s (funcall get-resp-content))) (if done (funcall done s) s))) 221 | (ignore-errors (kill-buffer buf)))) 222 | (error (if fail (funcall fail err) (signal 'user-error (cdr err))))) 223 | ;; async 224 | (let ((buf (url-retrieve url 225 | (lambda (status) 226 | (let ((cb (current-buffer))) 227 | (remove-hook 'after-change-functions #'gt-url-http-extra-filter t) 228 | (unwind-protect 229 | (if-let* ((err (or (cdr-safe (plist-get status :error)) 230 | (when (or (null url-http-end-of-headers) (= 1 (point-max))) 231 | (list 'empty-response "Nothing responsed from server"))))) 232 | (if fail (funcall fail err) (signal 'user-error err)) 233 | (if done (funcall done (funcall get-resp-content)))) 234 | (kill-buffer cb)))) 235 | nil t))) 236 | (when (and filter (buffer-live-p buf)) 237 | (with-current-buffer buf 238 | (setq-local gt-url-extra-filter filter) 239 | (add-hook 'after-change-functions #'gt-url-http-extra-filter nil t))) 240 | (get-buffer-process buf))))) 241 | 242 | 243 | ;;; request with `curl' by package `plz.el' 244 | 245 | ;; you should install `plz.el' first before use this 246 | 247 | (defclass gt-plz-http-client (gt-http-client) 248 | ((extra-args 249 | :initarg :args 250 | :type list 251 | :documentation "Extra arguments passed to curl programe.")) 252 | :documentation "Http Client implemented using `plz.el'.") 253 | 254 | (defvar plz-curl-program) 255 | (defvar plz-curl-default-args) 256 | (defvar plz-http-end-of-headers-regexp) 257 | 258 | (declare-function plz "ext:plz.el" t t) 259 | (declare-function plz-error-message "ext:plz.el" t t) 260 | (declare-function plz-error-curl-error "ext:plz.el" t t) 261 | (declare-function plz-error-response "ext:plz.el" t t) 262 | (declare-function plz-response-status "ext:plz.el" t t) 263 | (declare-function plz-response-body "ext:plz.el" t t) 264 | (declare-function plz--narrow-to-body "ext:plz.el" t t) 265 | 266 | (defvar gt-plz-initialize-error-message 267 | "\n\nTry to install curl and specify the program like this to solve the problem:\n 268 | (setq plz-curl-program \"c:/msys64/usr/bin/curl.exe\")\n 269 | Or switch http client to `gt-url-http-client' instead:\n 270 | (setq gt-default-http-client (gt-url-http-client))") 271 | 272 | (cl-defmethod gt-request :before ((_ gt-plz-http-client) &rest _) 273 | (unless (and (require 'plz nil t) (executable-find plz-curl-program)) 274 | (error "You should have `plz.el' and `curl' installed before using `gt-plz-http-client'"))) 275 | 276 | (cl-defmethod gt-request ((client gt-plz-http-client) &key url method headers data filter done fail sync retry) 277 | (ignore retry) 278 | (let* ((plz-curl-default-args (if (slot-boundp client 'extra-args) 279 | (append (oref client extra-args) plz-curl-default-args) 280 | plz-curl-default-args)) 281 | (formdatap (and (consp data) 282 | (or (string-match-p "multipart/formdata" 283 | (or (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) "")) 284 | (cl-some (lambda (x) (consp (cdr x))) data)))) 285 | (data (funcall (if (atom data) #'identity ; string 286 | (if formdatap #'gt-format-formdata #'gt-format-params)) ; alist 287 | data)) 288 | (string-or-binary (lambda () ; decode according content-type. there is no builtin way to do this in plz 289 | (widen) 290 | (let* ((content-type (mail-fetch-field "content-type")) 291 | (binaryp (gt-http-binary-p content-type))) 292 | (set-buffer-multibyte (not binaryp)) 293 | (goto-char (point-min)) 294 | (plz--narrow-to-body) 295 | (unless binaryp (decode-coding-region (point-min) (point-max) 'utf-8)) 296 | (buffer-string))))) 297 | ;; headers 298 | (when formdatap 299 | (setf (alist-get "Content-Type" headers nil nil #'string-equal-ignore-case) 300 | (concat "multipart/form-data; boundary=" gt-multipart-boundary))) 301 | (unless (alist-get "User-Agent" headers nil nil #'string-equal-ignore-case) 302 | (push `("User-Agent" . ,(or (oref client user-agent) gt-user-agent)) headers)) 303 | ;; log 304 | (gt-log (eieio-object-class client) 305 | (format "> %s\n> %s" client url) 306 | (if headers (format "> HEADER: %s" headers)) 307 | (if data (format "> DATA: %s" data)) 308 | (if plz-curl-default-args (format "> EXTRA: %s" plz-curl-default-args))) 309 | ;; sync 310 | (if sync 311 | (condition-case err 312 | (let ((r (plz method url 313 | :headers headers 314 | :body data 315 | :body-type (if formdatap 'binary 'text) 316 | :decode nil 317 | :as string-or-binary 318 | :then 'sync))) 319 | (if done (funcall done r) r)) 320 | (error (if fail (funcall fail err) 321 | (signal 'user-error (cdr err))))) 322 | ;; async 323 | (plz method url 324 | :headers headers 325 | :body data 326 | :body-type (if formdatap 'binary 'text) 327 | :decode nil 328 | :as string-or-binary 329 | :filter (when filter 330 | (lambda (proc string) 331 | (with-current-buffer (process-buffer proc) 332 | (save-excursion 333 | (goto-char (point-max)) 334 | (insert string) 335 | (goto-char (point-min)) 336 | (when (re-search-forward plz-http-end-of-headers-regexp nil t) 337 | (save-restriction 338 | (narrow-to-region (point) (point-max)) 339 | (funcall filter))))))) 340 | :then (lambda (raw) 341 | (when done (funcall done raw))) 342 | :else (lambda (err) 343 | (let ((ret ;; try to compat with error object of url.el, see `url-retrieve' for details 344 | (or (plz-error-message err) 345 | (when-let* ((r (plz-error-curl-error err))) 346 | (list 'curl-error 347 | (concat (format "%s" (or (cdr r) (car r))) 348 | (pcase (car r) 349 | (2 (when (memq system-type '(cygwin windows-nt ms-dos)) 350 | gt-plz-initialize-error-message)))))) 351 | (when-let* ((r (plz-error-response err))) 352 | (list 'http (plz-response-status r) (plz-response-body r)))))) 353 | (if fail (funcall fail ret) 354 | (signal 'user-error ret)))))))) 355 | 356 | (provide 'gt-httpx) 357 | 358 | ;;; gt-httpx.el ends here 359 | -------------------------------------------------------------------------------- /gt-tests.el: -------------------------------------------------------------------------------- 1 | ;;; gt-tests.el --- Tests -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; Unit Tests 26 | 27 | ;;; Code: 28 | 29 | (require 'ert) 30 | (require 'go-translate) 31 | 32 | ;;; Tests 33 | 34 | (defvar gt-test-text-1 35 | " 36 | 37 | This buffer is for text that is not saved, and for Lisp evaluation. 38 | 39 | To create a file, visit it with ‘C-x C-f’ and enter text in its buffer. 40 | 41 | ") 42 | 43 | (defvar gt-test-text-2 "你好，朋友 欢迎你") 44 | 45 | (ert-deftest test--gt-word-p () 46 | (should (gt-word-p 'zh "你好")) 47 | (should (gt-word-p 'zh " 你好 ")) 48 | (should-not (gt-word-p 'zh "你好 吧")) 49 | (should-not (gt-word-p 'zh "你好，吧")) 50 | (should (gt-word-p 'en "hello")) 51 | (should-not (gt-word-p 'en "hello,world")) 52 | (should-not (gt-word-p 'en "hello world"))) 53 | 54 | (ert-deftest test--gt-pick-items-by-thing () 55 | (should (null (gt-pick-items-by-thing nil nil))) 56 | (should (equal (gt-pick-items-by-thing gt-test-text-1 nil) gt-test-text-1)) 57 | (should (equal (gt-pick-items-by-thing gt-test-text-1 'word) 58 | '("This" "buffer" "is" "for" "text" "that" "is" "not" "saved" "and" 59 | "for" "Lisp" "evaluation" "To" "create" "a" "file" "visit" "it" "with" "C" "x" "C" "f" 60 | "and" "enter" "text" "in" "its" "buffer"))) 61 | (should (equal (gt-pick-items-by-thing gt-test-text-1 'word (lambda (w) (string-prefix-p "e" w))) 62 | '("evaluation" "enter"))) 63 | (should (equal (gt-pick-items-by-thing gt-test-text-1 'paragraph) 64 | '("This buffer is for text that is not saved, and for Lisp evaluation.\n" 65 | " To create a file, visit it with ‘C-x C-f’ and enter text in its buffer.\n"))) 66 | (should (equal (gt-pick-items-by-thing gt-test-text-2 'word) 67 | '("你好" "朋友" "欢迎你")))) 68 | 69 | (ert-deftest test--gt-available-langs () 70 | (should-error (gt-available-langs nil nil)) 71 | (should-error (gt-available-langs '(en) nil)) 72 | (let ((gt-target-history '((en ja) (zh ja) (en zh)))) 73 | (let ((gt-polyglot-p nil) 74 | (gt-ignore-target-history-p t)) 75 | (should (equal (gt-available-langs '(en zh ja) nil) 76 | '((en zh) (en ja)))) 77 | (should (equal (gt-available-langs '(en zh ja) gt-test-text-1) 78 | '((en zh) (en ja)))) 79 | (should (equal (gt-available-langs '(en zh ja) gt-test-text-2) 80 | '((zh en) (zh ja)))) 81 | (should (equal (gt-available-langs 82 | '(en zh ja) (gt-pick-items-by-thing gt-test-text-1 'word)) 83 | '((en zh) (en ja))))) 84 | (let ((gt-polyglot-p t) 85 | (gt-ignore-target-history-p t)) 86 | (should (equal (gt-available-langs '(en zh ja) gt-test-text-1) 87 | '((en zh ja)))) 88 | (should (equal (gt-available-langs '(en zh ja) gt-test-text-2) 89 | '((zh en ja))))) 90 | (let ((gt-polyglot-p nil) 91 | (gt-ignore-target-history-p nil)) 92 | (should (equal (gt-available-langs '(en zh ja) nil) 93 | '((en ja) (en zh)))) 94 | (should (equal (gt-available-langs '(en zh ja) gt-test-text-1) 95 | '((en ja) (en zh)))) 96 | (should (equal (gt-available-langs '(en zh ja) gt-test-text-2) 97 | '((zh ja) (zh en))))))) 98 | 99 | (ert-deftest test--gt-valid-literally () 100 | (should (gt-valid-literally 'word '("hello") 'en 'fr)) 101 | (should-not (gt-valid-literally 'word '("hello world") 'en 'fr)) 102 | (should-not (gt-valid-literally 'word '("hello" "world") 'en 'fr)) 103 | (should (gt-valid-literally 'not-word '("hello" "world") 'en 'fr)) 104 | (should (gt-valid-literally 'parts '("hello" "world") 'en 'fr)) 105 | (should (gt-valid-literally 'not-parts '("hello") 'en 'fr)) 106 | (should (gt-valid-literally 'src:en '("hello") 'en 'fr)) 107 | (should (gt-valid-literally 'tgt:fr '("hello") 'en 'fr)) 108 | (should (gt-valid-literally 'not-tgt:en '("hello") 'en 'fr)) 109 | (should (gt-valid-literally '(and not-tgt:en (or word not-parts)) '("hello") 'en 'fr))) 110 | 111 | (ert-deftest test--gt-current-cacher () 112 | (let ((gt-default-cacher (gt-memory-cacher))) 113 | (cl-multiple-value-bind (c d) 114 | (gt-current-cacher (gt-bing-engine :cache nil) nil) 115 | (should (and (null c) (null d)))) 116 | (cl-multiple-value-bind (c d) 117 | (gt-current-cacher (gt-bing-engine :cache t) nil) 118 | (should (and (eq c gt-default-cacher) (null d)))) 119 | (cl-multiple-value-bind (c d) 120 | (gt-current-cacher (gt-bing-engine :cache 'word) nil) 121 | (should (and (eq c gt-default-cacher) (eq d 'word)))) 122 | (cl-multiple-value-bind (c d) 123 | (gt-current-cacher (gt-bing-engine :cache (gt-memory-cacher :if 'xxx)) nil) 124 | (should (and (eq (oref c if) 'xxx) (null d)))))) 125 | 126 | (ert-deftest test--gt-plist-let () 127 | (should (gt-plist-let '(:b 2 :c 3) 128 | (equal (+ .b .c) 5))) 129 | (should (gt-plist-let `(:b 2 :c ,(max 2 3)) 130 | (equal (+ .b .c) 5))) 131 | (should (gt-plist-let ((a 1) '(:b 2 :c 3)) 132 | (equal (+ a .b .c) 6))) 133 | (should (gt-plist-let ((a 1) `(:b 2 :c ,(max 2 3))) 134 | (equal (+ a .b .c) 6))) 135 | (should (let ((a `(:b 2 :c ,(max 2 3)))) 136 | (gt-plist-let a (equal (+ .b .c) 5))))) 137 | 138 | (ert-deftest test--gt-translation-life-cycle () 139 | (let ((translator (gt-translator 140 | :taker (gt-taker 141 | :langs '(en zh) 142 | :text 'buffer 143 | :pick 'word 144 | :pick-pred (lambda (w) (string-prefix-p "w" w)) 145 | :then #'ignore) 146 | :engines (list 147 | (gt-google-engine 148 | :parse (gt-google-summary-parser) 149 | :if 'word 150 | :cache nil 151 | :then #'ignore) 152 | (gt-deepl-engine 153 | :if 'not-word 154 | :cache nil)) 155 | :render (gt-insert-render 156 | :type 'after 157 | :then (lambda (ts) 158 | (with-slots (bounds state bag) ts 159 | (with-current-buffer (car bounds) 160 | (setf state 9 bag (buffer-string))))))))) 161 | (with-temp-buffer 162 | (insert "hello world") 163 | (gt-start translator) 164 | (while (< (oref translator state) 4) (sit-for 0.2)) 165 | (should (string-match-p "^hello world[ \n]+世界$" (oref translator bag)))) 166 | (with-temp-buffer 167 | (with-slots (bag state) translator 168 | (insert "love and peace") 169 | (gt-set-taker translator (gt-taker :langs '(en zh) :text 'buffer)) 170 | (gt-start translator) 171 | (while (< state 4) (sit-for 0.2)) 172 | (should (string-match-p "^love and peace[ \n]+爱与和平$" bag)))))) 173 | 174 | (provide 'gt-tests) 175 | 176 | ;;; gt-tests.el ends here 177 | -------------------------------------------------------------------------------- /gt-text-utility.el: -------------------------------------------------------------------------------- 1 | ;;; gt-text-utility.el --- Text utilities base on the translator -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2024 lorniu 4 | ;; Author: lorniu 5 | 6 | ;; SPDX-License-Identifier: GPL-3.0-or-later 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;; This file is NOT part of GNU Emacs. 22 | 23 | ;;; Commentary: 24 | 25 | ;; Integrate md5, sha1, base64, qrcode and others into this translation framework. 26 | ;; 27 | ;; Shows that this framework is more than just translation purposes. 28 | ;; 29 | ;; Use like this: 30 | ;; 31 | ;; \\=(gt-start (gt-text-utility :render (gt-buffer-render))) 32 | ;; 33 | ;; To avoid be prompted, specify the targets like this: 34 | ;; 35 | ;; \\=(gt-start (gt-text-utility :taker (gt-taker :langs '(md5 sha1)) :render (gt-insert-render))) 36 | 37 | ;;; Code: 38 | 39 | (require 'gt-extension) 40 | 41 | (defvar gt-text-utilities `(base64 rot13 qrcode speak ,@(secure-hash-algorithms)) 42 | "List of available targets for `gt-text-utility-engine'.") 43 | 44 | (defclass gt-text-utility (gt-translator) ()) 45 | 46 | (defclass gt-text-utility-engine (gt-engine) 47 | ((tag :initform 'Text-Utility) 48 | (cache :initform nil) 49 | (delimiter :initform nil))) 50 | 51 | (cl-defmethod gt-reset :after ((translator gt-text-utility) &rest _) 52 | (with-slots (_engines) translator 53 | (unless _engines (setf _engines (gt-text-utility-engine))) 54 | (setf _engines (ensure-list _engines)) 55 | (unless (and (not (cdr _engines)) (cl-typep (car _engines) 'gt-text-utility-engine)) 56 | (user-error "%s should use only one gt-text-utility-engine as engine" (gt-desc translator))))) 57 | 58 | (cl-defmethod gt-target ((taker gt-taker) (_ gt-text-utility) &rest _) 59 | (let ((tgts (if (slot-boundp taker 'langs) 60 | (ensure-list (oref taker langs)) 61 | (mapcar #'intern 62 | (completing-read-multiple 63 | "Utilities (can choose multiple): " gt-text-utilities 64 | nil t nil 'gt-text-utility-hist))))) 65 | (unless tgts (user-error "No targets found")) 66 | (cons nil (cl-delete-duplicates tgts)))) 67 | 68 | (cl-defmethod gt-translate ((_ gt-text-utility-engine) task _) 69 | "Translate and render the result directly, skip parse and other steps." 70 | (with-slots (text tgt res translator) task 71 | (setf res (mapcar (lambda (c) (gt-text-util tgt (encode-coding-string c 'utf-8))) text)) 72 | (gt-update-state translator) 73 | (gt-output (oref translator render) translator))) 74 | 75 | (cl-defmethod gt-keybinds ((_buffer gt-buffer-render) (_ gt-text-utility)) 76 | (gt-buffer-render-key ("t" "Cycle Next") #'gt-buffer-render--cycle-next) 77 | (gt-buffer-render-key ("g" "Refresh") #'gt-buffer-render--refresh) 78 | (gt-buffer-render-key ("q" "Quit") #'kill-buffer-and-window) 79 | (gt-buffer-render-key ("C-x C-q") #'gt-buffer-render--toggle-readonly) 80 | (gt-buffer-render-key ("?") #'gt-buffer-render--show-tips)) 81 | 82 | 83 | 84 | (cl-defgeneric gt-text-util (target text) 85 | "Dispatch to different TEXT utility methods for different TARGET." 86 | (:method ((_ (eql 'base64)) text) (base64-encode-string text t)) 87 | (:method ((_ (eql 'rot13)) text) (rot13 text)) 88 | (:method ((_ (eql 'qrcode)) text) (gt-qrcode text)) 89 | (:method ((_ (eql 'speak)) text) (gt-text-speak-button text)) 90 | (if (member target (secure-hash-algorithms)) 91 | (secure-hash target text) 92 | (user-error "Unimplemented"))) 93 | 94 | (defun gt-text-speak-button (str) 95 | (propertize str 96 | 'display " click to speak... " 97 | 'pointer 'hand 98 | 'keymap (gt-simple-keymap [mouse-1] (lambda () (interactive) (gt-speak 'interact str t))) 99 | 'face '(:box t) 100 | 'mouse-face '(:reverse-video t :inherit font-lock-warning-face))) 101 | 102 | (declare-function qrencode "ext:qrencode.el" t t) 103 | 104 | ;;;###autoload 105 | (defun gt-qrcode (str) 106 | "Genrate QR Code for STR." 107 | (interactive (list (read-string "String to generate QRCode: "))) 108 | (let ((code (if (executable-find "qrencode") 109 | (with-temp-buffer 110 | (let ((coding-system-for-read 'raw-text)) 111 | (set-buffer-multibyte nil) 112 | (insert str) 113 | (shell-command-on-region (point-min) (point-max) "qrencode -t PNG -o -" (current-buffer)) 114 | (if (string-match-p "PNG" (buffer-substring 1 (min (point-max) 8))) 115 | (propertize " " 'display `(image :type png :data ,(buffer-string) :width 200)) 116 | (user-error (buffer-string))))) 117 | (if (require 'qrencode nil t) 118 | (qrencode str) 119 | (user-error "Install program `qrencode' or package `qrencode.el' first to generate QR Code"))))) 120 | (if (called-interactively-p 'any) (message "%s" code) code))) 121 | 122 | (provide 'gt-text-utility) 123 | 124 | ;;; gt-text-utility.el ends here 125 | --------------------------------------------------------------------------------