Skip to content

Commit

Permalink
add method for initial incremental buffer check and documentation.
Browse files Browse the repository at this point in the history
  • Loading branch information
tpeacock19 committed Mar 4, 2024
1 parent 372b39d commit df18bba
Show file tree
Hide file tree
Showing 3 changed files with 104 additions and 54 deletions.
9 changes: 8 additions & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,14 @@ included in `flymake-languagetool-active-modes`.

## 🧪 Configuration

### Language
### Sentence Awareness
`flymake-languagetool` now uses emacs sentence navigation to send only portions
of the text that have been modified rather than the entire buffer. In order for
this to behave in an expected manner, you may have to modify
`sentence-end-double-space`. The default is set to `true` and may cause some
contextual issues if you only use a single space to separate sentences.

### language
The language used for flymake can be customized by using
`flymake-languagetool-language` (Default `"en-US"`)

Expand Down
4 changes: 4 additions & 0 deletions example.org
Original file line number Diff line number Diff line change
Expand Up @@ -17,3 +17,7 @@ Moreover, hour new office will be bigger than before.
I didn’t no the answer, but he person told me the correct answer. We
want too go to the museum no, but Peter isn’t here yet. Sara past the
test yesterday. I lent him same money. Please turn of your phones.

# Local Variables:
# sentence-end-double-space: nil
# End:
145 changes: 92 additions & 53 deletions flymake-languagetool.el
Original file line number Diff line number Diff line change
Expand Up @@ -199,6 +199,10 @@ These rules will be enabled if `flymake-languagetool-check-spelling' is non-nil.
(defvar-local flymake-languagetool--proc-buf nil
"Current process we are currently using for grammar check.")

(defvar-local flymake-languagetool--buf-checked '(nil . 0)
"Current state of the source buffer.
If the entire buffer has been checked this will be t")

(defvar flymake-languagetool--local nil
"Can we reach the local LanguageTool server API?")

Expand Down Expand Up @@ -255,7 +259,7 @@ See https://languagetool.org/development/api/org/languagetool/rules/Categories.h
(seq-intersection faces-to-ignore (ensure-list x))))

(defun flymake-languagetool--check-all (errors source-buffer start end)
"Check grammar ERRORS for SOURCE-BUFFER document."
"Check grammar ERRORS for SOURCE-BUFFER from START to END."
(let ((faces (alist-get (buffer-local-value 'major-mode source-buffer)
flymake-languagetool-ignore-faces-alist))
check-list)
Expand Down Expand Up @@ -285,30 +289,36 @@ See https://languagetool.org/development/api/org/languagetool/rules/Categories.h
check-list))

(defun flymake-languagetool--output-to-errors (output source-buffer start end)
"Parse the JSON data from OUTPUT of LanguageTool analysis of SOURCE-BUFFER."
"Parse the JSON data from OUTPUT of LanguageTool analysis of SOURCE-BUFFER.
Region checked is defined by START and END."
(let* ((json-array-type 'list)
(full-results (json-read-from-string output))
(errors (cdr (assoc 'matches full-results))))
(flymake-languagetool--check-all errors source-buffer start end)))

(defun flymake-languagetool--handle-finished (status source-buffer
report-fn start end)
report-fn state start end)
"Callback function for LanguageTool process for SOURCE-BUFFER.
STATUS provided from `url-retrieve'."
STATUS provided from `url-retrieve'. Region checked is defined by START and
END. If STATE is 'start then this will call `flymake-languagetool--check' to
continue diagnosing the rest of the buffer."
(let* ((err (plist-get status :error))
(err-type (nth 1 err))
(err-detail (nth 2 err))
(c-buf (current-buffer))
(proc-buf (buffer-local-value 'flymake-languagetool--proc-buf
source-buffer))
(proc-current (equal c-buf proc-buf)))
(cond
((and proc-current err)
(with-current-buffer source-buffer
;; for some reason the 2nd element in error list is a
;; symbol. This needs to be changed to string to reflect in
;; `error-message-string'
(setf (nth 1 err) (symbol-name (nth 1 err)))
(funcall report-fn :panic :explanation
(format "%s: %s" c-buf (error-message-string err)))))
;; Need to ignore deleted obsolete processes
(unless (and (stringp err-detail) (equal err-detail "deleted\n"))
;; The 2nd element in error list is a symbol. This needs to be changed
;; to string to reflect in `error-message-string'
(setf (nth 1 err) (symbol-name err-type))
(funcall report-fn :panic :explanation
(format "%s: %s" c-buf (error-message-string err))))))
((and proc-current url-http-end-of-headers)
(let ((output (save-restriction
(set-buffer-multibyte t)
Expand All @@ -319,26 +329,38 @@ STATUS provided from `url-retrieve'."
(flymake-languagetool--output-to-errors output
source-buffer
start end)
:region (cons start end))))
:region (cons start end))
;; When the buffer is larger than the api limit, we need to send the
;; remaining portion back to LanguageTool.
(when (and (eq state 'start)
(not (car flymake-languagetool--buf-checked)))
(setf (cdr flymake-languagetool--buf-checked) end)
(pcase-let ((`(,state ,n-start ,n-end)
(flymake-languagetool--check-state nil)))
(if (> n-end end)
(funcall #'flymake-languagetool--check
report-fn (buffer-substring-no-properties n-start n-end)
state n-start n-end)
(setf (car flymake-languagetool--buf-checked) t))))))
(kill-buffer c-buf))
((not proc-current)
(with-current-buffer source-buffer
(flymake-log :debug "Skipping an obsolete check"))
(kill-buffer c-buf)))))

(defun flymake-languagetool--check (report-fn text start end)
(defun flymake-languagetool--check (report-fn text state start end)
"Run LanguageTool on TEXT from current buffer's contento.
The callback function will reply with REPORT-FN."
(when-let ((buf flymake-languagetool--proc-buf))
;; need to check if buffer has ongoing process or else we may
;; potentially delete the wrong one.
(when-let ((process (get-buffer-process buf)))
(delete-process process))
(setf flymake-languagetool--proc-buf nil))
(setq-local flymake-languagetool--proc-buf nil))
(let* ((url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded")))
(source-buffer (current-buffer))
(source-buffer flymake-languagetool--source-buffer)
(disabled-cats
(string-join flymake-languagetool-disabled-categories ","))
(disabled-rules
Expand All @@ -358,21 +380,21 @@ The callback function will reply with REPORT-FN."
(list "apiKey" flymake-languagetool-api-key))))
(url-request-data (url-build-query-string params nil t)))
(if (flymake-languagetool--reachable-p)
(setq flymake-languagetool--proc-buf
(url-retrieve
(concat (or flymake-languagetool-url
(format "http://localhost:%s"
flymake-languagetool-server-port))
"/v2/check")
#'flymake-languagetool--handle-finished
(list source-buffer report-fn start end) t))
(setq-local flymake-languagetool--proc-buf
(url-retrieve
(concat (or flymake-languagetool-url
(format "http://localhost:%s"
flymake-languagetool-server-port))
"/v2/check")
#'flymake-languagetool--handle-finished
(list source-buffer report-fn state start end) t))
;; can't reach LanguageTool API, try again. TODO:
(funcall report-fn :panic :explanation
(format "Cannot reach LanguageTool URL: %s"
flymake-languagetool-url)))))

(defun flymake-languagetool--reachable-p ()
"TODO: Document this."
"Test if the LanguageTool server is reachable."
(let ((res (or flymake-languagetool--local
(condition-case nil
(url-retrieve-synchronously
Expand All @@ -384,7 +406,7 @@ The callback function will reply with REPORT-FN."
(file-error nil)))))
(when (buffer-live-p res)
(kill-buffer res)
(setq res t))
(setf res t))
res))

(defun flymake-languagetool--start-server (report-fn)
Expand All @@ -404,39 +426,48 @@ Once started call `flymake-languagetool' checker with REPORT-FN."
(funcall #'internal-default-process-filter proc string)
(when (string-match ".*Server started\n$" string)
(with-current-buffer source
(setq flymake-languagetool--local t)
(setq-local flymake-languagetool--local t)
(flymake-languagetool--checker report-fn))
(set-process-filter proc nil)))
:sentinel
(lambda (proc _event)
(when (memq (process-status proc) '(exit signal))
(setq flymake-languagetool--local nil)
(setq-local flymake-languagetool--local nil)
(delete-process proc)
(kill-buffer (process-buffer proc)))))))
(when-let ((buf (process-buffer proc)))
(kill-buffer buf)))))))

(defun flymake-languagetool--sentence-point (pt arg)
"Return the point at the beginning of preceding sentence or at the
end of following sentence."
"Wrapper for `forward-sentence-function'.
A positive ARG will return beginning point ARG number sentence preceding PT.
A positive ARG will return end point ARG number sentence following PT."
(when pt
(save-excursion
(goto-char pt)
(funcall forward-sentence-function arg))))

(defun flymake-languagetool--setup ()
"Used to reset the checked state of the current buffer."
(setq-local flymake-languagetool--buf-checked '(nil . 0)
flymake-languagetool--proc-buf nil
flymake-languagetool--local nil))

(defun flymake-languagetool--check-length (region)
"Ensure character count for REGION complies with api restrictions.
https://languagetool.org/http-api/"
(pcase-let* ((`(,status ,start ,end) region)
(pcase-let* ((`(,state ,start ,end) region)
(size (- end start))
(limit (cond (flymake-languagetool-api-key 60000)
((not (or flymake-languagetool-server-command
flymake-languagetool-server-jar))
20000))))
(if (and limit (> size limit))
(list status start (+ start (1- limit)))
(list state start (+ start (1- limit)))
region)))

(defun flymake-languagetool--check-status (report-fn args)
"Determine what region has changed and needs to be checked."
(defun flymake-languagetool--check-state (args)
"Determine what region has changed and needs to be checked.
Function acceps ARGS sent from `flymake' describing potential changes."
(if (plist-member args :recent-changes)
(let ((changes (or (plist-get args :recent-changes) 'none))
(start (or (flymake-languagetool--sentence-point
Expand All @@ -447,20 +478,27 @@ https://languagetool.org/http-api/"
(point-max))))
(flymake-languagetool--check-length
(list changes start end)))
(flymake-languagetool--check-length
(list 'start (point-min) (point-max)))))
(if (car flymake-languagetool--buf-checked)
(list 'save
(flymake-languagetool--sentence-point (point) -2)
(flymake-languagetool--sentence-point (point) 2))
(flymake-languagetool--check-length
(list 'start (max (point-min) (cdr flymake-languagetool--buf-checked))
(point-max))))))

(defun flymake-languagetool--checker (report-fn &rest args)
"Diagnostic checker function with REPORT-FN."
(setq flymake-languagetool--source-buffer (current-buffer))
(pcase-let ((`(,status ,start ,end)
(flymake-languagetool--check-status report-fn args)))
"Diagnostic checker function with REPORT-FN.
Function acceps ARGS sent from `flymake' describing potential changes."
(setq-local flymake-languagetool--source-buffer (current-buffer))
(pcase-let* ((a args)
(`(,state ,start ,end)
(flymake-languagetool--check-state a)))
(cond
((flymake-languagetool--reachable-p)
(unless (eq status 'none)
(unless (eq state 'none)
(flymake-languagetool--check report-fn (buffer-substring-no-properties
start end)
start end)))
state start end)))
((or flymake-languagetool-server-command flymake-languagetool-server-jar)
(flymake-languagetool--start-server report-fn))
(t (funcall report-fn :panic :explanation
Expand All @@ -480,23 +518,23 @@ Optionally provide pretty FORMAT for each overlay."
(overlays-in (point-min) (point-max))))
(ovs (seq-sort-by #'overlay-start #'< lt-ovs)))
(if format
(seq-map
(lambda (ov) (cons (format "%s: %s"
(line-number-at-pos (overlay-start ov))
(flymake-diagnostic-text
(overlay-get ov 'flymake-diagnostic)))
ov))
ovs)
(seq-map (lambda (ov)
(cons (format "%s: %s"
(line-number-at-pos (overlay-start ov))
(flymake-diagnostic-text
(overlay-get ov 'flymake-diagnostic)))
ov))
ovs)
ovs)))

(defvar-local flymake-languagetool-current-cand nil
"Current overlay candidate.")

(defun flymake-languagetool--ov-at-point ()
"Return `flymake-languagetool' overlay at point."
(setq flymake-languagetool-current-cand
(car (seq-filter #'flymake-languagetool--overlay-p
(overlays-at (point))))))
(setq-local flymake-languagetool-current-cand
(car (seq-filter #'flymake-languagetool--overlay-p
(overlays-at (point))))))

(defun flymake-languagetool--suggestions ()
"Show corrections suggested from LanguageTool."
Expand All @@ -511,7 +549,7 @@ Optionally provide pretty FORMAT for each overlay."
"Remove highlighting of current candidate."
(ignore-errors
(overlay-put flymake-languagetool-current-cand 'face 'flymake-warning))
(setq flymake-languagetool-current-cand nil))
(setq-local flymake-languagetool-current-cand nil))

(defun flymake-languagetool--check-buffer ()
"TODO: Document this."
Expand Down Expand Up @@ -630,7 +668,8 @@ Use OL as diagnostic if non-nil."
"Convenience function to setup flymake-languagetool.
This adds the language-tool checker to the list of flymake diagnostic
functions."
(add-hook 'flymake-diagnostic-functions #'flymake-languagetool--checker nil t))
(add-hook 'flymake-diagnostic-functions #'flymake-languagetool--checker nil t)
(add-hook 'flymake-mode-hook #'flymake-languagetool--setup))

;;;###autoload
(defun flymake-languagetool-maybe-load ()
Expand Down

0 comments on commit df18bba

Please sign in to comment.