On Fri, May 29, 2009 at 11:29 PM, Jürgen Hötzel
<address@hidden> wrote:
;;; babel.el --- interface to web translation services such as Babelfish
;;;
;;; Git blob $Id: 0d9ffa59c8729dfbc407e175048af2ced458a30c $
;;;
;;; Author: Eric Marsden <address@hidden>
;;; Juergen Hoetzel <address@hidden>
;;; Keywords: translation, web
;;; Copyright: (C) 1999-2001 Eric Marsden
;;; 2005-2009 Juergen Hoetzel
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public
;; License along with this program; if not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
;;
;; Please send suggestions and bug reports to <address@hidden>.
;; The latest version of this package should be available at
;;
;; http://github.com/juergenhoetzel/babel/tree/master
;;; Commentary:
;;; Overview ==========================================================
;;
;; This module provides an Emacs interface to different translation
;; services available on the Internet. You give it a word or paragraph
;; to translate and select the source and destination languages, and
;; it connects to the translation server, retrieves the data, and
;; presents it in a special *babel* buffer. Currently the following
;; backends are available:
;;
;; * the Babelfish service at babelfish.yahoo.com
;; * the Google service at translate.google.com
;; * the Transparent Language motor at FreeTranslation.com
;;
;; Entry points: either 'M-x babel', which prompts for a phrase, a
;; language pair and a backend, or 'M-x babel-region', which prompts
;; for a language pair and backend, then translates the currently
;; selected region, and 'M-x babel-buffer' to translate the current
;; buffer.
;;
;; If you ask for a language combination which several backends could
;; translate, babel.el will allow you to choose which backend to
;; use. Since most servers have limits on the quantity of text
;; translated, babel.el will split long requests into translatable
;; chunks and submit them sequentially.
;;
;; Please note that the washing process (which takes the raw HTML
;; returned by a translation server and attempts to extract the useful
;; information) is fragile, and can easily be broken by a change in
;; the server's output format. In that case, check whether a new
;; version is available (and if not, warn me; I don't translate into
;; Welsh very often).
;;
;; Also note that by accessing an online translation service you are
;; bound by its Terms and Conditions; in particular
;; FreeTranslation.com is for "personal, non-commercial use only".
;;
;;
;; Installation ========================================================
;;
;; Place this file in a directory in your load-path (to see a list of
;; appropriate directories, type 'C-h v load-path RET'). Optionally
;; byte-compile the file (for example using the 'B' key when the
;; cursor is on the filename in a dired buffer). Then add the
;; following lines to your ~/.emacs.el initialization file:
;;
;; (autoload 'babel "babel"
;; "Use a web translation service to translate the message MSG." t)
;; (autoload 'babel-region "babel"
;; "Use a web translation service to translate the current region." t)
;; (autoload 'babel-as-string "babel"
;; "Use a web translation service to translate MSG, returning a string." t)
;; (autoload 'babel-buffer "babel"
;; "Use a web translation service to translate the current buffer." t)
;;
;; babel.el requires emacs >= 22
;;
;;
;; Backend information =================================================
;;
;; A babel backend named <zob> must provide three functions:
;;
;; (babel-<zob>-translation from to)
;;
;; where FROM and TO are three-letter language abbreviations from
;; the alist `babel-languages'. This should return non-nil if the
;; backend is capable of translating between these two languages.
;;
;; (babel-<zob>-fetch msg from to)
;;
;; where FROM and TO are as above, and MSG is the text to
;; translate. Connect to the appropriate server and fetch the raw
;; HTML corresponding to the request.
;;
;; (babel-<zob>-wash)
;;
;; When called on a buffer containing the raw HTML provided by the
;; server, remove all the uninteresting text and HTML markup.
;;
;; I would be glad to incorporate backends for new translation servers
;; which are accessible to the general public. List of translation
;; engines and multilingual dictionaries at
;; <URL:http://funsan.biomed.mcgill.ca/~funnell/language.html>.
;;
;;
;; <URL:http://www.xmethods.net/sd/BabelFishService.wsdl>
;;
;; babel.el was inspired by a posting to the ding list by Steinar Bang
;; <address@hidden>. Morten Eriksen <address@hidden> provided several
;; patches to improve InterTrans washing. Thanks to Per Abrahamsen and
;; Thomas Lofgren for pointing out a bug in the keymap code. Matt
;; Hodges <address@hidden> suggested ignoring case
;; on completion. Colin Marquardt suggested
;; `babel-preferred-to-language'. David Masterson suggested adding a
;; menu item. Andy Stewart provided
;; `babel-remember-window-configuration' functionality, output window
;; adjustments and more improvements.
;;
;; User quotes: Dieses ist die größte Sache seit geschnittenem Brot.
;; -- Stainless Steel Rat <address@hidden>
;;; History
;; 1.0 * Fixed Google backend (new regex)
;; * New custom variables `babel-buffer-name',
;; `babel-echo-area', `babel-select-output-window'
;; * Disable use of echo area usage on xemacs if lines > 1
;; (resize of minibuffer does not work reliable)
;; * `babel-url-retrieve' fix for xemacs from Uwe Brauer
;; 0.9 * Use `babel-buffer-name' for output buffer
;; 0.8 * Remember window config if `babel-remember-window-configuration'
;; is non-nil.
;; * made *babel* buffer read-only
;; * use echo area (like `shell-command')
;; * New functions `babel-as-string-default',`babel-region-default',
;; `babel-buffer-default', `babel-smart' (provided by Andy)
;; 0.7 * error handling if no backend is available for translating
;; the supplied languages
;; * rely on url-* functions (for charset decoding) on GNU emacs
;; * increased chunk size for better performance
;; * added support for all Google languages
;; * `babel-region' with prefix argument inserts the translation
;; output at point.
;; 0.6 * get rid of w3-region (implementend basic html entity parsing)
;; * get rid of w3-form-encode-xwfu (using mm-url-form-encode-xwfu)
;; * no character classes in regex (for xemacs compatibility)
;; * default backend: Google
;; 0.5: * Fixed Google and Babelfish backends
;; 0.4: * revised FreeTranslation backend
;;; 0.3: * removed non-working backends: systran, intertrans, leo, e-PROMPT
;;; * added Google backend
;;; * revised UTF-8 handling
;;; * Added customizable variables: babel-preferred-to-language, babel-preferred-from-language
;;; * revised history handling
;;; * added helper function: babel-wash-regex
;; TODO:
;;
;; * Use google xml output
;;
;; * Adjust output window height. Current versions use
;; `with-current-buffer' instead `with-output-to-temp-buffer'. So
;; `temp-buffer-show-hook' will fail to adjust output window height
;; -> Use (fit-window-to-buffer nil babel-max-window-height) to
;; adjust output window height in new version.
;;
;; * use non-blocking `url-retrieve'
;;
;; * improve function `babel-simple-html-parse'.
;;
;; * In `babel-quite' function, should be add (boundp
;; 'babel-previous-window-configuration) to make value of
;; `babel-previous-window-configuration' is valid
;;
(require 'cl)
(require 'mm-url)
(require 'easymenu)
;; xemacs compatibility
(eval-and-compile
(when (featurep 'xemacs)
(defun url-retrieve-synchronously (url)
(save-excursion
(cdr (url-retrieve url))))))
;; ======================================================================
;;; Customizables
;; ======================================================================
(defgroup babel nil
"provides an Emacs interface to different translation services available on the Internet"
:group 'applications)
(defconst babel-version 1.0
"The version number of babel.el")
(defconst babel-languages
'(("Arabic" . "ar")
("Bulgarian" . "bg")
("Catalan" . "ca")
("Czech" . "cs")
("Danish" . "da")
("German" . "de")
("Greek" . "el")
("English" . "en")
("Spanish" . "es")
("Finnish" . "fi")
("French" . "fr")
("Hindi" . "hi")
("Croatian" . "hr")
("Indonesian" . "id")
("Italian" . "it")
("Hebrew" . "iw")
("ja" . "Japanese")
("Korean" . "ko")
("lt" . "Lithuanian")
("Latvian" . "lv")
("nl" . "Dutch")
("Norwegian" . "no")
("pl" . "Polish")
("Portuguese" . "pt")
("ro" . "Romanian")
("Russian" . "ru")
("sk" . "Slovak")
("Slovenian" . "sl")
("sr" . "Serbian")
("Swedish" . "sv")
("tl" . "Filipino")
("Ukrainian" . "uk")
("Vietnamese" . "vi")
("Chinese (Simplified)" . "zh-CN")
("Chinese" . "zh-CN")
("Chinese (Traditional)" . "zh-TW")))
(defcustom babel-preferred-to-language "German"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,@(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-to-history (list value)))
:group 'babel)
(defcustom babel-preferred-from-language "English"
"*Default target translation language.
This must be the long name of one of the languages in the alist"
:type `(choice ,@(mapcar (lambda (s) `(const ,(car s))) babel-languages))
:set (lambda (symbol value)
(set-default symbol value)
(setq babel-from-history (list value)))
:group 'babel)
(defcustom babel-remember-window-configuration t
"Whether remeber window configuration before transform. If this
variable is t, will use `babel-quit' command restore window
configuration."
:type 'boolean
:group 'babel)
(defcustom babel-max-window-height 30
"The max height that babel output window."
:type 'integer
:group 'babel)
(defcustom babel-buffer-name "*babel*"
"The buffer name of `babel' transform output."
:type 'string
:group 'babel)
(defcustom babel-echo-area t
"If this option is `non-nil' and the output is short enough to
display in the echo area (which is determined by the variables
`resize-mini-windows' and `max-mini-window-height'), it is shown in
echo area.
Default is `t'."
:type 'boolean
:group 'babel)
(defcustom babel-select-output-window t
"Select output window after transform complete.
This is useful when you have a complex window layout.
Save you time to switch babel output window."
:type 'boolean
:group 'babel)
(defvar babel-previous-window-configuration nil
"The window configuration before transform.")
(defvar babel-to-history (list babel-preferred-to-language))
(defvar babel-from-history (list babel-preferred-to-language))
(defvar babel-backend-history (list))
(defvar babel-mode-hook nil)
(defvar babel-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "q") #'bury-buffer)
(define-key map (kbd "SPC") #'scroll-up)
(define-key map (kbd "DEL") #'scroll-down)
(define-key map (kbd "<") #'beginning-of-buffer)
(define-key map (kbd ">") #'end-of-buffer)
(define-key map (kbd "s") #'isearch-forward)
(define-key map (kbd "r") #'isearch-backward)
(define-key map (kbd "h") #'describe-mode)
map)
"Keymap used in Babel mode.")
(defvar babel-backends
'(("Google" . google)
("Babelfish at Yahoo" . fish)
("FreeTranslation" . free))
"List of backends for babel translations.")
(defun babel-sentence-end()
"portability function. emacs 22.0.50 introduced sentence-end
function, not available on other emacsen"
(if (fboundp 'sentence-end)
(sentence-end)
sentence-end))
;; xemacs compatibility
(eval-and-compile
(if (featurep 'xemacs)
;; XEmacs
(defun babel-url-retrieve (url)
"Retrieve URL and decode"
(let ((current (current-buffer))
(tmp (url-retrieve-synchronously url)))
(with-current-buffer tmp
;;shrug: we asume utf8
(decode-coding-region (point-min) (point-max) 'utf-8)
(copy-to-buffer current (point-min) (point-max)))))
;; GNUs Emacs
(require 'url-handlers)
(defun babel-url-retrieve (url)
(let ((tmp (url-retrieve-synchronously url)))
(url-insert tmp)))))
(defun babel-wash-regex (regex)
"Extract the useful information from the HTML returned by fetch function
translated text should be inside parenthesized _expression_ in regex"
(goto-char (point-min))
(if (search-forward-regexp regex (point-max) t)
(progn
(delete-region (match-end 1) (point-max))
(delete-region (point-min) (match-beginning 1))
t)))
;;;###autoload
(defun babel (msg &optional no-display accept-default-setup)
"Use a web translation service to translate the message MSG.
Display the result in a buffer *babel* unless the optional argument
NO-DISPLAY is nil.
If the output is short enough to display in the echo area (which is
determined by the variables `resize-mini-windows' and
`max-mini-window-height'), it is shown there, but it is nonetheless
available in buffer `*babel*' even though that buffer is not
automatically displayed."
(interactive "sTranslate phrase: ")
(let* ((completion-ignore-case t)
(from-suggest (or (first babel-from-history) (caar babel-languages)))
(from-long
(if accept-default-setup
babel-preferred-from-language
(completing-read "Translate from: "
babel-languages nil t
(cons from-suggest 0)
'babel-from-history)))
(to-avail (remove* from-long babel-languages
:test #'(lambda (a b) (string= a (car b)))))
(to-suggest (or (first
(remove* from-long babel-to-history
:test #'string=))
(caar to-avail)))
(to-long
(if accept-default-setup
babel-preferred-to-language
(completing-read "Translate to: " to-avail nil t
(cons to-suggest 0)
'babel-to-history)))
(from (cdr (assoc from-long babel-languages)))
(to (cdr (assoc to-long babel-languages)))
(backends (babel-get-backends from to)))
(if (not backends)
(error "No Backend available for translating %s to %s"
from-long to-long)
(let* ((backend-str
(if accept-default-setup (caar backends)
(completing-read "Using translation service: "
backends nil t
(cons (or (member (first babel-backend-history)
backends) (caar backends)) 0)
'babel-backend-history)))
(backend (symbol-name (cdr (assoc backend-str babel-backends))))
(fetcher (intern (concat "babel-" backend "-fetch")))
(washer (intern (concat "babel-" backend "-wash")))
(chunks (babel-chunkify msg 7000))
(translated-chunks '())
(view-read-only nil))
(loop for chunk in chunks
do (push (babel-work chunk from to fetcher washer)
translated-chunks))
(if no-display
(apply #'concat (nreverse translated-chunks))
(let ((pop-up-frames nil)
(temp-buffer-show-hook
'(lambda ()
(fit-window-to-buffer nil babel-max-window-height)
(shrink-window-if-larger-than-buffer))))
(if (and babel-remember-window-configuration
(null babel-previous-window-configuration))
(setq babel-previous-window-configuration (current-window-configuration)))
(with-current-buffer
(get-buffer-create babel-buffer-name)
;; ensure buffer is writeable
(setq buffer-read-only nil)
(erase-buffer)
(loop for tc in (nreverse translated-chunks)
do (insert tc))
(save-excursion
(with-current-buffer babel-buffer-name
(let ((lines
(if (= (buffer-size) 0)
0
;; xemacs compatibility
(if (not (featurep 'xemacs))
(count-screen-lines nil nil nil (minibuffer-window))
(count-lines (point-min) (point-max))))))
(babel-mode)
(cond ((= lines 0))
((and babel-echo-area (or (<= lines 1)
(and (not (featurep 'xemacs))
(<= lines
(if resize-mini-windows
(cond ((floatp max-mini-window-height)
(* (frame-height)
max-mini-window-height))
((integerp max-mini-window-height)
max-mini-window-height)
(t
1))
1))))
;; Don't use the echo area if the output buffer is
;; already dispayed in the selected frame.
(not (get-buffer-window (current-buffer))))
;; Echo area
(goto-char (point-max))
(when (bolp)
(backward-char 1))
(message "%s" (buffer-substring (point-min) (point))))
(t
;; Buffer
(goto-char (point-min))
(display-buffer (current-buffer))))))))))))))
(defun babel-as-string-default (msg)
"Use a web translation service to translate MSG, returning a string."
(interactive "sTranslate phrase: ")
(babel msg t t))
(defun babel-region-default (start end &optional arg)
"Use a web translation service to translate the current region.
With prefix argument, insert the translation output at point."
(interactive "r\nP")
(if arg
(insert (babel (buffer-substring-no-properties start end) t t))
(babel (buffer-substring-no-properties start end) nil t)))
(defun babel-buffer-default ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string-default
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region-default (point-min) (point-max))))))
(defun babel-smart (&optional prefix)
"Smart babel function. If you use prefix keystroke, prompt with
input. Same effect with `babel'. If mark active with current buffer,
transform region. Same effect with `babel-region'. Otherwise
transform all content of current buffer. Same effect with
`babel-buffer'."
(interactive "P")
(if (null prefix)
(if mark-active
(babel-region-default (region-beginning) (region-end))
(babel-buffer-default))
(babel (read-string "Translate phrase: ") nil t)))
(defun babel-quit ()
"Quit babel window. If `babel-remember-window-configuration' is t,
restore window configuration before transform. Otherwise just do
`bury-buffer'."
(interactive)
(if (and babel-remember-window-configuration
babel-previous-window-configuration)
(progn
(kill-buffer (get-buffer babel-buffer-name))
(set-window-configuration babel-previous-window-configuration)
(setq babel-previous-window-configuration nil))
(bury-buffer)))
;;;###autoload
(defun babel-region (start end &optional arg)
"Use a web translation service to translate the current region.
With prefix argument, insert the translation output at point."
(interactive "r\nP")
(if arg
(insert (babel (buffer-substring-no-properties start end) t))
(babel (buffer-substring-no-properties start end))))
;;;###autoload
(defun babel-as-string (msg)
"Use a web translation service to translate MSG, returning a string."
(interactive "sTranslate phrase: ")
(babel msg t))
;; suggested by Djalil Chafai <address@hidden>
;;
;;;###autoload
(defun babel-buffer ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region (point-min) (point-max))))))
(defun babel-work (msg from to fetcher washer)
(save-excursion
(set-buffer (get-buffer-create " *babelurl*"))
(erase-buffer)
(funcall fetcher (babel-preprocess msg) from to)
(funcall washer)
(babel-postprocess)
(babel-simple-html-parse)
(babel-display)
(buffer-substring-no-properties (point-min) (point-max))))
(defun babel-get-backends (from to)
"Return a list of those backends which are capable of translating
language FROM into language TO."
(loop for b in babel-backends
for name = (symbol-name (cdr b))
for translator = (intern (concat "babel-" name "-translation"))
for translatable = (funcall translator from to)
if translatable collect b))
(defconst babel-html-entity-regex
"&\\(#\\([0-9]+\\)\\|\\([a-zA-Z]+\\)\\);")
(defun babel-decode-html-entitiy (str)
(if (and str (string-match babel-html-entity-regex
str))
(if (string= (substring str 1 2) "#")
;TODO: xemacs
(if (not (featurep 'xemacs))
(let ((number (match-string-no-properties 2 str)))
(decode-char 'ucs (string-to-number number)))
str)
(let ((letter (match-string-no-properties 3 str)))
(cond ((string= "gt" letter) ">")
((string= "lt" letter) "<")
(t "?"))))))
(defun babel-display ()
"Parse and display the region of this for basic HTML entities."
(save-excursion
(goto-char (point-min))
(while (and (< (point) (point-max)) (search-forward-regexp
babel-html-entity-regex
(point-max) t))
(let* ((start (match-beginning 0))
(end (match-end 0))
(entity (buffer-substring start end))
(replacement (babel-decode-html-entitiy entity)))
(delete-region start end)
(insert replacement)))))
(defun babel-mode ()
(interactive)
(kill-all-local-variables)
(use-local-map babel-mode-map)
(setq major-mode 'babel-mode
mode-name "Babel"
buffer-read-only t)
(buffer-disable-undo)
(run-hooks 'babel-mode-hook))
(cond ((fboundp 'string-make-unibyte)
(fset 'babel-make-unibyte #'string-make-unibyte))
((fboundp 'string-as-unibyte)
(fset 'babel-make-unibyte #'string-as-unibyte))
(t
(fset 'babel-make-unibyte #'identity)))
;; from nnweb.el, with added `string-make-unibyte'.
(defun babel-form-encode (pairs)
"Return PAIRS encoded for forms."
(mapconcat
(lambda (data)
(concat (mm-url-form-encode-xwfu (babel-make-unibyte (car data))) "="
(mm-url-form-encode-xwfu (babel-make-unibyte (cdr data)))))
pairs "&"))
;; We mark paragraph endings with a special token, so that we can
;; recover a little information on the original message's format after
;; translation and washing and rendering. Should really be using
;; `paragraph-start' and `paragraph-separate' here, but we no longer
;; have any information on the major-mode of the buffer that STR was
;; ripped from.
;;
;; This kludge depends on the fact that all the translation motors
;; seem to leave words they don't know how to translate alone, passing
;; them through untouched.
(defun babel-preprocess (str)
(while (string-match "\n\n\\|^\\s-+$" str)
(setq str (replace-match " FLOBSiCLE " nil t str)))
str)
;; decode paragraph endings in current buffer
(defun babel-postprocess ()
(goto-char (point-min))
(while (search-forward "FLOBSiCLE" nil t)
(replace-match "\n<p>" nil t)))
(defun babel-simple-html-parse ()
"Replace basic html markup"
(goto-char (point-min))
(while (re-search-forward "<\\(br\\|p\\)/?>" nil t)
(replace-match "\n"))
(goto-char (point-min))
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "")))
;; split STR into chunks of around LENGTH characters, trying to
;; maintain sentence structure (this is used to send big requests in
;; several batches, because otherwise the motors cut off the
;; translation).
(defun babel-chunkify (str chunksize)
(let ((start 0)
(pos 0)
(chunks '()))
(while (setq pos (string-match (babel-sentence-end) str pos))
(incf pos)
(when (> (- pos start) chunksize)
(push (substring str start pos) chunks)
(setq start pos)))
(when (/= start (length str))
(push (substring str start) chunks))
(nreverse chunks)))
;;;###autoload
(defun babel-version (&optional here)
"Show the version number of babel in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((version-string
(format "Babel version %s" babel-version)))
(if here
(insert version-string)
(if (interactive-p)
(message "%s" version-string)
version-string))))
;; Babelfish-specific functions ================================================
;;
;; Babelfish (which uses the SysTran engine) is only able to translate
;; between a limited number of languages.
;; translation from generic names to Babelfish 2-letter names
(defconst babel-fish-languages
'(("en" . "en")
("de" . "de")
("it" . "it")
("pt" . "pt")
("es" . "es")
("fr" . "fr")))
;; those inter-language translations that Babelfish is capable of
(defconst babel-fish-translations
'("en_fr" "en_de" "en_it" "en_pt" "en_es" "fr_en" "de_en" "it_en"
"es_en" "pt_en"))
;; if Babelfish is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-fish-translation (from to)
(let* ((fromb (cdr (assoc from babel-fish-languages)))
(tob (cdr (assoc to babel-fish-languages)))
(comb (and fromb tob (concat fromb "_" tob))))
(find comb babel-fish-translations :test #'string=)))
(defun babel-fish-fetch (msg from to)
"Connect to the Babelfish server and request the translation."
(let ((translation (babel-fish-translation from to)))
(unless translation
(error "Babelfish can't translate from %s to %s" from to))
(let* ((pairs `(("trtext" . ,(mm-encode-coding-string msg 'utf-8))
("lp" . ,translation)
("ei" . "UTF-8")
("doit" . "done")
("fr" . "bf-res")
("intl" . "1")
("tt" . "urltext")
("btnTrTxt" . "Translate")))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://babelfish.yahoo.com/translate_txt" ))))
(defun babel-fish-wash ()
"Extract the useful information from the HTML returned by Babelfish."
(if (not (babel-wash-regex "<div id=\"result\"><div style=\"padding:[0-9.]*em;\">\\([^<]*\\)</div></div>"))
(error "Babelfish HTML has changed ; please look for a new version of babel.el")))
;; FreeTranslation.com stuff ===========================================
;; translation from generic letter names to FreeTranslation names
(defconst babel-free-languages
'(("en" . "English")
("de" . "German")
("it" . "Italian")
("nl" . "Dutch")
("pt" . "Portuguese")
("es" . "Spanish")
("no" . "Norwegian")
("ru" . "Russian")
("zh-CN" . "SimplifiedChinese")
("zh-TW" . "TraditionalChinese")
("fr" . "French")))
;; those inter-language translations that FreeTranslation is capable of
(defconst babel-free-translations
'("English/Spanish" "English/French" "English/German" "English/Italian" "English/Dutch" "English/Portuguese"
"English/Russian" "English/Norwegian" "English/SimplifiedChinese" "English/TraditionalChinese" "Spanish/English"
"French/English" "German/English" "Italian/English" "Dutch/English" "Portuguese/English"))
(defun babel-free-translation (from to)
(let* ((ffrom (cdr (assoc from babel-free-languages)))
(fto (cdr (assoc to babel-free-languages)))
(trans (concat ffrom "/" fto)))
(find trans babel-free-translations :test #'string=)))
(defun babel-free-fetch (msg from to)
"Connect to the FreeTranslation server and request the translation."
(let ((coding-system-for-read 'utf-8)
(translation (babel-free-translation from to))
(url "http://ets.freetranslation.com/"))
(unless translation
(error "FreeTranslation can't translate from %s to %s" from to))
(let* ((pairs `(("sequence" . "core")
("mode" . "html")
("template" . "results_en-us.htm")
("srctext" . ,msg)
("charset" . "UTF-8")
("language" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-mime-accept-string "text/html")
(url-request-method "POST")
(url-privacy-level '(email agent))
(url-mime-charset-string "utf-8")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")
("Referer" . "http://ets.freetranslation.com/"))))
(babel-url-retrieve url))))
(defun babel-free-wash ()
"Extract the useful information from the HTML returned by FreeTranslation."
;;; <textarea name="dsttext" cols="40" rows="6">hello together</textarea><br />
(if (not (babel-wash-regex "<textarea name=\"dsttext\"[^>]+>\\([^<]*\\)</textarea>"))
(error "FreeTranslations HTML has changed ; please look for a new version of babel.el")))
;; Google stuff ===========================================
;; Google supports all languages
(defconst babel-google-languages
babel-languages)
(defun babel-google-translation (from to)
;; Google can always translate in both directions
(find to babel-google-languages
:test '(lambda (st el)
(string= (cdr el) st))))
(defun babel-google-fetch (msg from to)
"Connect to google server and request the translation."
;; Google can always translate in both directions
(if (not (find to babel-google-languages
:test '(lambda (st el)
(string= (cdr el) st))))
(error "Google can't translate from %s to %s" from to)
(let* ((pairs `(("text" . ,(mm-encode-coding-string msg 'utf-8))
("hl" . "en")
("Language" . "English")
("ie" . "UTF-8")
("oe" . "UTF-8")
("sl" . ,from)
("tl" . ,to)))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://translate.google.com/translate_t" ))))
(defun babel-google-wash ()
"Extract the useful information from the HTML returned by google."
(if (not (babel-wash-regex "<div id=result_box dir=\"[^\"]*\">\\(.*?\\)</div>"))
(error "Google HTML has changed ; please look for a new version of babel.el")))
;; TODO: ecs.freetranslation.com
;; (defun babel-debug ()
;; (let ((buf (get-buffer-create "*babel-debug*")))
;; (set-buffer buf)
;; (babel-free-fetch "state mechanisms are too busy" "eng" "ger")))
(easy-menu-add-item nil '("tools") ["Babel Translation" babel t])
(provide 'babel)
;; babel.el ends here
_______________________________________________
gnu-emacs-sources mailing list
address@hidden
http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources