Release Version 1.3.0

PillFall · Mar 25, 2023 · b136d53 · b136d53
2 parents 57af28a + bbdd10a
commit b136d53
Show file tree

Hide file tree

Showing 9 changed files with 128 additions and 74 deletions.
diff --git a/ChangeLog.org b/ChangeLog.org
@@ -8,6 +8,14 @@ Versioning]].
 
 ** [Unreleased]
 
+** [1.3.0]
+*** Added
+- Support for LanguageTool suggestion level. (Fix #18)
+
+*** Fixed
+- Face choosing algorithm.
+- Error when checking the matches between server requests. (Fix #14)
+
 ** [1.2.0]
 *** Added
 - Support for ~ispell~ ~LocalWords~ ignored words.

diff --git a/ReadMe.org b/ReadMe.org
@@ -163,6 +163,14 @@ this at the end of your file.
 # LocalWords: seplling
 #+END_SRC
 
+You can select between the default or the "picky" level when checking the
+buffer. When using the "picky" level, additional rules will activate, i.e. rules
+that you might only find useful when checking formal text. To change the level
+you can set your [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Specifying-File-Variables.html][local file variable]] ~languagetool-suggestion-level~ to the
+value desired, in lowercase.
+
+
+
 
 
 ** Quick Usage

diff --git a/languagetool-console.el b/languagetool-console.el
@@ -5,7 +5,7 @@
 ;; Author: Joar Buitrago <jebuitragoc@unal.edu.co>
 ;; Keywords: grammar text docs tools convenience checker
 ;; URL: https://github.com/PillFall/Emacs-LanguageTool.el
-;; Version: 1.2.0
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "27.1"))
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -128,25 +128,30 @@ for this package to work."
     (when (stringp languagetool-mother-tongue)
       (push (list "--mothertongue" languagetool-mother-tongue) arguments))
 
+    ;; Appends LanguageTool Suggestion level information
+    (when (stringp languagetool-suggestion-level)
+      (push (list "--level" (upcase languagetool-suggestion-level)) arguments))
+
     ;; Appends the disabled rules
     (let ((rules (string-join (append languagetool-disabled-rules languagetool-local-disabled-rules) ",")))
       (unless (string= rules "")
         (push (list "--disable" rules) arguments )))
     (flatten-tree (reverse arguments))))
 
-(defun languagetool-console-write-debug-info (text)
+(defun languagetool-console-write-debug-info (parsed-arguments text)
   "Write debug info in `languagetool-console-output-buffer-name'.
 
-The argument TEXT is the region passed to LanguageTool for
-checking."
+PARSED-ARGUMENTS is a list with all the arguments that are passed
+to LanguageTool and Java.
+
+TEXT is the region passed to LanguageTool for checking."
   (insert
    (propertize " ----- LanguageTool Command:" 'face 'font-lock-warning-face)
    "\n\n"
    (string-join
     (append
      (list languagetool-java-bin)
-     (languagetool-java-parse-arguments)
-     (languagetool-console-parse-arguments))
+     parsed-arguments)
     " ")
    "\n\n\n\n"
    (propertize " ----- LanguageTool Text:" 'face 'font-lock-warning-face)
@@ -172,19 +177,21 @@ The region is delimited by BEGIN and END."
     (let ((status 0)
           (buffer (get-buffer-create languagetool-console-output-buffer-name))
           (text (buffer-substring-no-properties begin end))
-          (json-parsed nil))
+          (json-parsed nil)
+          (parsed-arguments
+           (append
+            (languagetool-java-parse-arguments)
+            (languagetool-console-parse-arguments))))
       (with-current-buffer buffer
         (erase-buffer)
-        (languagetool-console-write-debug-info text))
+        (languagetool-console-write-debug-info parsed-arguments text))
       (setq status
             (apply #'call-process-region begin end
                    languagetool-java-bin
                    nil
                    languagetool-console-output-buffer-name
                    nil
-                   (append
-                    (languagetool-java-parse-arguments)
-                    (languagetool-console-parse-arguments))))
+                   parsed-arguments))
       (when (/= status 0)
         (error "LanguageTool returned with status %d" status))
       (with-current-buffer buffer

diff --git a/languagetool-core.el b/languagetool-core.el
@@ -5,7 +5,7 @@
 ;; Author: Joar Buitrago <jebuitragoc@unal.edu.co>
 ;; Keywords: grammar text docs tools convenience checker
 ;; URL: https://github.com/PillFall/Emacs-LanguageTool.el
-;; Version: 1.2.0
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "27.1"))
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -76,6 +76,17 @@ which can be mistranslated."
           (const nil)
           string))
 
+(defcustom languagetool-suggestion-level nil
+  "If set, additional rules will be activated.
+
+For example, rules that you might only find useful when checking
+formal text."
+  :group 'languagetool
+  :local t
+  :type '(choice
+          (const nil)
+          string))
+
 (defcustom languagetool-core-languages
   '(("auto" . "Automatic Detection")
     ("ar" . "Arabic")

diff --git a/languagetool-correction.el b/languagetool-correction.el
@@ -5,7 +5,7 @@
 ;; Author: Joar Buitrago <jebuitragoc@unal.edu.co>
 ;; Keywords: grammar text docs tools convenience checker
 ;; URL: https://github.com/PillFall/Emacs-LanguageTool.el
-;; Version: 1.2.0
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "27.1"))
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -74,13 +74,16 @@ Get the information about corrections from OVERLAY."
                          'face 'font-lock-keyword-face)
                         "]: "))
       (setq msg (concat msg (nth index replacements) "  ")))
-    ;; Add default Ignore and Skip options
+    ;; Add default Ignore, Add and Skip options
     (setq msg (concat msg "\n["
                       (propertize "C-i" 'face 'font-lock-keyword-face)
-                      "]: Ignore  "))
+                      "]: Ignore rule  "))
+    (setq msg (concat msg "["
+                      (propertize "C-a" 'face 'font-lock-keyword-face)
+                      "]: Add to LocalWords  "))
     (setq msg (concat msg "["
                       (propertize "C-s" 'face 'font-lock-keyword-face)
-                      "]: Skip  "))
+                      "]: Skip match  "))
     ;; Some people do not know C-g is the global exit key
     (setq msg (concat msg "["
                       (propertize "C-g" 'face 'font-lock-keyword-face)
@@ -93,6 +96,11 @@ PRESSED-KEY is the index of the suggestion in the array contained
 on OVERLAY."
   (cond
    ((char-equal ?\C-i pressed-key)
+    (save-excursion
+      (push (alist-get 'id (overlay-get overlay 'languagetool-rule)) languagetool-local-disabled-rules)
+      (add-file-local-variable 'languagetool-local-disabled-rules languagetool-local-disabled-rules)
+      (delete-overlay overlay)))
+   ((char-equal ?\C-a pressed-key)
     (progn
       (goto-char (overlay-end overlay))
       (ispell-add-per-file-word-list (buffer-substring-no-properties (overlay-start overlay) (overlay-end overlay)))

diff --git a/languagetool-issue.el b/languagetool-issue.el
@@ -5,7 +5,7 @@
 ;; Author: Joar Buitrago <jebuitragoc@unal.edu.co>
 ;; Keywords: grammar text docs tools convenience checker
 ;; URL: https://github.com/PillFall/Emacs-LanguageTool.el
-;; Version: 1.2.0
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "27.1"))
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -92,7 +92,7 @@ Each element is a cons cell with the form (ISSUE_TYPE . FACE_NAME)."
 
 (defun languagetool-issue-get-face (issue-type)
   "Return the face for ISSUE-TYPE."
-  (or (alist-get issue-type languagetool-issue-face-alist)
+  (or (cdr (assoc issue-type languagetool-issue-face-alist))
       'languagetool-issue-default))
 
 (defun languagetool-issue-create-overlay (begin end correction)

diff --git a/languagetool-java.el b/languagetool-java.el
@@ -5,7 +5,7 @@
 ;; Author: Joar Buitrago <jebuitragoc@unal.edu.co>
 ;; Keywords: grammar text docs tools convenience checker
 ;; URL: https://github.com/PillFall/Emacs-LanguageTool.el
-;; Version: 1.2.0
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "27.1"))
 
 ;; This program is free software; you can redistribute it and/or modify

diff --git a/languagetool-server.el b/languagetool-server.el
@@ -1,11 +1,11 @@
-;;; languagetool-server.el --- Description -*- lexical-binding: t; -*-
+;;; languagetool-server.el --- LanguageTool Server commands -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2020-2022  Joar Buitrago
 
 ;; Author: Joar Buitrago <jebuitragoc@unal.edu.co>
 ;; Keywords: grammar text docs tools convenience checker
 ;; URL: https://github.com/PillFall/Emacs-LanguageTool.el
-;; Version: 1.2.0
+;; Version: 1.3.0
 ;; Package-Requires: ((emacs "27.1"))
 
 ;; This program is free software; you can redistribute it and/or modify
@@ -92,11 +92,11 @@ More info at http://wiki.languagetool.org/command-line-options."
 (defvar-local languagetool-server-check-timer nil
   "Hold idle time that send request to LanguageTool server.")
 
-(defvar languagetool-server-open-communication-p nil
-  "Set to t if server communication is open, nil otherwise.")
+(defvar-local languagetool-server-open-communication-p nil
+  "Set to non-nil if server communication is open, nil otherwise.")
 
-(defvar languagetool-server-correction-p nil
-  "Set to t if correcting errors, nil otherwise.")
+(defvar languagetool-server-correcting-p nil
+  "Set to non-nil if correcting errors, nil otherwise.")
 
 ;; Function definitions:
 
@@ -117,10 +117,8 @@ Don't use this function, use `languagetool-server-mode' instead."
   ;; Start checking for LanguageTool server is able to handle requests
   (languagetool-server-check-for-communication)
 
-  ;; Init checking timer
-  (setq languagetool-server-check-timer
-        (run-with-idle-timer languagetool-server-check-delay t
-                             #'languagetool-server-check))
+  ;; Add checking system to editing hooks
+  (push #'languagetool-server-should-check after-change-functions)
 
   ;; Init hint timer in the current buffer if not already
   (setq languagetool-core-hint-timer
@@ -134,6 +132,9 @@ Don't use this function, use `languagetool-server-mode' instead."
   ;; Turn off buffer local flag for server communication.
   (setq languagetool-server-open-communication-p nil)
 
+  ;; Remove cheking system from editing hooks
+  (setq after-change-functions (delete #'languagetool-server-should-check after-change-functions))
+
   ;; Cancel check timer
   (when (timerp languagetool-server-check-timer)
     (cancel-timer languagetool-server-check-timer))
@@ -248,11 +249,11 @@ of seconds specified in `languagetool-server-max-timeout'."
             (when (/= (symbol-value 'url-http-response-status) 200)
               (error "Not successful response"))
             (setq languagetool-server-open-communication-p t)
-            (message "LanguageTool Server communication is up...")
-            (languagetool-server-check)))
+            (message "LanguageTool Server communication is up...")))
       (error
        (languagetool-server-mode -1)
-       (error "LanguageTool Server cannot communicate with server")))))
+       (error "LanguageTool Server cannot communicate with server")))
+    (languagetool-server-should-check)))
 
 (defun languagetool-server-parse-request ()
   "Return a assoc-list with LanguageTool Server request arguments parsed.
@@ -275,6 +276,10 @@ used in the POST request made to the LanguageTool server."
     (when (stringp languagetool-username)
       (push (list "username" languagetool-username) arguments))
 
+;; Appends LanguageTool suggestion level information
+    (when (stringp languagetool-suggestion-level)
+      (push (list "level" languagetool-suggestion-level) arguments))
+
     ;; Appends the disabled rules
     (let ((rules))
       ;; Global disabled rules
@@ -285,45 +290,52 @@ used in the POST request made to the LanguageTool server."
     ;; Add the buffer contents
     (push (list "text" (buffer-substring-no-properties (point-min) (point-max))) arguments)))
 
-(defun languagetool-server-check ()
-  "Show LanguageTool Server suggestions in the buffer.
-
-This function checks for the actual showed region of the buffer
-for suggestions."
-  (when (and languagetool-server-mode
-             (not languagetool-server-correction-p))
-    (let ((url-request-method "POST")
-          (url-request-data (url-build-query-string (languagetool-server-parse-request))))
-      (url-retrieve
-       (url-encode-url(format "%s:%d/v2/check" languagetool-server-url languagetool-server-port))
-       #'languagetool-server-highlight-matches
-       (list (current-buffer))
-       t))))
+(defun languagetool-server-should-check (&rest _args)
+  "Tell the package to send a request if there are no more edit commands in a time.
+
+When attached to `after-change-functions', Emacs sends the begin,
+end and length into the ARGS argument."
+  (when (timerp languagetool-server-check-timer)
+    (cancel-timer languagetool-server-check-timer))
+
+  (unless languagetool-server-correcting-p
+    (setq languagetool-server-check-timer (run-with-timer languagetool-server-check-delay nil #'languagetool-server-send-request))))
+
+(defun languagetool-server-send-request ()
+  "Send a request to the server and parse the output given."
+  (let ((url-request-method "POST")
+        (url-request-data (url-build-query-string (languagetool-server-parse-request))))
+    (url-retrieve
+     (url-encode-url(format "%s:%d/v2/check" languagetool-server-url languagetool-server-port))
+     #'languagetool-server-highlight-matches
+     (list (current-buffer))
+     t)))
 
 (defun languagetool-server-highlight-matches (_status checking-buffer)
   "Highlight LanguageTool Server issues in CHECKING-BUFFER.
 
 STATUS is a plist thrown by Emacs url. Throws an error if the response is null."
   (when (/= (symbol-value 'url-http-response-status) 200)
     (error "LanguageTool Server closed"))
-  (set-buffer-multibyte t)
-  (goto-char (point-max))
-  (backward-sexp)
-  (let ((json-parsed (json-read)))
-    (with-current-buffer checking-buffer
-      (save-excursion
-        (languagetool-core-clear-buffer)
-        (when languagetool-server-mode
-          (let ((corrections (alist-get 'matches json-parsed)))
-            (dotimes (index (length corrections))
-              (let* ((correction (aref corrections index))
-                     (offset (alist-get 'offset correction))
-                     (size (alist-get 'length correction))
-                     (start (+ (point-min) offset))
-                     (end (+ (point-min) offset size))
-                     (word (buffer-substring-no-properties start end)))
-                (unless (languagetool-core-correct-p word)
-                  (languagetool-issue-create-overlay start end correction))))))))))
+  (unless languagetool-server-correcting-p
+    (set-buffer-multibyte t)
+    (goto-char (point-max))
+    (backward-sexp)
+    (let ((json-parsed (json-read)))
+      (with-current-buffer checking-buffer
+        (save-excursion
+          (languagetool-core-clear-buffer)
+          (when languagetool-server-mode
+            (let ((corrections (alist-get 'matches json-parsed)))
+              (dotimes (index (length corrections))
+                (let* ((correction (aref corrections index))
+                       (offset (alist-get 'offset correction))
+                       (size (alist-get 'length correction))
+                       (start (+ (point-min) offset))
+                       (end (+ (point-min) offset size))
+                       (word (buffer-substring-no-properties start end)))
+                  (unless (languagetool-core-correct-p word)
+                    (languagetool-issue-create-overlay start end correction)))))))))))
 
 (provide 'languagetool-server)