From b0d8718e7c22aa9dc1eb6147cda4cf89235fec23 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Sat, 20 Feb 2016 13:59:21 +0100 Subject: [PATCH] update langtool. --- .../langtool-autoloads.el | 2 +- .../langtool-pkg.el | 2 +- .../langtool.el | 936 ++++++++++++------ elpa/langtool-readme.txt | 86 ++ 4 files changed, 738 insertions(+), 288 deletions(-) rename elpa/{langtool-20150609.2131 => langtool-20160116.1654}/langtool-autoloads.el (92%) rename elpa/{langtool-20150609.2131 => langtool-20160116.1654}/langtool-pkg.el (64%) rename elpa/{langtool-20150609.2131 => langtool-20160116.1654}/langtool.el (62%) create mode 100644 elpa/langtool-readme.txt diff --git a/elpa/langtool-20150609.2131/langtool-autoloads.el b/elpa/langtool-20160116.1654/langtool-autoloads.el similarity index 92% rename from elpa/langtool-20150609.2131/langtool-autoloads.el rename to elpa/langtool-20160116.1654/langtool-autoloads.el index 478985ab..583d6169 100644 --- a/elpa/langtool-20150609.2131/langtool-autoloads.el +++ b/elpa/langtool-20160116.1654/langtool-autoloads.el @@ -3,7 +3,7 @@ ;;; Code: (add-to-list 'load-path (or (file-name-directory #$) (car load-path))) -;;;### (autoloads nil "langtool" "langtool.el" (21908 14228 0 0)) +;;;### (autoloads nil "langtool" "langtool.el" (22215 7967 0 0)) ;;; Generated autoloads from langtool.el (defalias 'langtool-check 'langtool-check-buffer) diff --git a/elpa/langtool-20150609.2131/langtool-pkg.el b/elpa/langtool-20160116.1654/langtool-pkg.el similarity index 64% rename from elpa/langtool-20150609.2131/langtool-pkg.el rename to elpa/langtool-20160116.1654/langtool-pkg.el index a9b68b90..99604321 100644 --- a/elpa/langtool-20150609.2131/langtool-pkg.el +++ b/elpa/langtool-20160116.1654/langtool-pkg.el @@ -1 +1 @@ -(define-package "langtool" "20150609.2131" "Grammar check utility using LanguageTool" '((cl-lib "0.3")) :url "https://github.com/mhayashi1120/Emacs-langtool" :keywords '("docs")) +(define-package "langtool" "20160116.1654" "Grammar check utility using LanguageTool" '((cl-lib "0.3")) :url "https://github.com/mhayashi1120/Emacs-langtool" :keywords '("docs")) diff --git a/elpa/langtool-20150609.2131/langtool.el b/elpa/langtool-20160116.1654/langtool.el similarity index 62% rename from elpa/langtool-20150609.2131/langtool.el rename to elpa/langtool-20160116.1654/langtool.el index 6fce1c7e..c6252c0f 100644 --- a/elpa/langtool-20150609.2131/langtool.el +++ b/elpa/langtool-20160116.1654/langtool.el @@ -2,10 +2,10 @@ ;; Author: Masahiro Hayashi ;; Keywords: docs -;; Package-Version: 20150609.2131 +;; Package-Version: 20160116.1654 ;; URL: https://github.com/mhayashi1120/Emacs-langtool ;; Emacs: GNU Emacs 24 or later -;; Version: 1.3.1 +;; Version: 1.5.1 ;; Package-Requires: ((cl-lib "0.3")) ;; This program is free software; you can redistribute it and/or @@ -46,19 +46,29 @@ ;; (setq langtool-java-classpath ;; "/usr/share/languagetool:/usr/share/java/languagetool/*") -;; This setting is optional +;; These settings are optional: + +;; * 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-correct-buffer) + +;; * Default language is detected by LANG/LC_ALL environment variable. +;; Please set `langtool-default-language` if you need to change default value. ;; -;; Currently GNU java version not works. +;; (setq langtool-default-language "en-US") ;; -;; (setq langtool-java-bin "/path/to/java") +;; 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. ;; -;; Maybe you want to specify your mother tongue. +;; (setq langtool-java-bin "/path/to/java") + +;; * Maybe you want to specify your mother tongue. ;; ;; (setq langtool-mother-tongue "en") @@ -67,15 +77,37 @@ ;; * 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 -;; * Goto warning point and +;; * Go to warning point you can see a report from LanguageTool. +;; Otherwise: ;; ;; M-x langtool-show-message-at-point +;; * Show LanguageTool report automatically by `popup' +;; This idea come from: +;; http://d.hatena.ne.jp/LaclefYoshi/20150912/langtool_popup +;; +;; (defun langtool-autoshow-detail-popup (overlays) +;; (when (require 'popup nil t) +;; ;; Do not interrupt current popup +;; (unless (or popup-instances +;; ;; suppress popup after type `C-g' . +;; (memq last-command '(keyboard-quit))) +;; (let ((msg (langtool-details-error-message overlays))) +;; (popup-tip msg))))) +;; +;; (setq langtool-autoshow-message-function +;; 'langtool-autoshow-detail-popup) + ;; * To finish checking. All langtool marker is removed. ;; ;; M-x langtool-check-done @@ -86,7 +118,8 @@ ;; * check only docstring (emacs-lisp-mode) ;; or using (derived-mode-p 'prog-mode) and only string and comment ;; * I don't know well about java. But GNU libgcj version not works.. -;; * java encoding <-> elisp encoding +;; * java encoding <-> elisp encoding (No enough information..) +;; * should use --api argument ;;; Code: @@ -98,10 +131,38 @@ :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")) @@ -109,33 +170,49 @@ "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." + "Executing java command." :group 'langtool :type 'file) (defcustom langtool-language-tool-jar nil - "*LanguageTool jar file." + "LanguageTool jar file. + +No need to set this variable when `langtool-java-classpath' is set." :group 'langtool :type 'file) (defcustom langtool-java-classpath nil - "Custom classpath to use when executing languagetool" + "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." + "Language name pass to LanguageTool." :group 'langtool :type 'string) (defcustom langtool-mother-tongue nil - "*Your mothertongue Language name pass to LanguageTool." + "Your mothertongue Language name pass to LanguageTool." :group 'langtool :type 'string) (defcustom langtool-disabled-rules nil - "*Disabled rules pass to LanguageTool. + "Disabled rules pass to LanguageTool. String that separated by comma or list of string. " :group 'langtool @@ -143,24 +220,33 @@ String that separated by comma or list of string. (list string) string)) +(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) -(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 - ))) - (defvar langtool-buffer-process nil) (make-variable-buffer-local 'langtool-buffer-process) @@ -170,6 +256,28 @@ String that separated by comma or list of string. (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 +;; + +(defmacro langtool--with-java-environ (&rest form) + `(let ((coding-system-for-read langtool-process-coding-system)) + (progn ,@form))) + (defun langtool-region-active-p () (cond ((fboundp 'region-active-p) @@ -177,144 +285,6 @@ String that separated by comma or list of string. (t (and transient-mark-mode mark-active)))) -(defun langtool-goto-next-error () - "Obsoleted function. Should use `langtool-correct-buffer'. -Goto 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 ((msgs (langtool--current-error-messages))) - (if (null msgs) - (message "No errors") - (let ((buf (get-buffer-create langtool-error-buffer-name))) - (with-current-buffer buf - (erase-buffer) - (mapc - (lambda (msg) (insert msg "\n")) - msgs)) - (save-window-excursion - (display-buffer buf) - (let* ((echo-keystrokes) - (event (read-event))) - (setq unread-command-events (list event)))))))) - -(defun langtool-check-done () - "Finish LanguageTool process and cleanup existing colorized texts." - (interactive) - (when langtool-buffer-process - (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) - (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... - (when (listp mode-line-process) - (add-to-list 'mode-line-process '(t langtool-mode-line-message))) - (let* ((file (buffer-file-name)) - (region-p (langtool-region-active-p)) - (begin (and region-p (region-beginning))) - (finish (and region-p (region-end)))) - (when region-p - (deactivate-mark)) - (unless langtool-temp-file - (setq langtool-temp-file (make-temp-file "langtool-"))) - (when (or (null file) (buffer-modified-p) region-p) - (save-restriction - (widen) - (let ((coding-system-for-write buffer-file-coding-system)) - (write-region begin finish langtool-temp-file nil 'no-msg)) - (setq file langtool-temp-file))) - ;; clear previous check - (langtool--clear-buffer-overlays) - (let ((command langtool-java-bin) - args) - (setq args (list "-c" (langtool--java-coding-system buffer-file-coding-system) - "-l" (or lang langtool-default-language) - "-d" (langtool--disabled-rules))) - (if langtool-java-classpath - (setq args (append (list "-cp" langtool-java-classpath - "org.languagetool.commandline.Main") - args)) - (setq args (append - (list "-jar" (expand-file-name langtool-language-tool-jar)) - args))) - (when langtool-mother-tongue - (setq args (append args (list "-m" langtool-mother-tongue)))) - (setq args (append args (list file))) - (langtool--debug "Command" "%s: %s" command args) - (let* ((buffer (langtool--process-create-buffer)) - (proc (apply 'start-process "LanguageTool" buffer command args))) - (set-process-filter proc 'langtool--process-filter) - (set-process-sentinel proc 'langtool--process-sentinel) - (process-put proc 'langtool-source-buffer (current-buffer)) - (process-put proc 'langtool-region-begin begin) - (process-put proc 'langtool-region-finish finish) - (setq langtool-buffer-process proc) - (setq langtool-mode-line-message - (list " LanguageTool" - (propertize ":run" 'face compilation-info-face))))))) - -;;;###autoload -(defun langtool-switch-default-language (lang) - "Switch `langtool-read-lang-name' to LANG" - (interactive (list (langtool-read-lang-name))) - (setq langtool-default-language lang) - (message "Now default language is `%s'" lang)) - -(defun langtool-correct-buffer () - "Execute interactive correction after `langtool-check'" - (interactive) - (let ((ovs (langtool--overlays-region (point-min) (point-max)))) - (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)))) - -(defvar langtool--debug nil) -(defun langtool-toggle-debug () - "Toggle LanguageTool debugging." - (interactive) - (setq langtool--debug (not langtool--debug)) - (if langtool--debug - (message "LanguageTool debug ON.") - (message "LanguageTool debug off."))) - (defun langtool--debug (key fmt &rest args) (when langtool--debug (let ((buf (get-buffer-create "*LanguageTool Debug*"))) @@ -323,20 +293,34 @@ Restrict to selection when region is activated. (insert "---------- [" key "] ----------\n") (insert (apply 'format fmt args) "\n"))))) -(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--chomp (s) + (if (string-match "\\(?:\\(\r\n\\)+\\|\\(\n\\)+\\)\\'" s) + (substring s 0 (match-beginning 0)) + s)) -(defun langtool-read-lang-name () - (completing-read "Lang: " - (or (mapcar 'list (langtool--available-languages)) - locale-language-names))) +;; +;; 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))) (defun langtool--create-overlay (tuple) (let ((line (nth 0 tuple)) @@ -364,33 +348,6 @@ Restrict to selection when region is activated. (overlay-put ov 'priority 1) (overlay-put ov 'face 'langtool-errline)))))) -;;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))) - -(defun langtool--current-error-messages () - (remove nil - (mapcar - (lambda (ov) - (overlay-get ov 'langtool-message)) - (overlays-at (point))))) - (defun langtool--clear-buffer-overlays () (mapc (lambda (ov) @@ -409,16 +366,103 @@ Restrict to selection when region is activated. (lambda (ov1 ov2) (< (overlay-start ov1) (overlay-start ov2))))) -(defun langtool--check-command () - (when (or (null langtool-java-bin) - (not (executable-find langtool-java-bin))) - (error "java command is not found")) - (unless langtool-java-classpath - (when (or (null langtool-language-tool-jar) - (not (file-readable-p langtool-language-tool-jar))) - (error "langtool jar file is not found"))) - (when langtool-buffer-process - (error "Another process is running"))) +(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 +;; (defun langtool--disabled-rules () (let ((custom langtool-disabled-rules) @@ -433,9 +477,34 @@ Restrict to selection when region is activated. (append custom locals) ","))))) +(defun langtool--check-command () + (when (or (null langtool-java-bin) + (not (executable-find langtool-java-bin))) + (error "java command is not found")) + (unless langtool-java-classpath + (when (or (null langtool-language-tool-jar) + (not (file-readable-p langtool-language-tool-jar))) + (error "langtool jar file is not found"))) + (when langtool-buffer-process + (error "Another process is running"))) + (defun langtool--process-create-buffer () (generate-new-buffer " *LanguageTool* ")) +(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)) + (defun langtool--process-filter (proc event) (langtool--debug "Filter" "%s" event) (with-current-buffer (process-buffer proc) @@ -479,11 +548,13 @@ Restrict to selection when region is activated. (langtool--create-overlay tuple)) (nreverse n-tuple))))))))) -;;FIXME sometimes LanguageTool says wrong column. +;;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)) @@ -512,19 +583,68 @@ Restrict to selection when region is activated. "\\)"))))) regexp))) -(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)) +(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--invoke-process (file begin finish &optional 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 ((command langtool-java-bin) + args) + (setq args (list "-c" (langtool--java-coding-system + buffer-file-coding-system) + "-l" (or lang langtool-default-language) + "-d" (langtool--disabled-rules))) + (if langtool-java-classpath + (setq args (append (list "-cp" langtool-java-classpath + "org.languagetool.commandline.Main") + args)) + (setq args (append + (list "-jar" (langtool--process-file-name langtool-language-tool-jar)) + args))) + (when langtool-mother-tongue + (setq args (append args (list "-m" langtool-mother-tongue)))) + (setq args (append args (list (langtool--process-file-name file)))) + (langtool--debug "Command" "%s: %s" command args) + (let* ((buffer (langtool--process-create-buffer)) + (proc (langtool--with-java-environ + (apply 'start-process "LanguageTool" buffer command args)))) + (set-process-filter proc 'langtool--process-filter) + (set-process-sentinel proc 'langtool--process-sentinel) + (process-put proc 'langtool-source-buffer (current-buffer)) + (process-put proc 'langtool-region-begin begin) + (process-put proc 'langtool-region-finish finish) + (setq langtool-buffer-process proc) + (setq langtool-mode-line-message + (list " LanguageTool" + (propertize ":run" 'face compilation-info-face)))))) (defun langtool--process-sentinel (proc event) (when (memq (process-status proc) '(exit signal)) @@ -557,60 +677,75 @@ Restrict to selection when region is activated. (message "LanguageTool exited abnormally with code %d (%s)" code msg))) (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."))) (when (buffer-live-p pbuf) (kill-buffer pbuf))))) -(defun langtool--available-languages () - (when (stringp langtool-language-tool-jar) - (let ((dir (expand-file-name "rules" (file-name-directory langtool-language-tool-jar)))) - (when (file-directory-p dir) - (remove nil - (mapcar - (lambda (f) - (when (file-directory-p f) - (file-name-nondirectory f))) - (directory-files dir t "^[^.].$"))))))) +(defun langtool--cleanup-process () + (when langtool-buffer-process + (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)) ;;FIXME -;; http://java.sun.com/j2se/1.5.0/ja/docs/ja/guide/intl/encoding.doc.html +;; https://docs.oracle.com/javase/6/docs/technotes/guides/intl/encoding.doc.html (defun langtool--java-coding-system (coding-system) (let* ((cs (coding-system-base coding-system)) (csname (symbol-name cs)) (aliases (langtool--coding-system-aliases cs)) (names (mapcar 'symbol-name aliases)) + (case-fold-search nil) tmp) (cond ((string-match "utf-8" csname) "utf8") + ((string-match "utf-16" csname) + (cond + ((memq cs '(utf-16le utf-16-le)) + "UnicodeLittleUnmarked") + ((memq cs '(utf-16be utf-16-be)) + "UnicodeBigUnmarked") + (t + "utf-16"))) ((or (string-match "euc.*jp" csname) (string-match "japanese-iso-.*8bit" csname)) - "eucjp") + "euc_jp") ((string-match "shift.jis" csname) "sjis") ((string-match "iso.*2022.*jp" csname) "iso2022jp") + ((memq cs '(euc-kr euc-corea korean-iso-8bit)) + "euc_kr") ((setq tmp (cl-loop for x in names if (string-match "iso-8859-\\([0-9]+\\)" x) return x)) (concat "ISO8859_" (match-string 1 tmp))) - ((memq cs '(us-ascii raw-text undecided no-conversion)) + ((memq cs '(binary us-ascii raw-text undecided no-conversion)) "ascii") ((memq cs '(cyrillic-koi8)) "koi8-r") + ((memq cs '(gb2312)) + "euc_cn") + ((string-match "\\`\\(cp\\|ibm\\)[0-9]+" csname) + (downcase csname)) ((setq tmp (cl-loop for x in names if (string-match "^windows-[0-9]+$" x) return x)) tmp) (t - ;; default guessed as ascii - "ascii")))) + ;; simply guessed as same name. + (downcase csname))))) (defun langtool--coding-system-aliases (coding-system) (if (fboundp 'coding-system-aliases) @@ -618,6 +753,40 @@ Restrict to selection when region is activated. (funcall 'coding-system-aliases coding-system) (coding-system-get coding-system 'alias-coding-systems))) +(defun langtool--available-languages () + (let ((command langtool-java-bin) + args res) + (cond + ((null langtool-language-tool-jar)) + (langtool-java-classpath + (setq args (append args + (list "-cp" langtool-java-classpath + "org.languagetool.commandline.Main")))) + (t + (setq args (append + args + (list "-jar" (langtool--process-file-name langtool-language-tool-jar)) + (list "--list"))))) + (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)) + (while (re-search-forward "^\\([^\s\t]+\\)" nil t) + (setq res (cons (match-string 1) res))) + (nreverse res))))) + +;; +;; 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 @@ -678,41 +847,6 @@ Restrict to selection when region is activated. ;; next item (langtool--next-overlay ov overlays)))) -(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--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--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)) - -(defvar langtool--correction-keys - [?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9]) - -(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) - (defun langtool--correction-popup (msg suggests) (let ((buf (langtool--correction-buffer))) (delete-other-windows) @@ -756,19 +890,249 @@ Restrict to selection when region is activated. (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)) + (completing-read "Lang: " + (or (mapcar 'list (langtool--available-languages)) + locale-language-names)))) + +(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* ((file (buffer-file-name)) + (region-p (langtool-region-active-p)) + (begin (and region-p (region-beginning))) + (finish (and region-p (region-end)))) + (when region-p + (deactivate-mark)) + (unless langtool-temp-file + (setq langtool-temp-file (make-temp-file "langtool-"))) + ;; create temporary file to pass the text contents to LanguageTool + (when (or (null file) + (buffer-modified-p) + region-p + ;; 1 is dos EOL style, this must convert to unix + (eq (coding-system-eol-type buffer-file-coding-system) 1)) + (save-restriction + (widen) + (let ((coding-system-for-write + ;; convert EOL style to unix (LF). + ;; dos (CR-LF) style EOL may destroy position of marker. + (coding-system-change-eol-conversion + buffer-file-coding-system 'unix))) + ;; BEGIN nil means entire buffer + (write-region begin finish langtool-temp-file nil 'no-msg)) + (setq file langtool-temp-file))) + (langtool--invoke-process file begin finish lang) + (force-mode-line-update))) + +;;;###autoload +(defun langtool-switch-default-language (lang) + "Switch `langtool-read-lang-name' to LANG" + (interactive (list (langtool-read-lang-name))) + (setq langtool-default-language lang) + (message "Now default language is `%s'" lang)) + +(defun langtool-correct-buffer () + "Execute interactive correction after `langtool-check'" + (interactive) + (let ((ovs (langtool--overlays-region (point-min) (point-max)))) + (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)))) + +(defun langtool-toggle-debug () + "Toggle LanguageTool debugging." + (interactive) + (setq langtool--debug (not langtool--debug)) + (if langtool--debug + (message "LanguageTool debug ON.") + (message "LanguageTool debug off."))) + +;;; +;;; initialize +;;; + ;; initialize custom variables guessed from environment. -(let ((env (or (getenv "LANG") - (getenv "LC_ALL"))) - lang mt) - (and env - (string-match "^\\(..\\)_" env) - (setq lang (downcase (match-string 1 env))) - (member lang (langtool--available-languages)) - (setq mt lang)) +(let ((mt (langtool--guess-language))) (unless langtool-mother-tongue (setq langtool-mother-tongue mt)) (unless langtool-default-language - (setq langtool-default-language (or mt "en")))) + (setq langtool-default-language (or mt "en-GB")))) (provide 'langtool) diff --git a/elpa/langtool-readme.txt b/elpa/langtool-readme.txt new file mode 100644 index 00000000..d7074449 --- /dev/null +++ b/elpa/langtool-readme.txt @@ -0,0 +1,86 @@ +## Install: + +Install LanguageTool (and java) +http://www.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) + (setq langtool-language-tool-jar "/path/to/languagetool-commandline.jar") + +If you use old version of LanguageTool, may be: + + (setq langtool-language-tool-jar "/path/to/LanguageTool.jar") + +Alternatively, you can set the classpath where LanguageTool's jars reside: + + (require 'langtool) + (setq langtool-java-classpath + "/usr/share/languagetool:/usr/share/java/languagetool/*") + +These settings are optional: + +* 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-correct-buffer) + +* Default language is detected by LANG/LC_ALL environment variable. + Please set `langtool-default-language` if you need to change default value. + + (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 you want to specify your mother tongue. + + (setq langtool-mother-tongue "en") + +## 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 + +* Show LanguageTool report automatically by `popup' + This idea come from: + http://d.hatena.ne.jp/LaclefYoshi/20150912/langtool_popup + + (defun langtool-autoshow-detail-popup (overlays) + (when (require 'popup nil t) + ;; Do not interrupt current popup + (unless (or popup-instances + ;; suppress popup after type `C-g' . + (memq last-command '(keyboard-quit))) + (let ((msg (langtool-details-error-message overlays))) + (popup-tip msg))))) + + (setq langtool-autoshow-message-function + 'langtool-autoshow-detail-popup) + +* To finish checking. All langtool marker is removed. + + M-x langtool-check-done -- 2.47.3