Created
July 13, 2011 16:35
-
-
Save mhayashi1120/1080701 to your computer and use it in GitHub Desktop.
English checker for Japanese
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; Install: | |
;; Put this file into load-path'ed directory, and byte compile it if | |
;; desired. And put the following expression into your ~/.emacs. | |
;; | |
;; (require 'nativechecker) | |
;;; Usage: | |
;; M-x nativechecker | |
;;; TODO: | |
;;; Code: | |
(require 'json) | |
(require 'url) | |
(defvar unread-command-events) | |
(defvar transient-mark-mode) | |
(defun nativechecker (sentence) | |
"todo NativeChecker を使って文章をチェックする" | |
(interactive | |
(list (nativechecker--current-sentence))) | |
(let ((json (nativechecker--search sentence))) | |
(when json | |
(let ((text (nativechecker--results-text json))) | |
(nativechecker--dropdown-text text))))) | |
(defvar nativechecker--cache (make-hash-table)) | |
(defun nativechecker--search (sentence) | |
(let* ((params `(("phrase" . ,sentence) | |
("action" . "check") | |
("component" . "check") | |
("time" . ,(nativechecker--current-time)))) | |
(url (concat | |
"http://native-checker.com/native-checker/teeda.ajax" | |
"?" | |
(mapconcat (lambda (pair) | |
(format "%s=%s" | |
(url-hexify-string (car pair)) | |
(url-hexify-string (cdr pair)))) | |
params "&")))) | |
(nativechecker--retrieve url))) | |
(defun nativechecker--retrieve (url) | |
(let (url-show-status) | |
(let ((buffer (url-retrieve-synchronously url)) | |
json) | |
(with-current-buffer buffer | |
(goto-char (point-min)) | |
(when (re-search-forward "^$" nil t) | |
(setq json (decode-coding-string (buffer-substring (point) (point-max)) 'utf-8)) | |
(json-read-from-string json)))))) | |
(defun nativechecker--context-propertize (context) | |
(let ((c context) | |
res) | |
(while (string-match "<b>\\([^<]+\\)</b>" c) | |
(setq res | |
(concat res | |
(substring c 0 (match-beginning 0)) | |
(propertize (match-string 1 c) 'face 'bold-italic))) | |
(setq c (substring c (match-end 0)))) | |
(setq res (concat res c)) | |
res)) | |
(defun nativechecker--results-text (json) | |
(let ((contexts (cdr (assq 'contexts json)))) | |
(if (and contexts (> (length contexts) 0)) | |
(mapconcat | |
(lambda (c) (nativechecker--context-propertize c)) | |
contexts "\n") | |
(let ((err (cdr (assq 'errorMessage json)))) | |
(unless (and err (> (length err) 0)) | |
(setq err "Unable get answer.")) | |
(when err | |
(propertize err 'face 'font-lock-warning-face)))))) | |
(defun nativechecker--dropdown-text (text) | |
(let ((modified (buffer-modified-p)) | |
(inhibit-read-only t) | |
start end) | |
(save-excursion | |
(end-of-line) | |
(setq start (point)) | |
(insert "\n ") | |
(set-buffer-modified-p modified) | |
(setq end (point))) | |
(unwind-protect | |
(let* ((start (line-beginning-position 2)) | |
(ov (make-overlay start (1+ start)))) | |
(unwind-protect | |
(progn | |
(overlay-put ov 'display text) | |
(overlay-put ov 'face `(background-color . "beige")) | |
(save-window-excursion | |
(nativechecker--recenter-if) | |
(let* ((echo-keystrokes) | |
(event (read-event))) | |
(setq unread-command-events (list event))))) | |
(delete-overlay ov))) | |
(delete-region start end) | |
(set-buffer-modified-p modified)))) | |
(defun nativechecker--recenter-if () | |
;;TODO wrong at bottom of buffer and window | |
(let ((min (max (/ (window-height) 2) 5)) | |
(bottom (- (line-number-at-pos (window-end)) (line-number-at-pos (point))))) | |
(when (> min bottom) | |
(recenter (- (window-height) min))))) | |
(defun nativechecker--current-sentence () | |
(let ((sent (if (and transient-mark-mode mark-active) | |
(buffer-substring-no-properties (region-beginning) (region-end)) | |
(save-excursion | |
(let (start end) | |
(backward-sentence) | |
(setq start (point)) | |
(forward-sentence) | |
(setq end (point)) | |
(buffer-substring-no-properties start end)))))) | |
(while (string-match "\\([\n\t]\\| \\)+" sent) | |
(setq sent (replace-match " " nil nil sent 1))) | |
(read-from-minibuffer "Sentence: " sent))) | |
(defun nativechecker--current-time () | |
(let ((system-time-locale "C")) | |
(format-time-string "%a %b %d %Y %H:%M:%S GMT%z"))) | |
(provide 'nativechecker) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment