-
Notifications
You must be signed in to change notification settings - Fork 3
/
redpen-paragraph.el
338 lines (305 loc) · 12.4 KB
/
redpen-paragraph.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
;;; redpen-paragraph.el --- RedPen interface. -*- lexical-binding: t; -*-
;; Copyright (C) 2015 karronoli
;; Author: karronoli
;; Created: 2016/06/13
;; Version: 0.42
;; Keywords: document, proofreading, help
;; X-URL: https://github.com/karronoli/redpen-paragraph.el
;; Package-Requires: ((emacs "24") (cl-lib "0.5") (json "1.4"))
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express
;; or implied. See the License for the specific language governing
;; permissions and limitations under the License.
;;; Commentary:
;;
;; This package proofread some paragraph or a file by RedPen,
;; parse the json Output Format.
;;
;; You can get some paragraph by the priority.
;; 1. by customization on specific major mode
;; 2. active region
;; 3. (mark-paragraph)
;;
;; Or you can get a file regardless of the priority.
;;; Usage:
;;
;; You should install redpen!
;; http://redpen.cc/
;;
;; Install from package.el & put these lines in your init file.
;; `redpen-commands' is for demo by default.
;; '%s' is replaced by `redpen-temporary-filename'.
;; With C-u, replaced by `buffer-file-name'.
;;
;; (defvar redpen-commands
;; ;; for english command
;; '("redpen -r json -c /path/to/redpen-conf-en.xml %s 2>/dev/null"
;; ;; for not english command
;; "redpen -r json -c /path/to/redpen-conf-ja.xml %s 2>/dev/null"))
;; (define-key global-map (kbd "C-c C-r") 'redpen-paragraph)
;; (add-hook 'kill-emacs-hook
;; (lambda ()
;; (if (file-exists-p redpen-temporary-filename)
;; (delete-file redpen-temporary-filename))))
;;
;; You can add how to get paragraph by `redpen-paragraph-alist'.
;; `org-mode' setting is enabled by default.
;;
;; (with-eval-after-load "org"
;; (defvar org-mode-map)
;; ;; Override `org-reveal' by `global-map' or set other key.
;; (define-key org-mode-map (kbd "C-c C-r") nil))
;;
;; You may need extra setting for convenient.
;; - `popwin-mode' for closing buffer. (but often not work...)
;;
;; (require 'popwin)
;; (popwin-mode 1)
;; (push '(compilation-mode :noselect t) popwin:special-display-config)
;;
;; - save hook
;;
;; (add-hook 'after-save-hook
;; (lambda ()
;; (if (eq major-mode 'org-mode)
;; (let ((redpen-paragraph-force-reading-whole t))
;; (redpen-paragraph)))))
;;; Code:
(require 'cl-lib)
(require 'compile)
(require 'json)
(defgroup redpen-paragraph nil
"RedPen interface for proofreading paragraph."
:group 'redpen-paragraph)
(defvar redpen-commands
;; This setting is demo use only.
(cond
((or (locate-file "curl" exec-path)
(locate-file "curl.exe" exec-path))
`(,(concat
"curl -s --data-urlencode document@%s"
" --data format=json2 --data lang=en" ;; for english
;; " --data-urlencode config@/path/to/redpen-conf-en.xml"
" http://redpen-paragraph-demo.herokuapp.com/rest/document/validate/")
,(concat
"curl -s --data-urlencode document@%s"
" --data format=json2 --data lang=ja" ;; for not english
;; " --data-urlencode config@/path/to/redpen-conf-ja.xml"
" http://redpen-paragraph-demo.herokuapp.com/rest/document/validate/")))
((and (eq system-type 'windows-nt)
(locate-file "powershell.exe" exec-path))
`(,(concat
"chcp 65001>NUL & powershell -Command \"& {"
"(Invoke-WebRequest -Uri"
" 'http://redpen-paragraph-demo.herokuapp.com/rest/document/validate/'"
" -Method Post -Body @{"
" lang = 'en'; format = 'json2';"
" document = (Get-Content -Raw '%s' -Encoding UTF8)}"
").Content}\"")
,(concat
"chcp 65001>NUL & powershell -Command \"& {"
"(Invoke-WebRequest -Uri"
" 'http://redpen-paragraph-demo.herokuapp.com/rest/document/validate/'"
" -Method Post -Body @{"
" lang = 'ja'; format = 'json2';"
" document = (Get-Content -Raw '%s' -Encoding UTF8)}"
").Content}\""))))
"Define redpen commands.
1st is for english, 2nd is for other language.")
(defvar redpen-paragraph-force-english nil
"Force English without detecting.")
(defvar redpen-paragraph-force-reading-whole nil
"Force reading the whole file.")
(defvar redpen-encoding 'utf-8
"Encoding for redpen I/O.")
(defvar redpen-temporary-filename
(expand-file-name
(format "redpen.%s" (emacs-pid)) temporary-file-directory)
"Filename passed to rendpen(internal use).")
(defvar redpen-target-filename ""
"Editing filename(internal use).")
(defvar redpen-paragraph-compilation-buffer-name
"*compilation*" "Compilation buffer name.")
(defvar redpen-paragraph-beginning-position
'(0 . 0) "Position of the paragraph beginning(internal use).")
;; eg. DoubledWord at start 1.57, end 1.59: Found repeated word "for".
(defvar redpen-paragraph-input-pattern
"%s at start %d.%d, end %d.%d: %s\n"
"Adjust to suit the input regexp.")
(defvar redpen-paragraph-input-regexp
"^\\sw+ at start \\([0-9]+\\).\\([0-9]+\\), end \\([0-9]+\\).\\([0-9]+\\): .*$"
"Adjust to suit the input pattern.
regexp capture & bind list
1st: errors[0].errors[i].position.start.line
2nd: errors[0].errors[i].position.start.offset
3rd: errors[0].errors[i].position.end.line
4th: errors[0].errors[i].position.end.offset")
(autoload 'org-backward-paragraph "org")
(autoload 'org-forward-paragraph "org")
(defvar redpen-paragraph-alist
(list
`(org-mode
. ,(lambda () "get visible string on current paragraph."
(let ((end (if (use-region-p) (1- (region-end))
(org-forward-paragraph) (1- (point))))
(begin (if (use-region-p) (region-beginning)
(org-backward-paragraph) (point))))
(apply 'string
(cl-loop
for pos from begin to end
when (not (get-text-property pos 'invisible))
collect (char-after pos)))))))
"Define how to get paragraph on specific major mode.")
(defun redpen-paragraph-is-english (text)
"Detect language by TEXT."
(cl-assert (stringp text))
(if (eq (length text) 0) t
(let* ((full (length text))
(not-english
(length (replace-regexp-in-string "[\x21-\x7e]" "" text)))
(english (- full not-english)))
(> english not-english))))
;;;###autoload
(defun redpen-paragraph (&optional flag)
"Profread some paragraphs by redpen.
if FLAG is not nil, use second command in `redpen-commands'."
(interactive "P")
(setq redpen-target-filename buffer-file-name)
(let* ((coding-system-for-write redpen-encoding) ; for writing file
(coding-system-for-read redpen-encoding) ; for reading stdout
(is-whole (or redpen-paragraph-force-reading-whole
(not (null flag)))) ;; for C-u flag
(handler (cdr (assq major-mode redpen-paragraph-alist)))
(default-handler
(lambda ()
(unless (use-region-p) (mark-paragraph))
(let ((text (thing-at-point 'line)))
(set-text-properties 0 (length text) nil text)
(if (string= "\n" text)
(forward-char)))
(buffer-substring-no-properties (region-beginning) (region-end))))
(string (save-excursion
(funcall (or handler default-handler))))
(is-english (or redpen-paragraph-force-english
(redpen-paragraph-is-english string)))
(command
(let ((template (nth (if is-english 0 1) redpen-commands)))
(format template
(if is-whole
buffer-file-name redpen-temporary-filename)))))
(with-temp-file redpen-temporary-filename (insert string))
(setq redpen-paragraph-beginning-position
(if is-whole '(0 . 0)
(save-excursion
(unless (use-region-p) (mark-paragraph))
(goto-char (region-beginning))
(let ((text (thing-at-point 'line)))
(set-text-properties 0 (length text) nil text)
(if (string= "\n" text)
(forward-char)))
(cons (1- (line-number-at-pos))
(current-column)))))
(with-current-buffer
(get-buffer-create redpen-paragraph-compilation-buffer-name)
;; if compilation-mode have activated,
;; Deactivate it by command output.
(async-shell-command command (current-buffer))
(set-process-sentinel
(get-buffer-process (current-buffer))
'redpen-paragraph-sentinel))))
(defun redpen-paragraph-sentinel (proc desc)
"Sentinel for redpen-paragraph compilation buffers.
PROC is a RedPen asynchronous process.
DESC is status of the process."
(cl-assert (processp proc))
(cl-assert (stringp desc))
(message "Compilation %s at %s"
(replace-regexp-in-string "\n?$" "" desc)
(substring (current-time-string) 0 19))
(if (memq (process-status proc) '(exit signal))
(with-current-buffer
redpen-paragraph-compilation-buffer-name
;; Erase for showing the errors after reading the raw result.
(let* ((json-object-type 'plist)
(json (json-read-from-string (buffer-string))))
(erase-buffer)
(redpen-paragraph-list-errors json)))))
(defun redpen-paragraph-list-errors (json)
"Show the error list for the current buffer by RedPen.
JSON is redpen-server response or repen cli response."
(cl-assert
(or (plist-get json :errors)
(and (vectorp json) (plist-get (elt json 0) :errors))))
;; Split window as well as usual compilation-mode.
(switch-to-buffer-other-window (current-buffer))
(set-buffer redpen-paragraph-compilation-buffer-name)
(mapc
(lambda (errors)
(let ((sentence (plist-get errors :sentence))
(position (lambda (root k1 k2)
(plist-get
(plist-get
(plist-get root :position) k1) k2))))
(mapc
(lambda (err)
(let (;; Emacs displays from the 1st line.
(start-line
(max
(+ (car redpen-paragraph-beginning-position)
(funcall position err :start :line))
1))
(end-line
(max
(+ (car redpen-paragraph-beginning-position)
(funcall position err :end :line))
1))
;; Add cursor offset to RedPen offset only in the 1st line
(start-offset
(+ 1 (funcall position err :start :offset)
(if (eq 1 (funcall position err :start :line))
(cdr redpen-paragraph-beginning-position) 0)))
(end-offset
(+ (funcall position err :end :offset)
(if (eq 1 (funcall position err :start :line))
(cdr redpen-paragraph-beginning-position) 0))))
(insert (format
redpen-paragraph-input-pattern
(plist-get err :validator)
start-line start-offset end-line
(if (and (eq start-line end-line)
(> start-offset end-offset))
start-offset end-offset)
(plist-get err :message)))
(if (> (length sentence) 0)
(insert sentence "\n"))
(insert "\n")))
(plist-get errors :errors))))
(or (plist-get json :errors) (plist-get (elt json 0) :errors)))
;; According to `redpen-paragraph-input-regexp',
;; Parse `redpen-paragraph-input-pattern' in `compilation-mode'.
(compilation-mode)
(goto-char (point-min)))
(eval-after-load "compile"
'(progn
(add-to-list 'compilation-error-regexp-alist 'redpen-paragraph)
(add-to-list
'compilation-error-regexp-alist-alist
`(redpen-paragraph
,redpen-paragraph-input-regexp
redpen-target-filename
(1 . 3) (2 . 4)))))
(defun redpen-target-filename ()
"Return `redpen-target-filename'."
redpen-target-filename)
(provide 'redpen-paragraph)
;; Local Variables:
;; coding: utf-8
;; End:
;;; redpen-paragraph.el ends here