;;; langtool.el --- Grammar check utility using LanguageTool -*- lexical-binding: t -*-

;; Copyright (C) 2011-2020,2022-2023 Masahiro Hayashi

;; Author: Masahiro Hayashi <mhayashi1120@gmail.com>
;; Keywords: docs
;; URL: https://github.com/mhayashi1120/Emacs-langtool
;; Emacs: GNU Emacs 24 or later
;; Version: 2.3.8
;; Package-Requires: ((emacs "24.3"))

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; ## Install:

;; Install LanguageTool version 3.0 or later (and java)
;; https://languagetool.org/
;;
;; Put this file into load-path'ed directory, and byte compile it if
;; desired.  And put the following expression into your ~/.emacs.
;;
;;     (require 'langtool)
;;
;; Or use Melpa (https://melpa.org/)

;; ## NOTE (2023-01-25)
;;
;; Confirmed working on following environment
;;
;; ### Java
;;
;; `java --version`
;;
;; > openjdk 17.0.4 2022-07-19
;; > OpenJDK Runtime Environment (build 17.0.4+8-Debian-1deb11u1)
;; > OpenJDK 64-Bit Server VM (build 17.0.4+8-Debian-1deb11u1, mixed mode, sharing)
;;
;; ### LanguageTool
;;
;; Can be downloaded from [here](https://languagetool.org/download/)
;;
;; `java -jar languagetool-commandline.jar --version`
;;
;; > LanguageTool version 6.0 (2022-12-29 12:13:11 +0000, e44dbb0)

;; ## Settings (required):
;;
;; langtool.el have 3 types of client.

;; 1. Command line
;;
;;  This setting should be set, if you use rest of clients, to get full of
;;  completion support.  And you should be set the variables before load
;;  this library.
;;
;;     (setq langtool-language-tool-jar "/path/to/languagetool-commandline.jar")
;;     (require 'langtool)
;;
;; Alternatively, you can set the classpath where LanguageTool's jars reside
;; (e.g. ArchLinux):
;;
;;     (setq langtool-java-classpath
;;           "/usr/share/languagetool:/usr/share/java/languagetool/*")
;;     (require 'langtool)
;;
;;
;; You can set a script that hold java setting (e.g. Gentoo):
;;
;;     (setq langtool-bin "/path/to/your/langtool")
;;     (require 'langtool)

;; 2. HTTP server & client
;;
;;  You can use HTTP server implementation.  This is very fast after listen server,
;;  but has security risk if there are multiple user on a same host.
;;
;;     (setq langtool-language-tool-server-jar "/path/to/languagetool-server.jar")
;;
;; You can change HTTP server port number like following.
;;
;;     (setq langtool-server-user-arguments '("-p" "8082"))

;; 3. HTTP client
;;
;; If you have running HTTP LanguageTool server instance on any machine:
;;
;;     (setq langtool-http-server-host "localhost"
;;           langtool-http-server-port 8082)
;;
;; Now testing although, that running instance is working under HTTPSServer or via
;; general ssl support (e.g. nginx) following may be working.  Again, this is now
;; testing, so please open issue when the ssl/tls connection is not working.
;;
;;     (setq langtool-http-server-stream-type 'tls)

;; ## Optional settings
;;
;; * Key binding if you desired.
;;
;;     (global-set-key "\C-x4w" 'langtool-check)
;;     (global-set-key "\C-x4W" 'langtool-check-done)
;;     (global-set-key "\C-x4l" 'langtool-switch-default-language)
;;     (global-set-key "\C-x44" 'langtool-show-message-at-point)
;;     (global-set-key "\C-x4c" 'langtool-interactive-correction)

;; * Default language is detected by LanguageTool automatically.
;;   Please set `langtool-default-language` if you need specific language.
;;
;;     (setq langtool-default-language "en-US")
;;
;;   Otherwise, invoke `M-x langtool-check` with `C-u` (universal-argument)

;; * Currently GNU java version is not working.
;;   Please change the variable to your favorite java executable.
;;
;;     (setq langtool-java-bin "/path/to/java")

;; * Maybe your LanguageTool have launcher.  (e.g. Gentoo)
;;   You need to set `langtool-bin'.
;;   See https://github.com/mhayashi1120/Emacs-langtool/issues/24
;;
;;     (setq langtool-bin "/usr/bin/languagetool")

;; * Maybe you want to specify your mother tongue.
;;
;;     (setq langtool-mother-tongue "en")

;; * To customize LanguageTool commandline arguments.
;;
;;     (setq langtool-java-user-arguments '("-Dfile.encoding=UTF-8"))
;;
;;   You can also make the variable to buffer local like following:
;;
;;     (add-hook '**SOME**-mode-hook
;;               (lambda () (set (make-local-variable 'langtool-java-user-arguments)
;;                              '("-Dfile.encoding=UTF-8"))))
;;
;;   NOTE: Although there is no good example, `langtool-user-arguments' is
;;   a similar custom variable.

;; ## Usage:

;; * To check current buffer and show warnings.
;;
;;     M-x langtool-check
;;
;;   Check with different language.  You can complete supported language
;;   with C-i/TAB
;;
;;     C-u M-x langtool-check

;; * To correct marker follow LanguageTool suggestions.
;;
;;     M-x langtool-correct-buffer

;; * Go to warning point you can see a report from LanguageTool.
;;   Otherwise:
;;
;;     M-x langtool-show-message-at-point

;; * You can optionally use extension package `langtool-popup` in this repository.
;;   To show automatically popup the cursor.

;; * To finish checking.  All langtool marker is removed.
;;
;;     M-x langtool-check-done

;;; TODO:

;; * process coding system (test on Windows)
;; * check only docstring (emacs-lisp-mode)
;;    or using (derived-mode-p 'prog-mode) and only string and comment
;; * java encoding <-> elisp encoding (No enough information..)
;; * change to --json argument to parse.

;;; Code:


(require 'cl-lib)
(require 'compile)
(require 'json)
(require 'pcase)

(defgroup langtool nil
  "Customize langtool"
  :prefix "langtool-"
  :group 'applications)

;;;
;;; Variables / Faces
;;;

;;
;; constants
;;

(defconst langtool-output-regexp
  (eval-when-compile
    (concat
     "^[0-9]+\\.) Line \\([0-9]+\\), column \\([0-9]+\\), Rule ID: \\(.*\\)\n"
     "Message: \\(.*\\)\n"
     "\\(?:Suggestion: \\(.*\\)\n\\)?"
     ;; As long as i can read
     ;; src/dev/de/danielnaber/languagetool/dev/wikipedia/OutputDumpHandler.java
     "\\(\\(?:.*\\)\n\\(?:[ ^]+\\)\\)\n"
     "\n?"                              ; last result have no new-line
     )))

;;
;; externals
;;

(defvar current-prefix-arg)
(defvar unread-command-events)
(defvar locale-language-names)

;;
;; faces
;;

(defface langtool-errline
  '((((class color) (background dark)) (:background "Firebrick4"))
    (((class color) (background light)) (:background "LightPink"))
    (t (:bold t)))
  "Face used for marking error lines."
  :group 'langtool)

(defface langtool-correction-face
  '((((class mono)) (:inverse-video t :bold t :underline t))
    (t (:background "red1" :foreground "yellow" :bold t)))
  "Face used to visualize correction."
  :group 'langtool)

;;
;; customize variables
;;

(defcustom langtool-java-bin "java"
  "Executing java command."
  :group 'langtool
  :type 'file)

(defcustom langtool-bin nil
  "Executing LanguageTool command."
  :group 'langtool
  :type 'file)

(defcustom langtool-java-user-arguments nil
  "List of string which is passed to java command as arguments.
This java command holds LanguageTool process.
Otherwise, function which return above value.

e.g. ( Described at http://wiki.languagetool.org/command-line-options )
\(setq langtool-java-user-arguments \\='(\"-Dfile.encoding=UTF-8\"))"
  :group 'langtool
  :type '(choice
          (repeat string)
          function))

(defcustom langtool-language-tool-jar nil
  "LanguageTool jar file.

No need to set this variable when `langtool-java-classpath' is set."
  :group 'langtool
  :type 'file)

(defcustom langtool-language-tool-server-jar nil
  "LanguageTool server jar file.
Very fast, but do not use it if there is unreliable user on a same host."
  :group 'langtool
  :type 'file)

(defcustom langtool-http-server-host nil
  "Normally should be \"localhost\" . Do not set the untrusted host/network.
Your post may not be encrypted application layer, so your privacy may be leaked.

Please set `langtool-http-server-port' either."
  :group 'langtool
  :type 'string)

(defcustom langtool-http-server-port nil
  "See `langtool-http-server-host' ."
  :group 'langtool
  :type 'number)

(defcustom langtool-http-server-stream-type nil
  "This is now testing and not enough tested yet. This value is passed to
`open-network-stream' `:type' argument.
Valid arguments are same to above except `nil'. This means `plain'."
  :group 'langtool
  :type 'symbol)

(defcustom langtool-java-classpath nil
  "Custom classpath to use on special environment.  (e.g. Arch Linux)
Do not set both of this variable and `langtool-language-tool-jar'.

https://github.com/mhayashi1120/Emacs-langtool/pull/12
https://github.com/mhayashi1120/Emacs-langtool/issues/8"
  :group 'langtool
  :type 'string)

(defcustom langtool-default-language nil
  "Language name pass to LanguageTool command.
This is string which indicate locale or `auto' or nil.
Currently `auto' and nil is a same meaning."
  :group 'langtool
  :type '(choice
          string
          (const auto)
          (const nil)))

(defcustom langtool-mother-tongue nil
  "Your mothertongue Language name pass to LanguageTool."
  :group 'langtool
  :type 'string)

(defcustom langtool-disabled-rules nil
  "Disabled rules pass to LanguageTool.
String that separated by comma or list of string."
  :group 'langtool
  :type '(choice
          (list string)
          string))

(defcustom langtool-user-arguments nil
  "Similar to `langtool-java-user-arguments' except this list is appended
after `-jar' argument.

Valid values are described below:
http://wiki.languagetool.org/command-line-options

Do not change this variable if you don't understand what you are doing."
  :group 'langtool
  :type '(choice
          (repeat string)
          function))

(defcustom langtool-server-user-arguments nil
  "`langtool-language-tool-server-jar' customize arguments.
You can pass `--config' option to the server that indicate java property file.

You can see all valid arguments with following command
  (Replace path by yourself):
java -jar /path/to/languagetool-server.jar --help"
  :group 'langtool
  :type '(choice
          (repeat string)
          function))

(defcustom langtool-client-filter-query-function nil
  "Filter function that accept one query form argument.
This query form is an alist will be encoded by `url-build-query-string'.
Call just before POST with `application/x-www-form-urlencoded'."
  :group 'langtool
  :type 'function)

(defcustom langtool-error-exists-hook
  '(langtool-autoshow-ensure-timer)
  "Hook run after LanguageTool process found any error(s)."
  :group 'langtool
  :type 'hook)

(defcustom langtool-noerror-hook nil
  "Hook run after LanguageTool report no error."
  :group 'langtool
  :type 'hook)

(defcustom langtool-finish-hook
  '(langtool-autoshow-cleanup-timer-maybe)
  "Hook run after cleanup buffer."
  :group 'langtool
  :type 'hook)

;;
;; local variables
;;

(defvar langtool-local-disabled-rules nil)
(make-variable-buffer-local 'langtool-local-disabled-rules)

(defvar langtool-temp-file nil)
(make-variable-buffer-local 'langtool-temp-file)

(defvar langtool-buffer-process nil)
(make-variable-buffer-local 'langtool-buffer-process)

(defvar langtool-mode-line-message nil)
(make-variable-buffer-local 'langtool-mode-line-message)
(put 'langtool-mode-line-message 'risky-local-variable t)

(defvar langtool-mode-line-process nil)
(make-variable-buffer-local 'langtool-mode-line-process)
(put 'langtool-mode-line-process 'risky-local-variable t)

(defvar langtool-mode-line-server-process nil)
(put 'langtool-mode-line-server-process 'risky-local-variable t)

(defvar langtool-error-buffer-name " *LanguageTool Errors* ")

(defvar langtool--debug nil)

(defvar langtool--correction-keys
  ;; (q)uit, (c)lear, (e)dit, (i)gnore
  [?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
      ;; suggestions may over 10.
      ;; define rest of alphabet just in case.
      ?a ?b ?d ?f ?g ?h ?j ?k ?l ?m ?n
      ?o ?p ?r ?s ?t ?u ?v ?w ?x ?y ?z])

;;;
;;; Internal functions
;;;

;;
;; basic functions
;;

(defun langtool-region-active-p ()
  (cond
   ((fboundp 'region-active-p)
    (funcall 'region-active-p))
   (t
    (and transient-mark-mode mark-active))))

(defun langtool--debug (key fmt &rest args)
  (when langtool--debug
    (let ((buf (get-buffer-create "*Langtool Debug*")))
      (with-current-buffer buf
        (goto-char (point-max))
        (insert "---------- [" key "] ----------\n")
        (insert (apply #'format fmt args) "\n")))))

(defun langtool--chomp (s)
  (if (string-match "\\(?:\\(\r\n\\)+\\|\\(\n\\)+\\)\\'" s)
      (substring s 0 (match-beginning 0))
    s))

(defun langtool--make-temp-file ()
  (make-temp-file "langtool-"))

;;
;; HTTP basic
;;

(defun langtool-http--parse-response-header ()
  ;; Not a exact parser. Just a necessary. ;-)
  (save-excursion
    (goto-char (point-min))
    (unless (re-search-forward "^\r\n" nil t)
      (error "Parse error.  Not found http header separator"))
    (let (status headers body-start)
      (setq body-start (point))
      (forward-line -1)
      (save-restriction
        (narrow-to-region (point-min) (point))
        (goto-char (point-min))
        (unless (looking-at "^HTTP/[0-9.]+[\s\t]+\\([0-9]+\\)")
          (error "Parse error.  Not found HTTP status code"))
        (setq status (string-to-number (match-string-no-properties 1)))
        (forward-line)
        (while (not (eobp))
          (let (key value)
            (unless (looking-at "^\\([^:]+\\):")
              (error "Invalid header of HTTP response"))
            (setq key (match-string-no-properties 1))
            (goto-char (match-end 0))
            (while (looking-at "[\s\t]+\\(.*\\)\r")
              (setq value (concat value (match-string-no-properties 1)))
              (forward-line 1))
            (setq headers (cons (cons key value) headers))))
        (list status headers body-start)))))

;;
;; handle error overlay
;;

;;FIXME
;;http://sourceforge.net/tracker/?func=detail&aid=3054895&group_id=110216&atid=655717
(defun langtool--fuzzy-search (context-regexp length)
  (let* ((regexp (concat ".*?" context-regexp))
         (default (cons (point) (+ (point) length))))
    (or (and (null regexp)
             (cons (point) (+ (point) length)))
        (and (looking-at regexp)
             (cons (match-beginning 1) (match-end 1)))
        (let ((beg (min (line-beginning-position) (- (point) 20))))
          (cl-loop while (and (not (bobp))
                              (<= beg (point)))
                   ;; backward just sentence length to search sentence after point
                   do (condition-case nil
                          (backward-char length)
                        (beginning-of-buffer nil))
                   if (looking-at regexp)
                   return (cons (match-beginning 1) (match-end 1))))
        default)))

;; TODO, FIXME remove _version completely. Previous version accept
;;    difference output between another version
(defun langtool--compute-start&end (_version check)
  (let ((line (nth 0 check))
        (col (nth 1 check))
        (len (nth 2 check))
        (context (nth 7 check))
        ;; Only Server <-> Client have the data
        (offset (nth 8 check)))
    (cond
     (offset
      (let* ((start (+ (point-min) offset))
             (end (+ start len)))
        (cons start end)))
     (context
      ;; Command-line client have a bug that point to wrong place.
      (goto-char (point-min))
      (forward-line (1- line))
      ;;  1. sketchy move to column that is indicated by LanguageTool.
      ;;  2. fuzzy match to reported sentence which indicated by ^^^ like string.
      ;;  3. restrict to the current line
      (when (< 0 col)
        (forward-char (1- col)))
      (langtool--fuzzy-search context len))
     (t
      (goto-char (point-min))
      (forward-line (1- line))
      (forward-char col)
      (cons (point) (+ (point) len))))))

(defun langtool--create-overlay (version check)
  (cl-destructuring-bind (start . end)
      (langtool--compute-start&end version check)
    (let ((ov (make-overlay start end)))
      (overlay-put ov 'langtool-simple-message (nth 4 check))
      (overlay-put ov 'langtool-message (nth 5 check))
      (overlay-put ov 'langtool-suggestions (nth 3 check))
      (overlay-put ov 'langtool-rule-id (nth 6 check))
      (overlay-put ov 'priority 1)
      (overlay-put ov 'face 'langtool-errline))))

(defun langtool--clear-buffer-overlays ()
  (mapc
   (lambda (ov)
     (delete-overlay ov))
   (langtool--overlays-region (point-min) (point-max))))

(defun langtool--overlays-region (start end)
  (sort
   (remove
    nil
    (mapcar
     (lambda (ov)
       (when (overlay-get ov 'langtool-message)
         ov))
     (overlays-in start end)))
   (lambda (ov1 ov2)
     (< (overlay-start ov1) (overlay-start ov2)))))

(defun langtool--current-error-overlays ()
  (remove nil
          (mapcar
           (lambda (ov)
             (and (overlay-get ov 'langtool-message)
                  ov))
           (overlays-at (point)))))

(defun langtool--expire-buffer-overlays ()
  (mapc
   (lambda (o)
     (unless (overlay-get o 'face)
       (delete-overlay o)))
   (langtool--overlays-region (point-min) (point-max))))

(defun langtool--erase-overlay (ov)
  (overlay-put ov 'face nil))

(defun langtool--next-overlay (current overlays)
  (cl-loop for o in (cdr (memq current overlays))
           if (overlay-get o 'face)
           return o))

(defun langtool--prev-overlay (current overlays)
  (cl-loop for o in (cdr (memq current (reverse overlays)))
           if (overlay-get o 'face)
           return o))

(defun langtool--goto-error (overlays predicate)
  (catch 'done
    (mapc
     (lambda (ov)
       (when (funcall predicate ov)
         (goto-char (overlay-start ov))
         (throw 'done t)))
     overlays)
    nil))

(defun langtool-working-p ()
  (cl-loop with current = (current-buffer)
           for buf in (buffer-list)
           when (and (not (eq buf current))
                     (with-current-buffer buf
                       (langtool--overlays-region
                        (point-min) (point-max))))
           return buf
           finally return nil))

;;
;; utility
;;

(defun langtool-simple-error-message (overlays)
  "Textify error messages as long as simple."
  (mapconcat
   (lambda (ov)
     (format
      "[%s] %s%s"
      (overlay-get ov 'langtool-rule-id)
      (overlay-get ov 'langtool-simple-message)
      (if (overlay-get ov 'langtool-suggestions)
          (concat
           " -> ("
           (mapconcat #'identity (overlay-get ov 'langtool-suggestions) ", ")
           ")")
        "")))
   overlays "\n"))

(defun langtool-details-error-message (overlays)
  "Textify error messages."
  (mapconcat
   (lambda (ov)
     (concat
      (format "Rule ID: %s\n"
              (overlay-get ov 'langtool-rule-id))
      (format "Message: %s\n"
              (overlay-get ov 'langtool-simple-message))
      (if (overlay-get ov 'langtool-suggestions)
          (concat
           "Suggestions: "
           (mapconcat
            #'identity
            (overlay-get ov 'langtool-suggestions)
            "; "))
        "")))
   overlays
   "\n\n"))

(defun langtool--current-error-messages ()
  (mapcar
   (lambda (ov)
     (overlay-get ov 'langtool-message))
   (langtool--current-error-overlays)))

;;;
;;; LanguageTool Process
;;;

;;
;; Process basic
;;

(defmacro langtool--with-java-environ (&rest form)
  `(let ((coding-system-for-read langtool-process-coding-system))
     (progn ,@form)))

(defun langtool--process-file-name (path)
  "Correct the file name depending on the underlying platform.

PATH: The file-name path to be corrected.

Currently corrects the file-name-path when running under Cygwin."
  (setq path (expand-file-name path))
  (cond
   ((eq system-type 'cygwin)
    ;; no need to catch error. (e.g. cygpath is not found)
    ;; this failure means LanguageTools is not working completely.
    (with-temp-buffer
      (call-process "cygpath" nil t nil "--windows" path)
      (langtool--chomp (buffer-string))))
   (t
    path)))

(defcustom langtool-process-coding-system
  (cond
   ((eq system-type 'cygwin)
    'dos)
   (t nil))
  "LanguageTool process coding-system.
Ordinary no need to change this."
  :group 'langtool
  :type 'coding-system)

(defun langtool--custom-arguments (var)
  (let ((value (symbol-value var))
        args)
    (cond
     ((functionp value)
      (setq args (funcall value)))
     ((consp value)
      (setq args value)))
    (copy-sequence args)))

;;
;; Command interaction
;;

(defun langtool--disabled-rules ()
  (let ((custom langtool-disabled-rules)
        (locals langtool-local-disabled-rules))
    (cond
     ((stringp custom)
      (mapconcat #'identity
                 (cons custom locals)
                 ","))
     (t
      (mapconcat #'identity
                 (append custom locals)
                 ",")))))

(defun langtool--basic-command&args ()
  (cond
   (langtool-bin
    (list langtool-bin nil))
   (t
    (let (command args)
      (setq command langtool-java-bin)
      ;; Construct arguments pass to java command
      (setq args (langtool--custom-arguments 'langtool-java-user-arguments))
      (cond
       (langtool-java-classpath
        (setq args (append
                    args
                    (list "-cp" langtool-java-classpath
                          "org.languagetool.commandline.Main")))
        (list command args))
       (langtool-language-tool-jar
        (setq args (append
                    args
                    (list "-jar" (langtool--process-file-name langtool-language-tool-jar))))
        (list command args))
       (t nil))))))

(defun langtool--process-create-client-buffer ()
  (generate-new-buffer " *Langtool* "))

(defun langtool--sentence-to-fuzzy (sentence)
  (mapconcat #'regexp-quote
             ;; this sentence is reported by LanguageTool
             (split-string sentence " +")
             ;; LanguageTool interpreted newline as space.
             "[[:space:]\n]+?"))

(defun langtool--pointed-length (message)
  (or
   (and (string-match "\n\\( *\\)\\(\\^+\\)" message)
        (length (match-string 2 message)))
   ;; never through here, but if return nil from this function make stop everything.
   1))

;;FIXME sometimes LanguageTool reports wrong column.
(defun langtool--pointed-context-regexp (message)
  (when (string-match "\\(.*\\)\n\\( *\\)\\(\\^+\\)" message)
    (let* ((msg1 (match-string 1 message))
           ;; calculate marker "^" start at column
           (pre (length (match-string 2 message)))
           ;; "^" marker length
           (len (length (match-string 3 message)))
           (end (+ pre len))
           (sentence (substring msg1 pre end))
           (regexp (cond
                    ((string-match "^[[:space:]]+$" sentence)
                     ;; invalid sentence only have whitespace,
                     ;; search with around sentence.
                     (concat
                      "\\("
                      (let* ((count (length sentence))
                             (spaces (format "[[:space:]\n]\\{%d\\}" count)))
                        spaces)
                      "\\)"
                      ;; considered truncated spaces that is caused by
                      ;; `langtool--sentence-to-fuzzy'
                      "[[:space:]]*?"
                      ;; to match the correct block
                      ;; suffix of invalid spaces.
                      (langtool--sentence-to-fuzzy
                       (let ((from (min end (length msg1))))
                         ;;TODO magic number.
                         (substring msg1 from (min (length msg1) (+ from 20)))))))
                    (t
                     (concat "\\("
                             (langtool--sentence-to-fuzzy sentence)
                             "\\)")))))
      regexp)))

;;
;; Commandline / HTTP integration
;;

(defun langtool--checker-mode ()
  ;; NOTE: This priority is order by light weight.
  (cond
   ((and langtool-http-server-host
         langtool-http-server-port)
    'http-client)
   (langtool-language-tool-server-jar
    'client-server)
   ((or langtool-language-tool-jar
        langtool-java-classpath
        langtool-bin)
    'commandline)
   (t
    (error "There is no valid setting"))))

(defun langtool--apply-checks (proc checks)
  (let ((source (process-get proc 'langtool-source-buffer))
        (version (process-get proc 'langtool-jar-version))
        (begin (process-get proc 'langtool-region-begin))
        (finish (process-get proc 'langtool-region-finish)))
    (when (buffer-live-p source)
      (with-current-buffer source
        (save-excursion
          (save-restriction
            (when (and begin finish)
              (narrow-to-region begin finish))
            (mapc
             (lambda (check)
               (langtool--create-overlay version check))
             (nreverse checks))))))))

(defun langtool--lazy-apply-checks (proc version checks)
  (let ((source (process-get proc 'langtool-source-buffer))
        (begin (process-get proc 'langtool-region-begin))
        (finish (process-get proc 'langtool-region-finish)))
    (when (buffer-live-p source)
      (with-current-buffer source
        (save-excursion
          (save-restriction
            (when (and begin finish)
              (narrow-to-region begin finish))
            (cond
             ((consp checks)
              (langtool--create-overlay version (car checks))
              (run-with-idle-timer
               1 nil #'langtool--lazy-apply-checks
               proc version (cdr checks)))
             (t
              (let ((source (process-get proc 'langtool-source-buffer)))
                (langtool--check-finish source nil))))))))))

(defun langtool--check-finish (source errmsg)
  (let (marks face)
    (when (buffer-live-p source)
      (with-current-buffer source
        (setq marks (langtool--overlays-region (point-min) (point-max)))
        (setq face (cond
                    (errmsg
                     compilation-error-face)
                    (marks
                     compilation-warning-face)
                    (t
                     compilation-info-face)))
        (setq langtool-buffer-process nil)
        (setq langtool-mode-line-process
              (propertize ":exit" 'face face))
        (cond
         (errmsg
          (message "%s" errmsg))
         (marks
          (run-hooks 'langtool-error-exists-hook)
          (message "%s"
                   (substitute-command-keys
                    "Type \\[langtool-correct-buffer] to correct buffer.")))
         (t
          (run-hooks 'langtool-noerror-hook)
          (message "LanguageTool successfully finished with no error.")))))))

;;
;; LanguageTool Commandline
;;

(defun langtool-command--check-command ()
  (cond
   (langtool-bin
    (unless (executable-find langtool-bin)
      (error "LanguageTool command not executable")))
   ((or (null langtool-java-bin)
        (not (executable-find langtool-java-bin)))
    (error "`java` command is not found")))
  (cond
   (langtool-java-classpath)
   (langtool-language-tool-jar
    (unless (file-readable-p langtool-language-tool-jar)
      (error "LanguageTool jar file is not readable"))))
  (when langtool-buffer-process
    (error "Another process is running")))

;; Create utf-8-unix temporary file if need. This coding-system is
;; troubleless, I think.
(defun langtool-command--maybe-create-temp-file (&optional begin finish)
  (let* ((file (buffer-file-name))
         (cs buffer-file-coding-system)
         (cs-base (coding-system-base cs)))
    (unless langtool-temp-file
      (setq langtool-temp-file (langtool--make-temp-file)))
    ;; create temporary file to pass the text contents to LanguageTool
    (when (or (null file)
              (buffer-modified-p)
              (and begin finish)
              ;; 1 is dos EOL style, this must convert to unix
              ;; dos (CR-LF) style EOL may destroy position of marker.
              (eq (coding-system-eol-type cs) 1)
              ;; us-ascii is included in utf-8
              (and (not (coding-system-equal cs-base 'us-ascii))
                   (not (coding-system-equal cs-base 'utf-8))))
      (save-restriction
        (widen)
        (let ((coding-system-for-write 'utf-8-unix))
          ;; BEGIN nil means entire buffer
          (write-region begin finish langtool-temp-file nil 'no-msg))
        (setq file langtool-temp-file)))
    file))

(defun langtool-command--invoke-process (file begin finish &optional lang)
  (let ((version (langtool--jar-version)))
    (cl-destructuring-bind (command args)
        (langtool--basic-command&args)
      ;; Construct arguments pass to jar file.
      ;; http://wiki.languagetool.org/command-line-options
      (setq args (append
                  args
                  (list
                   "-d" (langtool--disabled-rules))))
      (cond
       ((stringp (or lang langtool-default-language))
        (setq args (append args (list "-l" (or lang langtool-default-language)))))
       (t
        (setq args (append args (list "--autoDetect")))))
      (when langtool-mother-tongue
        (setq args (append args (list "-m" langtool-mother-tongue))))
      (setq args (append args (langtool--custom-arguments 'langtool-user-arguments)))
      (setq args (append args (list (langtool--process-file-name file))))
      (langtool--debug "Command" "%s: %s" command args)
      (let* ((buffer (langtool--process-create-client-buffer))
             (proc (langtool--with-java-environ
                    (apply #'start-process "LanguageTool" buffer command args))))
        (set-process-filter proc 'langtool-command--process-filter)
        (set-process-sentinel proc 'langtool-command--process-sentinel)
        (process-put proc 'langtool-source-buffer (current-buffer))
        (process-put proc 'langtool-region-begin begin)
        (process-put proc 'langtool-region-finish finish)
        (process-put proc 'langtool-jar-version version)
        proc))))

(defun langtool-command--process-filter (proc event)
  (langtool--debug "Filter" "%s" event)
  (with-current-buffer (process-buffer proc)
    (goto-char (point-max))
    (insert event)
    (let ((min (or (process-get proc 'langtool-process-done)
                   (point-min)))
          checks)
      (goto-char min)
      (while (re-search-forward langtool-output-regexp nil t)
        (let* ((line (string-to-number (match-string 1)))
               (column (1- (string-to-number (match-string 2))))
               (rule-id (match-string 3))
               (suggest (match-string 5))
               (msg1 (match-string 4))
               ;; rest of line. Point the raw message.
               (msg2 (match-string 6))
               (message
                (concat "Rule ID: " rule-id "\n"
                        msg1 "\n\n"
                        msg2))
               (suggestions (and suggest (split-string suggest "; ")))
               (context (langtool--pointed-context-regexp msg2))
               (len (langtool--pointed-length msg2)))
          (setq checks (cons
                         (list line column len suggestions
                               msg1 message rule-id context)
                         checks))))
      (process-put proc 'langtool-process-done (point))
      (langtool--apply-checks proc checks))))

(defun langtool-command--process-sentinel (proc event)
  (langtool--debug "Sentinel" "event: %s" event)
  (unless (process-live-p proc)
    (let ((code (process-exit-status proc))
          (pbuf (process-buffer proc))
          (source (process-get proc 'langtool-source-buffer))
          errmsg)
      (cond
       ((buffer-live-p pbuf)
        (when (/= code 0)
          ;; Get first line of output.
          (with-current-buffer pbuf
            (goto-char (point-min))
            (setq errmsg
                  (format "LanguageTool exited abnormally with code %d (%s)"
                          code (buffer-substring (point) (line-end-position))))))
        (kill-buffer pbuf))
       (t
        (setq errmsg "Buffer was dead")))
      (langtool--check-finish source errmsg))))

;;;
;;; Adapter for internal/external server
;;;

(defvar langtool-adapter--plist nil)

(defun langtool-adapter-ensure-internal (process)
  (setq langtool-adapter--plist
        (cons 'internal
              (list
               'process process
               'finalizer `(lambda () (langtool-server-ensure-stop ,process))
               'host (process-get process 'langtool-server-host)
               'port (process-get process 'langtool-server-port)))))

(defun langtool-adapter-ensure-external ()
  (setq langtool-adapter--plist
        (cons 'external
              (list
               'host langtool-http-server-host
               'port langtool-http-server-port
               'stream-type langtool-http-server-stream-type))))

(defun langtool-adapter-get (key)
  (plist-get (cdr langtool-adapter--plist) key))

(defun langtool-adapter-ensure-terminate ()
  (when langtool-adapter--plist
    (let ((finalizer (langtool-adapter-get 'finalizer)))
      (when finalizer
        (funcall finalizer)))
    (setq langtool-adapter--plist nil)))

;;
;; LanguageTool HTTP Server <-> Client
;;

(defun langtool-server--check-command ()
  (cond
   ((or (null langtool-java-bin)
        (not (executable-find langtool-java-bin)))
    (error "java command is not found")))
  (unless langtool-language-tool-server-jar
    (error "Please set `langtool-language-tool-server-jar'"))
  (unless (file-readable-p langtool-language-tool-server-jar)
    (error "languagetool-server jar file is not readable")))

(defun langtool-http-client-check-command ()
  ;; Currently no need to check command. Just HTTP post.
  )

(defun langtool-server-ensure-stop (proc)
  (when (processp proc)
    (let ((buffer (process-buffer proc)))
      (delete-process proc)
      (when (buffer-live-p buffer)
        (kill-buffer buffer)))))

(defun langtool-server--parse-initial-buffer ()
  (save-excursion
    (goto-char (point-min))
    (cond
     ((re-search-forward (eval-when-compile
                           (concat
                            "Starting LanguageTool "
                            "\\([0-9.]+\\)\\(?:-SNAPSHOT\\)? "
                            ".+?"
                            "server on https?://\\([^:]+\\):\\([0-9]+\\)"
                            "\\.\\.\\."
                            "$"))
                         nil t))
     (t
      (error "Unable parse initial buffer")))
    (let ((version (match-string 1))
          (host (match-string 2))
          (port (string-to-number (match-string 3))))
      (list version host port))))

(defun langtool-server--rendezvous (proc buffer)
  (message "Waiting for server")
  (catch 'rendezvous
    (with-current-buffer buffer
      (save-excursion
        (while t
          (goto-char (point-min))
          (when (re-search-forward "Server started" nil t)
            (cl-destructuring-bind (version host port)
                (langtool-server--parse-initial-buffer)
              (when (version< version "4.0")
                (langtool-server-ensure-stop proc)
                (error "LanguageTool Server version must be than 4.0 but now %s"
                       version))
              (process-put proc 'langtool-server-host host)
              (process-put proc 'langtool-server-port port)
              (message "%s done." (current-message))
              (throw 'rendezvous t)))
          (unless (eq (process-status proc) 'run)
            (langtool-server-ensure-stop proc)
            (error "Failed to start LanguageTool Server"))
          (message "%s." (current-message))
          (accept-process-output proc 0.1 nil t))))))

(defvar langtool-server--process-exit-hook nil)

(defun langtool-server--process-sentinel (proc event)
  (langtool--debug "Sentinel" "event: %s" event)
  (unless (process-live-p proc)
    (run-hooks 'langtool-server--process-exit-hook)))

(defun langtool-server--ensure-running ()
  (langtool-server--check-command)
  (unless (let ((proc (langtool-adapter-get 'process)))
            (and  (processp proc)
                  (eq (process-status proc) 'run)))
    ;; Force terminate previous server process if exists.
    (langtool-adapter-ensure-terminate)
    (let* ((bin langtool-java-bin)
           (args '()))
      ;; jar Default setting is "HTTPSServer" .
      ;; This application no need to use SSL since local app.
      ;; http://wiki.languagetool.org/http-server
      (setq args (append args (list
                               "-cp" (langtool--process-file-name
                                      langtool-language-tool-server-jar))))
      (setq args (append args (list "org.languagetool.server.HTTPServer")))
      (setq args (append args langtool-server-user-arguments))
      (langtool--debug "HTTPServer" "%s: %s" bin args)
      (let* ((buffer (get-buffer-create " *LangtoolHttpServer* "))
             (proc (apply
                    #'start-process
                    "LangtoolHttpServer" buffer
                    bin
                    args)))
        (langtool-server--rendezvous proc buffer)
        (set-process-sentinel proc 'langtool-server--process-sentinel)
        (langtool-adapter-ensure-internal proc)
        proc))))

(defun langtool-client--parse-response-json ()
  (let* ((json (json-read))
         (matches (cdr (assq 'matches json)))
         (software (cdr (assq 'software json)))
         (version (cdr (assq 'version software)))
         checks)
    (cl-loop for match across matches
             do (let* ((offset (cdr (assoc 'offset match)))
                       (len (cdr (assoc 'length match)))
                       (rule (cdr (assoc 'rule match)))
                       (rule-id (cdr (assoc 'id rule)))
                       (replacements (cdr (assoc 'replacements match)))
                       (suggestions (mapcar
                                     (lambda (x) (cdr (assoc 'value x)))
                                     replacements))
                       (msg1 (cdr (assoc 'message match)))
                       ;; rest of line. Point the raw message.
                       (msg2 (cdr (assoc 'shortMessage match)))
                       (message
                        (concat "Rule ID: " rule-id "\n"
                                msg1 "\n\n"
                                msg2))
                       ;; No need this value when json
                       (context nil)
                       (line nil)
                       (column nil))
                  (setq checks (cons
                                 (list line column len suggestions
                                       msg1 message rule-id context
                                       offset)
                                 checks))))
    (setq checks (nreverse checks))
    (list version checks)))

(defun langtool-client--parse-response-body (http-headers)
  (let ((ct (cdr (assoc-string "content-type" http-headers t))))
    (cond
     ((string= ct "application/json")
      (langtool-client--parse-response-json))
     (t
      (error "Not a supported Content-Type %s" ct)))))

(defun langtool-client--process-sentinel (proc _event)
  (unless (process-live-p proc)
    (let ((pbuf (process-buffer proc))
          (source (process-get proc 'langtool-source-buffer))
          errmsg version checks)
      (with-current-buffer pbuf
        (cl-destructuring-bind (status headers body-start)
            (langtool-http--parse-response-header)
          (goto-char body-start)
          (cond
           ((= status 200)
            (cl-destructuring-bind (ver result)
                (langtool-client--parse-response-body headers)
              (setq checks result)
              (setq version ver)))
           (t
            (setq errmsg (buffer-substring-no-properties (point) (point-max)))))
          (kill-buffer pbuf)))
      ;; after cleanup buffer.
      (cond
       (errmsg
        (langtool--check-finish source errmsg))
       (t
        (langtool--lazy-apply-checks proc version checks))))))

(defun langtool-client--process-filter (proc event)
  (langtool--debug "Filter" "%s" event)
  (with-current-buffer (process-buffer proc)
    (goto-char (point-max))
    (insert event)))

(defun langtool-client--make-post-data (&optional begin finish lang)
  (let* ((text (buffer-substring-no-properties (or begin (point-min)) (or finish (point-max))))
         (disabled-rules (langtool--disabled-rules))
         (language (cond
                    ((stringp (or lang langtool-default-language))
                     (or lang langtool-default-language))
                    (t
                     "auto")))
         (query `(
                  ("language" ,language)
                  ("text" ,text)
                  ,@(and langtool-mother-tongue
                         `(("motherTongue" ,langtool-mother-tongue)))
                  ("disabledRules" ,disabled-rules)))
         query-string)
    (when (and langtool-client-filter-query-function
               (functionp langtool-client-filter-query-function))
      (setq query (funcall langtool-client-filter-query-function query)))
    ;; UTF-8 encoding if value is multibyte character
    (setq query-string (url-build-query-string query))
    query-string))

(defun langtool-client--http-post (data)
  (let* ((host (langtool-adapter-get 'host))
         (port (langtool-adapter-get 'port))
         (buffer (langtool--process-create-client-buffer))
         (url-path "/v2/check")
         (client (let ((coding-system-for-write 'binary)
                       (coding-system-for-read 'utf-8-unix))
                   (open-network-stream
                    "LangtoolHttpClient" buffer host port
                    :type (or (langtool-adapter-get 'stream-type) 'plain)))))
    (process-send-string
     client
     (concat
      (format "POST %s HTTP/1.1\r\n" url-path)
      (format "Host: %s:%d\r\n" host port)
      (format "Content-length: %d\r\n" (length data))
      (format "Content-Type: application/x-www-form-urlencoded\r\n")
      (format "\r\n")
      data))
    (process-send-eof client)
    client))

(defun langtool-client--invoke-process (&optional begin finish lang)
  (let* ((data (langtool-client--make-post-data begin finish lang))
         (proc (langtool-client--http-post data)))
    (set-process-sentinel proc 'langtool-client--process-sentinel)
    (set-process-filter proc 'langtool-client--process-filter)
    (process-put proc 'langtool-source-buffer (current-buffer))
    (process-put proc 'langtool-region-begin begin)
    (process-put proc 'langtool-region-finish finish)
    proc))

;;
;; HTTP or commandline interface caller
;;

(defun langtool--invoke-checker-process (&optional begin finish lang)
  (when (listp mode-line-process)
    (add-to-list 'mode-line-process '(t langtool-mode-line-message)))
  ;; clear previous check
  (langtool--clear-buffer-overlays)
  (let (proc)
    (cl-ecase (langtool--checker-mode)
      ((commandline)
       ;; Ensure adapter is closed. That has been constructed other checker-mode.
       (langtool-adapter-ensure-terminate)
       (let ((file (langtool-command--maybe-create-temp-file begin finish)))
         (setq proc (langtool-command--invoke-process file begin finish lang))))
      ((client-server)
       (langtool-server--ensure-running)
       (setq langtool-mode-line-server-process
             (propertize ":server" 'face compilation-info-face))
       (add-hook 'langtool-server--process-exit-hook
                 (lambda ()
                   (setq langtool-mode-line-server-process nil)))
       (setq proc (langtool-client--invoke-process begin finish lang)))
      ((http-client)
       (langtool-adapter-ensure-terminate)
       ;; Construct new adapter each check.
       ;; Since maybe change customize variable in a Emacs session.
       (langtool-adapter-ensure-external)
       (setq proc (langtool-client--invoke-process begin finish lang))))
    (setq langtool-buffer-process proc)
    (setq langtool-mode-line-process
          (propertize ":run" 'face compilation-info-face))
    (setq langtool-mode-line-message
          (list " "
                "LT"                    ; LT <= LanguageTool shorthand
                'langtool-mode-line-server-process
                'langtool-mode-line-process))))

(defun langtool--cleanup-process ()
  ;; cleanup mode-line
  (let ((cell (and (listp mode-line-process) ; Check type
                   (rassoc '(langtool-mode-line-message) mode-line-process))))
    (when cell
      (setq mode-line-process (remq cell mode-line-process))))
  (when (and langtool-buffer-process
             (processp langtool-buffer-process))
    ;; TODO buffer killed, error. if process is local process (e.g. urllib)
    (delete-process langtool-buffer-process))
  (kill-local-variable 'langtool-buffer-process)
  (kill-local-variable 'langtool-mode-line-message)
  (kill-local-variable 'langtool-local-disabled-rules)
  (langtool--clear-buffer-overlays)
  (run-hooks 'langtool-finish-hook))

(defun langtool--check-command ()
  (cl-ecase (langtool--checker-mode)
    ((commandline)
     (langtool-command--check-command))
    ((client-server)
     (langtool-server--check-command))
    ((http-client)
     (langtool-http-client-check-command))))

(defun langtool--brief-execute (langtool-args parser)
  (pcase (langtool--basic-command&args)
    (`(,command ,args)
     ;; Construct arguments pass to jar file.
     (setq args (append args langtool-args))
     (with-temp-buffer
       (when (and command args
                  (executable-find command)
                  (= (langtool--with-java-environ
                      (apply #'call-process command nil t nil args))
                     0))
         (goto-char (point-min))
         (funcall parser))))
    (_
     nil)))

(defun langtool--available-languages ()
  (langtool--brief-execute
   (list "--list")
   (lambda ()
     (let ((res '()))
       (while (re-search-forward "^\\([^\s\t]+\\)" nil t)
         (setq res (cons (match-string 1) res)))
       (nreverse res)))))

(defun langtool--jar-version-string ()
  (langtool--brief-execute
   (list "--version")
   (lambda ()
     (langtool--chomp (buffer-string)))))

(defun langtool--jar-version ()
  (let ((string (langtool--jar-version-string)))
    (cond
     ((null string) nil)
     ((string-match "version \\([0-9.]+\\)" string)
      (match-string 1 string))
     (t
      ;; Unknown version, but should not raise error in this function.
      "0.0"))))

;;
;; interactive correction
;;

(defun langtool--ignore-rule (rule overlays)
  (cl-loop for ov in overlays
           do (let ((r (overlay-get ov 'langtool-rule-id)))
                (when (equal r rule)
                  (langtool--erase-overlay ov)))))

(defun langtool--correction (overlays)
  (let ((conf (current-window-configuration)))
    (unwind-protect
        (let ((next (car overlays)))
          (while (setq next (langtool--correction-loop next overlays))))
      (langtool--expire-buffer-overlays)
      (set-window-configuration conf)
      (kill-buffer (langtool--correction-buffer)))))

(defun langtool--correction-loop (ov overlays)
  (let* ((suggests (overlay-get ov 'langtool-suggestions))
         (msg (overlay-get ov 'langtool-simple-message))
         (alist (langtool--correction-popup msg suggests)))
    (catch 'next
      (while (progn
               (goto-char (overlay-start ov))
               (let (message-log-max)
                 (message (concat "C-h or ? for more options; "
                                  "SPC to leave unchanged, "
                                  "Digit to replace word")))
               (let* ((echo-keystrokes) ; suppress echoing
                      (c (downcase (read-char)))
                      (pair (assq c alist)))
                 (cond
                  (pair
                   (let ((sug (nth 1 pair)))
                     ;;TODO when region contains newline.
                     ;; -> insert newline after suggestion.
                     (delete-region (overlay-start ov) (overlay-end ov))
                     (insert sug)
                     (langtool--erase-overlay ov))
                   nil)
                  ((memq c '(?q))
                   (keyboard-quit))
                  ((memq c '(?c))
                   (langtool--erase-overlay ov)
                   nil)
                  ((memq c '(?e))
                   (message (substitute-command-keys
                             "Type \\[exit-recursive-edit] to finish the edit."))
                   (recursive-edit)
                   ;; stay current cursor and wait next user command.
                   (throw 'next ov))
                  ((memq c '(?i))
                   (let ((rule (overlay-get ov 'langtool-rule-id)))
                     (unless (member rule langtool-local-disabled-rules)
                       (setq langtool-local-disabled-rules
                             (cons rule langtool-local-disabled-rules)))
                     (langtool--ignore-rule rule overlays))
                   nil)
                  ((memq c '(?\C-h ?\?))
                   (langtool--correction-help)
                   t)
                  ((memq c '(?\d))
                   (throw 'next (langtool--prev-overlay ov overlays)))
                  ((memq c '(?\s)) nil)
                  (t (ding) t)))))
      ;; next item
      (langtool--next-overlay ov overlays))))

(defun langtool--correction-popup (msg suggests)
  (let ((buf (langtool--correction-buffer)))
    (delete-other-windows)
    (let ((win (split-window)))
      (set-window-buffer win buf))
    (with-current-buffer buf
      (let ((inhibit-read-only t))
        (erase-buffer)
        (insert msg "\n\n")
        (cl-loop for s in suggests
                 for c across langtool--correction-keys
                 do (progn
                      (insert "(" c ") ")
                      (let ((start (point)))
                        (insert s)
                        ;; colorize suggestion.
                        ;; suggestion may contains whitespace.
                        (let ((ov (make-overlay start (point))))
                          (overlay-put ov 'face 'langtool-correction-face)))
                      (insert "\n"))
                 collect (list c s))))))

(defun langtool--correction-help ()
  (let ((help-1 "[q/Q]uit correction; [c/C]lear the colorized text; ")
        (help-2 "[i/I]gnore the rule over current session.")
        (help-3 "[e/E]dit the buffer manually")
        (help-4 "SPC skip; DEL move backward;"))
    (save-window-excursion
      (unwind-protect
          (let ((resize-mini-windows 'grow-only))
            (select-window (minibuffer-window))
            (erase-buffer)
            (message nil)
            ;;(set-minibuffer-window (selected-window))
            (enlarge-window 2)
            (insert (concat help-1 "\n" help-2 "\n" help-3 "\n" help-4))
            (sit-for 5))
        (erase-buffer)))))

(defun langtool--correction-buffer ()
  (get-buffer-create "*Langtool Correction*"))

;;
;; Misc UI
;;

(defun langtool--show-message-buffer (msg)
  (let ((buf (get-buffer-create langtool-error-buffer-name)))
    (with-current-buffer buf
      (erase-buffer)
      (insert msg))
    (save-window-excursion
      (display-buffer buf)
      (let* ((echo-keystrokes)
             (event (read-event)))
        (setq unread-command-events (list event))))))

;;
;; initialize
;;

(defun langtool--guess-language ()
  (let ((env (or (getenv "LANG")
                 (getenv "LC_ALL")))
        (supported-langs (langtool--available-languages))
        lang country mems)
    (and env
         (string-match "\\`\\(..\\)_\\(..\\)?" env)
         (setq lang (downcase (match-string 1 env)))
         (setq country (and (match-string 2 env)
                            (upcase (match-string 2 env)))))
    (or
     (and
      lang country
      (setq mems (member (format "%s-%s" lang country) supported-langs))
      (car mems))
     (and
      lang
      (setq mems (cl-member-if
                  (lambda (x) (string-match
                               (concat "\\`" (regexp-quote lang)) x))
                  supported-langs))
      (car mems)))))

;;
;; autoshow message
;;

(defcustom langtool-autoshow-message-function
  #'langtool-autoshow-default-message
  "Function with one argument which displaying error overlays reported
 by LanguageTool. These overlays hold some useful properties:
 `langtool-simple-message', `langtool-rule-id', `langtool-suggestions' .
`langtool-autoshow-default-message' is a default/sample implementations.
See the Commentary section for `popup' implementation."
  :group 'langtool
  :type '(choice
          (const nil)
          function))

(defcustom langtool-autoshow-idle-delay 0.5
  "Number of seconds while idle time to wait before showing error message."
  :group 'langtool
  :type 'number)

(defvar langtool-autoshow--current-idle-delay nil)

(defvar langtool-autoshow--timer nil
  "Hold idle timer watch every LanguageTool processed buffer.")

(defun langtool-autoshow-default-message (overlays)
  ;; Do not interrupt current message
  (unless (current-message)
    (let ((msg (langtool-simple-error-message overlays)))
      (message "%s" msg))))

(defun langtool-autoshow--maybe ()
  (when langtool-autoshow-message-function
    (let ((delay (langtool-autoshow--idle-delay)))
      (cond
       ((equal langtool-autoshow--current-idle-delay delay))
       (t
        (setq langtool-autoshow--current-idle-delay delay)
        (timer-set-idle-time langtool-autoshow--timer
                             langtool-autoshow--current-idle-delay t))))
    (condition-case err
        (let ((error-overlays (langtool--current-error-overlays)))
          (when error-overlays
            (funcall langtool-autoshow-message-function error-overlays)))
      (error
       (message "langtool: %s" err)))))

(defun langtool-autoshow--idle-delay ()
  (if (numberp langtool-autoshow-idle-delay)
      langtool-autoshow-idle-delay
    (default-value 'langtool-autoshow-idle-delay)))

(defun langtool-autoshow-ensure-timer ()
  (unless (and (timerp langtool-autoshow--timer)
               (memq langtool-autoshow--timer timer-idle-list))
    (setq langtool-autoshow--timer
          (run-with-idle-timer
           (langtool-autoshow--idle-delay) t 'langtool-autoshow--maybe)))
  (add-hook 'kill-buffer-hook #'langtool-autoshow-cleanup-timer-maybe nil t))

(defun langtool-autoshow-cleanup-timer-maybe ()
  (unless (langtool-working-p)
    (when (timerp langtool-autoshow--timer)
      (cancel-timer langtool-autoshow--timer)
      (setq langtool-autoshow--timer nil))))

;;;
;;; interactive commands
;;;

(defun langtool-read-lang-name ()
  (let ((completion-ignore-case t)
        (set
         (append
          '(("auto" . auto))
          (or (mapcar #'list (langtool--available-languages))
              (mapcar (lambda (x) (list (car x))) locale-language-names)))))
    (let ((key (completing-read "Lang: " set)))
      (or (cdr (assoc key set)) key))))

(defun langtool-goto-next-error ()
  "Obsoleted function.  Should use `langtool-correct-buffer'.
Go to next error."
  (interactive)
  (let ((overlays (langtool--overlays-region (point) (point-max))))
    (langtool--goto-error
     overlays
     (lambda (ov) (< (point) (overlay-start ov))))))

(defun langtool-goto-previous-error ()
  "Obsoleted function.  Should use `langtool-correct-buffer'.
Goto previous error."
  (interactive)
  (let ((overlays (langtool--overlays-region (point-min) (point))))
    (langtool--goto-error
     (reverse overlays)
     (lambda (ov) (< (overlay-end ov) (point))))))

(defun langtool-show-message-at-point ()
  "Show error details at point."
  (interactive)
  (let ((ovs (langtool--current-error-overlays)))
    (if (null ovs)
        (message "No errors")
      (let ((msg (langtool-details-error-message ovs)))
        (langtool--show-message-buffer msg)))))

(defun langtool-show-brief-message-at-point ()
  "Show error brief message at point."
  (interactive)
  (let ((msgs (langtool--current-error-messages)))
    (if (null msgs)
        (message "No errors")
      (langtool--show-message-buffer
       (mapconcat #'identity msgs "\n")))))

(defun langtool-check-done ()
  "Finish LanguageTool process and cleanup existing colorized texts."
  (interactive)
  (langtool--cleanup-process)
  (force-mode-line-update)
  (message "Cleaned up LanguageTool."))

;;;###autoload
(defalias 'langtool-check #'langtool-check-buffer)

;;;###autoload
(defun langtool-check-buffer (&optional lang)
  "Check context current buffer and light up errors.
Optional \\[universal-argument] read LANG name.

You can change the `langtool-default-language' to apply all session.
Restrict to selection when region is activated."
  (interactive
   (when current-prefix-arg
     (list (langtool-read-lang-name))))
  (langtool--check-command)
  ;; probablly ok...
  (let* ((region-p (langtool-region-active-p))
         (begin (and region-p (region-beginning)))
         (finish (and region-p (region-end))))
    (when region-p
      (deactivate-mark))
    (langtool--invoke-checker-process begin finish lang)
    (force-mode-line-update)))

;;;###autoload
(defun langtool-switch-default-language (lang)
  "Switch `langtool-default-language' to LANG."
  (interactive (list (langtool-read-lang-name)))
  (setq langtool-default-language lang)
  (message "Now default language is `%s'" lang))

(defun langtool-correct-region (start end)
  "Execute interactive correction after `langtool-check' on the region."
  (let ((ovs (langtool--overlays-region start end)))
    (if (null ovs)
        (message "No error found. %s"
                 (substitute-command-keys
                  (concat
                   "Type \\[langtool-check-done] to finish checking "
                   "or type \\[langtool-check] to re-check buffer")))
      (barf-if-buffer-read-only)
      (langtool--correction ovs))))

;; Remaining backward compat. Should use `langtool-interactive-correction'
(defun langtool-correct-buffer ()
  "Execute interactive correction after `langtool-check'."
  (interactive)
  (langtool-correct-region (point-min) (point-max)))

(defun langtool-correct-at-point ()
  "Execute interactive correction at the point."
  (interactive)
  (langtool-correct-region (point) (point)))

(defun langtool-interactive-correction ()
  "Execute interactive correction for the current editor context.
If region active, just correct that range."
  (interactive)
  (cond
   ((langtool-region-active-p)
    (let ((start (region-beginning))
          (end (region-end)))
      (deactivate-mark)
      (langtool-correct-region start end)))
   (t
    (langtool-correct-region (point-min) (point-max)))))

(defun langtool-server-stop ()
  "Terminate LanguageTool HTTP server."
  (interactive)
  (langtool-adapter-ensure-terminate)
  (message "Server is terminated."))

(defun langtool-toggle-debug ()
  "Toggle LanguageTool debugging."
  (interactive)
  (setq langtool--debug (not langtool--debug))
  (if langtool--debug
      (message "Langtool debug ON.")
    (message "Langtool debug off.")))

;;;
;;; initialize
;;;

;; initialize custom variables guessed from environment.
(let ((mt (langtool--guess-language)))
  (unless langtool-mother-tongue
    (setq langtool-mother-tongue mt)))

(provide 'langtool)

;;; langtool.el ends here