English checker for Japanese

nativechecker.el

;;; 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)