-
Notifications
You must be signed in to change notification settings - Fork 4
/
wucuo.el
836 lines (734 loc) · 29 KB
/
wucuo.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
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
;;; wucuo.el --- Fastest solution to spell check camel case code or plain text -*- lexical-binding: t; -*-
;; Copyright (C) 2018-2023 Chen Bin
;;
;; Version: 0.3.2
;; Keywords: convenience
;; Author: Chen Bin <chenbin DOT sh AT gmail DOT com>
;; URL: http://github.com/redguardtoo/wucuo
;; Package-Requires: ((emacs "25.1"))
;; This file is not part of GNU Emacs.
;; 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 this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;;
;; 1. Setup
;; Please install either aspell or hunspell and their dictionaries.
;;
;; 2. Usage
;; Insert below code into ".emacs",
;; (add-hook 'prog-mode-hook 'wucuo-start)
;; (add-hook 'text-mode-hook 'wucuo-start)
;;
;; The spell checking starts when current buffer is saved.
;;
;; Please note `flyspell-prog-mode' and `flyspell-mode' should be turned off
;; before using this program.
;;
;; User's configuration for the package flyspell still works.
;; Flyspell provides two minor modes, `flyspell-prog-mode' and `flyspell-mode'.
;; They are replaced by this program. But all the other commands and configuration
;; for flyspell is still valid.
;;
;; 3. Tips
;;
;; - `wucuo-spell-check-file' checks one file and report typos
;; - `wucuo-spell-check-directory' checks files in one directory and report typos
;;
;; - If `wucuo-flyspell-start-mode' is "normal", `wucuo-start' runs `flyspell-buffer'
;; and `wucuo-spell-check-buffer-max' specifies maximum size of buffer to check.
;; If it's "fast", `wucuo-start' runs `flyspell-region' on current visible region
;; and `wucuo-spell-check-region-max' specifies maximum size of the region to check.
;;
;; - The interval of checking is set by `wucuo-update-interval'
;;
;; - See `wucuo-check-nil-font-face' on how to check plain text (text without font)
;;
;; - Use `wucuo-current-font-face' to detect font face at point
;;
;; - Set `wucuo-font-faces-to-check' or `wucuo-personal-font-faces-to-check' to specify
;; font faces to spell check
;;
;; - You can define a function in `wucuo-spell-check-buffer-predicate'.
;; If the function returns t, the spell checking of current buffer will continue.
;; If it returns nil, the spell checking is skipped.
;;
;; Here is sample to skip checking in specified major modes,
;; (setq wucuo-spell-check-buffer-predicate
;; (lambda ()
;; (not (memq major-mode
;; '(dired-mode
;; log-edit-mode
;; compilation-mode
;; help-mode
;; profiler-report-mode
;; speedbar-mode
;; gud-mode
;; calc-mode
;; Info-mode)))))
;;
;; This program assumes Flyspell is already set up properly.
;; If you have problems on Flyspell configuration, check wucuo's README.
;;
;; To ignore specific typo, you can set `wucuo-extra-predicate'.
;;
;; This program can be run in Linux terminal as batch script.
;; See README for more details.
;;; Code:
(require 'flyspell)
(require 'font-lock)
(require 'cl-lib)
(require 'find-lisp)
(require 'wucuo-sdk)
(defgroup wucuo nil
"Code spell checker."
:group 'flyspell)
(defcustom wucuo-debug nil
"Output debug information when it's not nil."
:type 'boolean
:group 'wucuo)
(defcustom wucuo-inherit-flyspell-mode-keybindings t
"Inherit `flyspell-mode' keybindings."
:type 'boolean
:group 'wucuo)
(defcustom wucuo-flyspell-check-doublon t
"Mark doublon (double words) as typo."
:type 'boolean
:group 'wucuo)
(defcustom wucuo-enable-camel-case-algorithm-p t
"Enable slower Lisp spell check algorithm for camel case word."
:type 'boolean
:group 'wucuo)
(defcustom wucuo-enable-extra-typo-detection-algorithm-p t
"Enable extra smart typo detection algorithm."
:type 'boolean
:group 'wucuo)
(defcustom wucuo-flyspell-start-mode "fast"
"If it's \"normal\", run `flyspell-buffer' in `after-save-hook'.
If it's \"fast\", run `flyspell-region' in `after-save-hook' to check visible
region in current window."
:type '(choice (string :tag "normal")
(string :tag "fast"))
:group 'wucuo)
(defcustom wucuo-check-nil-font-face 'text
"If nil, ignore plain text (text without font face).
If it's \"text\", check plain text in `text-mode' only.
If it's \"prog\", check plain text in `prog-mode' only.
If it's t, check plain text in any mode."
:type 'sexp
:group 'wucuo)
(defcustom wucuo-aspell-language-to-use "en"
"Language to use passed to aspell option '--lang'.
Please note it's only to check camel cased words.
User's original dictionary configuration for flyspell still works."
:type 'string
:group 'wucuo)
(defcustom wucuo-hunspell-dictionary-base-name "en_US"
"Dictionary base name pass to hunspell option '-d'.
Please note it's only used to check camel cased words.
User's original dictionary configuration for flyspell still works."
:type 'string
:group 'wucuo)
;; @see https://www.gnu.org/software/emacs/manual/html_node/elisp/Faces-for-Font-Lock.html
(defcustom wucuo-font-faces-to-check
'(font-lock-string-face
font-lock-doc-face
font-lock-comment-face
;; font-lock-builtin-face ; names of built-in functions.
font-lock-function-name-face
font-lock-variable-name-face
;; font-lock-type-face ; names of user-defined data types
;; tree-sitter
tree-sitter-hl-face:type
tree-sitter-hl-face:string
tree-sitter-hl-face:string.special
tree-sitter-hl-face:doc
tree-sitter-hl-face:comment
tree-sitter-hl-face:property
tree-sitter-hl-face:variable
tree-sitter-hl-face:varialbe.parameter
tree-sitter-hl-face:function
tree-sitter-hl-face:function.call
tree-sitter-hl-face:method
tree-sitter-hl-face:method.call
;; javascript
js2-function-call
js2-function-param
js2-object-property
js2-object-property-access
;; css
css-selector
css-property
;; ReactJS
rjsx-text
rjsx-tag
rjsx-attr)
"Only check word whose font face is among this list.
If major mode's own predicate is not nil, the font face check is skipped."
:type '(repeat sexp)
:group 'wucuo)
(defcustom wucuo-personal-font-faces-to-check
nil
"Similar to `wucuo-font-faces-to-check'. Define personal font faces to check.
If major mode's own predicate is not nil, the font face check is skipped."
:type '(repeat sexp)
:group 'wucuo)
(defcustom wucuo-update-interval 2
"Interval (seconds) for `wucuo-spell-check-buffer' to call `flyspell-buffer'."
:group 'wucuo
:type 'integer)
(defcustom wucuo-spell-check-buffer-max (* 4 1024 1024)
"Max size of buffer to run `flyspell-buffer'."
:type 'integer
:group 'wucuo)
(defcustom wucuo-spell-check-region-max (* 1000 80)
"Max size of region to run `flyspell-region'."
:type 'integer
:group 'wucuo)
(defcustom wucuo-find-file-regexp ".*"
"The file found in `wucuo-spell-check-directory' matches this regex."
:type 'string
:group 'wucuo)
(defcustom wucuo-exclude-file-regexp
"^.*\\.\\(o\\|a\\|lib\\|elc\\|pyc\\|mp[34]\\|mkv\\|avi\\|mpeg\\|docx?\\|xlsx?\\|pdf\\|png\\|jpe?g\\|gif\\|tiff\\|session\\|yas-compiled-snippets.el\\)\\|TAGS\\|tags$"
"The file found in `wucuo-spell-check-directory' does not match this regex."
:type 'string
:group 'wucuo)
(defcustom wucuo-exclude-directories
'(
".cache"
".cask"
".cvs"
".git"
".gradle"
".npm"
".sass-cache"
".svn"
".tox"
"bower_components"
"build"
"dist"
"elpa"
"node_modules"
)
"The directories skipped by `wucuo-spell-check-directory'.
Please note the directory name should not contain any slash character."
:type '(repeat string)
:group 'wucuo)
(defvar wucuo-spell-check-buffer-predicate nil
"Function to test if current buffer is checked by `wucuo-spell-check-buffer'.
Returns t to continue checking, nil otherwise.")
(defcustom wucuo-modes-whose-predicate-ignored
'(typescript-mode)
"Major modes whose own predicates should be ignored."
:type '(repeat sexp)
:group 'wucuo)
(defcustom wucuo-extra-predicate '(lambda (word) t)
"A callback to check WORD. Return t if WORD is typo."
:type 'function
:group 'wucuo)
(defvar wucuo-extra-typo-detection-algorithms
'(wucuo-flyspell-html-verify
wucuo-flyspell-org-verify)
"Extra Algorithms to test typos.")
(defvar wucuo-double-check-font-faces '(font-lock-string-face)
"Font faces to double check typo.")
;; Timer to run auto-update tags file
(defvar wucuo-timer nil "Internal timer.")
(declare-function markdown-flyspell-check-word-p "markdown-mode")
(declare-function wucuo-flyspell-org-verify "wucuo-flyspell-org")
(declare-function wucuo-flyspell-html-verify "wucuo-flyspell-html")
;;;###autoload
(defun wucuo-register-extra-typo-detection-algorithms ()
"Register extra typo detection algorithms."
(autoload 'markdown-flyspell-check-word-p "markdown-mode" nil)
(dolist (a wucuo-extra-typo-detection-algorithms)
(autoload a (symbol-name a) nil)))
;; register autoload right now
(wucuo-register-extra-typo-detection-algorithms)
;;;###autoload
(defun wucuo-current-font-face (&optional quiet)
"Get font face under cursor.
If QUIET is t, font face is not output."
(interactive)
(let* ((rlt (format "%S" (wucuo-sdk-get-font-face (point)))))
(kill-new rlt)
(unless quiet (message rlt))))
;;;###autoload
(defun wucuo-split-camel-case (word)
"Split camel case WORD into a list of strings.
Ported from \"https://github.com/fatih/camelcase/blob/master/camelcase.go\"."
(let* ((case-fold-search nil)
(len (length word))
;; 64 sub-words is enough
(runes (vector nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
(runes-length 0)
(i 0)
ch
(last-class 0)
(class 0)
rlt)
;; split into fields based on class of character
(while (< i len)
(setq ch (elt word i))
(cond
;; lower case
((and (>= ch ?a) (<= ch ?z))
(setq class 1))
;; upper case
((and (>= ch ?A) (<= ch ?Z))
(setq class 2))
((and (>= ch ?0) (<= ch ?9))
(setq class 3))
(t
(setq class 4)))
(cond
((= class last-class)
(aset runes
(1- runes-length)
(concat (aref runes (1- runes-length)) (char-to-string ch))))
(t
(aset runes runes-length (char-to-string ch))
(setq runes-length (1+ runes-length))))
(setq last-class class)
;; end of while
(setq i (1+ i)))
;; handle upper case -> lower case sequences, e.g.
;; "PDFL", "oader" -> "PDF", "Loader"
(setq i 0)
(while (< i (1- runes-length))
(let* ((ch-first (aref (aref runes i) 0))
(ch-second (aref (aref runes (1+ i)) 0)))
(when (and (and (>= ch-first ?A) (<= ch-first ?Z))
(and (>= ch-second ?a) (<= ch-second ?z)))
(aset runes (1+ i) (concat (substring (aref runes i) -1) (aref runes (1+ i))))
(aset runes i (substring (aref runes i) 0 -1))))
(setq i (1+ i)))
;; construct final result
(setq i 0)
(while (< i runes-length)
(when (> (length (aref runes i)) 0)
(push (aref runes i) rlt))
(setq i (1+ i)))
(nreverse rlt)))
(defun wucuo-spell-checker-to-string (line)
"Feed LINE into spell checker and return output as string."
(let* ((cmd (cond
;; aspell: `echo "helle world" | aspell pipe --lang en`
((string-match-p "aspell\\(\\.exe\\)?$" ispell-program-name)
(format "%s pipe --lang %s" ispell-program-name wucuo-aspell-language-to-use))
;; hunspell: `echo "helle world" | hunspell -a -d en_US`
(t
(format "%s -a -d %s" ispell-program-name wucuo-hunspell-dictionary-base-name))))
rlt)
(with-temp-buffer
(call-process-region line ; feed line into process
nil ; ignored
shell-file-name
nil ; don't delete
t
nil
shell-command-switch
cmd)
(setq rlt (buffer-substring-no-properties (point-min) (point-max))))
(when wucuo-debug (message "wucuo-spell-checker-to-string => cmd=%s rlt=%s" cmd rlt))
rlt))
;;;###autoload
(defun wucuo-check-camel-case-word-predicate (word)
"Use aspell to check WORD. If it's typo return t."
(if (string-match-p "^&" (wucuo-spell-checker-to-string word)) t))
(defun wucuo-handle-sub-word (sub-word)
"If return empty string, SUB-WORD is not checked by spell checker."
(cond
;; don't check 1/2 character word
((< (length sub-word) 3)
"")
;; don't check word containing special character
((not (string-match-p "^[a-zA-Z]*$" sub-word))
"")
(t
sub-word)))
(defmacro wucuo--get-mode-predicate ()
"Get per mode predicate."
`(unless (memq major-mode wucuo-modes-whose-predicate-ignored)
(get major-mode 'flyspell-mode-predicate)))
(defun wucuo--font-matched-p (font-faces)
"Verify if any of FONT-FACES should be spell checked."
;; multiple font faces at one point
(when (and (not (listp font-faces))
(not (null font-faces)))
(setq font-faces (list font-faces)))
(or (cl-intersection font-faces wucuo-font-faces-to-check)
(cl-intersection font-faces wucuo-personal-font-faces-to-check)
(and (null font-faces)
(or (eq t wucuo-check-nil-font-face)
(and (eq wucuo-check-nil-font-face 'text)
(derived-mode-p 'text-mode))
(and (eq wucuo-check-nil-font-face 'prog)
(derived-mode-p 'prog-mode))))))
(defun wucuo-major-mode-html-p ()
"Major mode is handling html like file."
;; no one uses html-mode now
(or (derived-mode-p 'nxml-mode)
(eq major-mode 'web-mode)))
;;;###autoload
(defun wucuo-typo-p (word)
"Spell check WORD and return t if it's typo.
This is slow because new shell process is created."
(save-excursion
(with-temp-buffer
(insert word)
(font-lock-ensure)
(flyspell-word)
(let* ((overlays (overlays-at (point-min))))
(and overlays (flyspell-overlay-p (car overlays)))))))
(defun wucuo-aspell-incorrect-typo-p (word)
"Aspell wrongly regards a WORD near single quote as typo."
(let* ((typo-p t))
(when (and (string-match "aspell\\(\\.exe\\)?$" ispell-program-name)
(memq (wucuo-sdk-get-font-face (point)) wucuo-double-check-font-faces))
(let* ((pos (- (point) (length word)))
(ch (char-before (1- pos))))
;; aspell regard symbol as part of word
;; @see http://aspell.net/0.61/man-html/Words-With-Symbols-in-Them.html#Words-With-Symbols-in-Them
;; @see https://github.com/redguardtoo/emacs.d/issues/892
(when (and (memq (wucuo-sdk-get-font-face pos) wucuo-double-check-font-faces)
(eq (char-before pos) ?')
(<= ?a ch)
(>= ?z ch))
(setq typo-p (wucuo-typo-p word)))))
(not typo-p)))
;;;###autoload
(defun wucuo-generic-check-word-predicate ()
"Function providing per-mode customization over which words are spell checked.
Returns t to continue checking, nil otherwise."
(let* ((case-fold-search nil)
(pos (- (point) 1))
(current-font-face (and (> pos 0) (wucuo-sdk-get-font-face pos)))
;; "(flyspell-mode 1)" loads per major mode predicate anyway
(mode-predicate (wucuo--get-mode-predicate))
(font-matched (wucuo--font-matched-p current-font-face))
subwords
word
(rlt t))
(if wucuo-debug (message "mode-predicate=%s" mode-predicate))
(if wucuo-debug (message "font-matched=%s, current-font-face=%s" font-matched current-font-face))
(cond
((<= pos 0)
nil)
;; ignore two character word.
;; in some major mode, word equals to sub-word
((< (length (setq word (save-excursion
(goto-char pos)
(thing-at-point 'word)))) 2)
(setq rlt nil))
((and mode-predicate (not (funcall mode-predicate)))
;; run major mode predicate
(setq rlt nil))
;; should be right after per mode predicate
((and wucuo-enable-extra-typo-detection-algorithm-p
(or (and (wucuo-major-mode-html-p)
(not (wucuo-flyspell-html-verify)))
(and (eq major-mode 'org-mode)
(not (wucuo-flyspell-org-verify)))
(and (eq major-mode 'markdown-mode)
(not (markdown-flyspell-check-word-p)))))
(setq rlt nil))
;; only check word with certain fonts
((and (not mode-predicate) (not font-matched))
;; major mode's predicate might want to manage font face check by itself
(setq rlt nil))
;; handle camel case word
((and wucuo-enable-camel-case-algorithm-p
(setq subwords (wucuo-split-camel-case word))
(> (length subwords) 1))
(let* ((s (mapconcat #'wucuo-handle-sub-word subwords " ")))
(setq rlt (wucuo-check-camel-case-word-predicate s))))
((wucuo-aspell-incorrect-typo-p word)
(setq rlt nil))
;; `wucuo-extra-predicate' actually does nothing by default
(t
(setq rlt (funcall wucuo-extra-predicate word))))
(when wucuo-debug
(message "wucuo-generic-check-word-predicate => word=%s rlt=%s wucuo-extra-predicate=%s subwords=%s"
word rlt wucuo-extra-predicate subwords))
rlt))
;;;###autoload
(defun wucuo-create-aspell-personal-dictionary ()
"Create aspell personal dictionary which is utf-8 encoded plain text file."
(interactive)
(with-temp-buffer
(let* ((file (file-truename (format "~/.aspell.%s.pws" wucuo-aspell-language-to-use))))
(insert (format "personal_ws-1.1 %s 2\nabcd\ndefg\n" wucuo-aspell-language-to-use))
(write-file file)
(message "%s created." file))))
;;;###autoload
(defun wucuo-create-hunspell-personal-dictionary ()
"Create hunspell personal dictionary which is utf-8 encoded plain text file."
(interactive)
(with-temp-buffer
(let* ((f (file-truename (format "~/.hunspell_%s" wucuo-hunspell-dictionary-base-name))))
(insert "abcd\ndefg\n")
(write-file f)
(message "%s created." f))))
;;;###autoload
(defun wucuo-version ()
"Output version."
(message "0.3.2"))
;;;###autoload
(defun wucuo-spell-check-visible-region ()
"Spell check visible region in current buffer."
(interactive)
(let* ((beg (max (point-min) (window-start)))
(end (min (point-max) (window-end))))
(when (< (- end beg) wucuo-spell-check-region-max)
(if wucuo-debug (message "wucuo-spell-check-visible-region called from %s to %s; major-mode=%s" beg end major-mode))
;; See https://emacs-china.org/t/flyspell-mode-wucuo-0-2-0/13274/46
;; where the performance issue is reported.
;; Tested in https://github.com/emacs-mirror/emacs/blob/master/src/xdisp.c
(font-lock-ensure beg end)
(flyspell-region beg end))))
(defun wucuo-buffer-windows-visible-p ()
"Check if current buffer's windows is visible."
(let* ((win (get-buffer-window (current-buffer))))
(and win (window-live-p win))))
(defun wucuo-spell-check-internal ()
"Spell check buffer or internal region."
;; work around some old ispell issue on Emacs 27.1
(unless (boundp 'ispell-menu-map-needed)
(defvar ispell-menu-map-needed nil))
;; hide "Spell Checking ..." message
(let* ((flyspell-issue-message-flag nil))
(cond
;; check buffer
((and (string= wucuo-flyspell-start-mode "normal")
(< (buffer-size) wucuo-spell-check-buffer-max))
(if wucuo-debug (message "flyspell-buffer called."))
;; `font-lock-ensure' on whole buffer could be slow
(font-lock-ensure)
(flyspell-buffer))
;; check visible region
((string= wucuo-flyspell-start-mode "fast")
(wucuo-spell-check-visible-region)))))
;;;###autoload
(defun wucuo-spell-check-buffer ()
"Spell check current buffer."
(if wucuo-debug (message "wucuo-spell-check-buffer called."))
(cond
((or (null ispell-program-name)
(not (executable-find ispell-program-name))
(not (string-match "aspell\\(\\.exe\\)?$\\|hunspell\\(\\.exe\\)?$" ispell-program-name)))
;; do nothing, wucuo only works with aspell or hunspell
(if wucuo-debug (message "aspell/hunspell missing in `ispell-program-name' or not installed.")))
((or (not wucuo-timer)
(> (- (float-time (current-time)) (float-time wucuo-timer))
wucuo-update-interval))
;; start timer if not started yet
(setq wucuo-timer (current-time))
(if wucuo-debug (message "wucuo-spell-check-buffer actually happened."))
(when (and (wucuo-buffer-windows-visible-p)
(or (null wucuo-spell-check-buffer-predicate)
(and (functionp wucuo-spell-check-buffer-predicate)
(funcall wucuo-spell-check-buffer-predicate))))
(wucuo-spell-check-internal)))
(t
;; do nothing, avoid `flyspell-buffer' too often
(if wucuo-debug (message "wucuo-spell-check-buffer actually skipped.")))))
;;;###autoload
(defun wucuo-start (&optional arg)
"Turn on wucuo to spell check code. ARG is ignored."
(interactive)
(if wucuo-debug (message "wucuo-start called."))
(ignore arg)
(cond
(wucuo-inherit-flyspell-mode-keybindings
(wucuo-mode 1))
(t
(wucuo-mode-on))))
(defun wucuo-stop ()
"Turn off wucuo and stop spell checking code."
(interactive)
(if wucuo-debug (message "wucuo-stop called."))
(cond
(wucuo-inherit-flyspell-mode-keybindings
(wucuo-mode -1))
(t
(wucuo-mode-off))))
(defun wucuo-enhance-flyspell ()
"Enhance flyspell."
;; To be honest, no other major mode can do better than this program
(setq flyspell-generic-check-word-predicate
#'wucuo-generic-check-word-predicate)
;; work around issue when calling `flyspell-small-region'
;; can't show the overlay of error but can't delete overlay
(setq flyspell-large-region 1))
;;;###autoload
(defun wucuo-aspell-cli-args (&optional run-together)
"Create arguments for aspell cli.
If RUN-TOGETHER is t, aspell can check camel cased word."
(let* ((args '("--sug-mode=ultra")))
;; "--run-together-min" could NOT be 3, see `check` in "speller_impl.cpp" of aspell code
;; The algorithm is not precise.
;; Run `echo tasteTableConfig | aspell --lang=en_US -C --run-together-limit=16 --encoding=utf-8 -a` in shell.
(when run-together
(cond
;; Kevin Atkinson said now aspell supports camel case directly
;; https://github.com/redguardtoo/emacs.d/issues/796
((string-match-p "--.*camel-case"
(shell-command-to-string (concat ispell-program-name " --help")))
(setq args (append args '("--camel-case"))))
;; old aspell uses "--run-together". Please note we are not dependent on this option
;; to check camel case word. wucuo is the final solution. This aspell options is just
;; some extra check to speed up the whole process.
(t
(setq args (append args '("--run-together" "--run-together-limit=16"))))))
args))
;;;###autoload
(defun wucuo-flyspell-highlight-incorrect-region-hack (orig-func &rest args)
"Don't mark double words as typo. ORIG-FUNC and ARGS is part of advice."
(let* ((poss (nth 2 args)))
(when (or wucuo-flyspell-check-doublon (not (eq 'doublon poss)))
(apply orig-func args))))
(with-eval-after-load 'flyspell
(advice-add 'flyspell-highlight-incorrect-region :around #'wucuo-flyspell-highlight-incorrect-region-hack))
(defun wucuo-goto-next-error ()
"Go to next error silently."
(let ((pos (point))
(max (point-max)))
(when (and (eq (current-buffer) flyspell-old-buffer-error)
(eq pos flyspell-old-pos-error))
(if (= flyspell-old-pos-error max) (goto-char (point-min))
(forward-word 1))
(setq pos (point)))
;; seek the next error
(while (and (< pos max)
(let ((ovs (overlays-at pos))
(r '()))
(while (and (not r) (consp ovs))
(if (flyspell-overlay-p (car ovs))
(setq r t)
(setq ovs (cdr ovs))))
(not r)))
(setq pos (1+ pos)))
;; save the current location for next invocation
(setq flyspell-old-pos-error pos)
(setq flyspell-old-buffer-error (current-buffer))
(goto-char pos)))
;;;###autoload
(defun wucuo-spell-check-file (file &optional kill-emacs-p full-path-p)
"Spell check FILE and report all typos.
If KILL-EMACS-P is t, kill the Emacs and set exit program code.
If FULL-PATH-P is t, always show typo's file full path.
Return t if there is typo."
(find-file file)
;; should set `flyspell-generic-check-word-predicate' after major mode is loaded
(wucuo-enhance-flyspell)
(font-lock-ensure)
(let* ((wucuo-flyspell-start-mode "normal")
typo-p)
(wucuo-spell-check-internal)
;; report all errors
(goto-char (point-min))
(wucuo-goto-next-error)
(while (< (point) (1- (point-max)))
(setq typo-p t)
(message "%s:%s: typo '%s' at %s is found"
(if full-path-p (file-truename file) file)
(count-lines (point-min) (point))
(thing-at-point 'word)
(point))
(wucuo-goto-next-error))
(when (and typo-p kill-emacs-p)
(kill-emacs 1))
typo-p))
;;;###autoload
(defun wucuo-find-file-predicate (file dir)
"True if FILE does match `wucuo-find-file-regexp'.
And FILE does not match `wucuo-exclude-file-regexp'.
DIR is the directory containing FILE."
(and (not (file-directory-p (expand-file-name file dir)))
(not (and wucuo-exclude-file-regexp
(string-match wucuo-exclude-file-regexp file)))
(string-match wucuo-find-file-regexp file)))
;;;###autoload
(defun wucuo-find-directory-predicate (dir parent)
"True if DIR is not a dot file, and not a symlink.
And DIR does not match `wucuo-exclude-directories'.
PARENT is the parent directory of DIR."
;; Skip current and parent directories
(not (or (string= dir ".")
(string= dir "..")
(member dir wucuo-exclude-directories)
;; Skip directories which are symlinks
;; Easy way to circumvent recursive loops
(file-symlink-p (expand-file-name dir parent)))))
;;;###autoload
(defun wucuo-spell-check-directory (directory &optional kill-emacs-p full-path-p)
"Spell check DIRECTORY and report all typos.
If KILL-EMACS-P is t, kill the Emacs and set exit program code.
If FULL-PATH-P is t, always show typo's file full path."
(let* ((files (find-lisp-find-files-internal directory
#'wucuo-find-file-predicate
#'wucuo-find-directory-predicate))
(count (length files))
(i 1)
typo-p)
(dolist (f files)
(when wucuo-debug
(message "checking file %s %s/%s" f i count)
(setq i (1+ i)))
(when (wucuo-spell-check-file f nil full-path-p)
(setq typo-p t)))
(when (and typo-p kill-emacs-p)
(kill-emacs 1))))
(defun wucuo-mode-on ()
"Turn Wucuo mode on."
(cond
(flyspell-mode
(message "Please turn off `flyspell-mode' and `flyspell-prog-mode' before wucuo starts!"))
(t
(wucuo-enhance-flyspell)
(add-hook 'after-save-hook #'wucuo-spell-check-buffer nil t))))
(defun wucuo-mode-off ()
"Turn Wucuo mode on."
;; {{ copied from `flyspell-mode-off'
(flyspell-delete-all-overlays)
(setq flyspell-pre-buffer nil)
(setq flyspell-pre-point nil)
;; }}
(remove-hook 'after-save-hook #'wucuo-spell-check-buffer t))
(define-minor-mode wucuo-mode
"Toggle spell checking (Wucuo mode).
With a prefix argument ARG, enable Flyspell mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
Wucuo mode is a buffer-local minor mode. When enabled, it
spawns a single Ispell process and checks each word. The default
flyspell behavior is to highlight incorrect words.
Remark:
`wucuo-mode' uses `flyspell' and `flyspell-mode-map'.
So all Flyspell setup and key bindings are valid."
:lighter flyspell-mode-line-string
:keymap flyspell-mode-map
:group 'wucuo
(cond
(wucuo-mode
(condition-case err
(wucuo-mode-on)
(error (message "Error enabling Flyspell mode:\n%s" (cdr err))
(wucuo-mode -1))))
(t
(wucuo-mode-off))))
(provide 'wucuo)
;;; wucuo.el ends here