[O] [ANN] Improved Flyspell check

[Nicolas Goaziou]

Hello,

I'd like to submit the following patch for review, testing and,
hopefully, inclusion.

>From the user point of view, it improves checks when using Flyspell,
removing false-positive and allowing to check more areas.

More importantly, it doesn't rely anymore on fontification, which means
that activating checks is very demanding for the parser. So, it is
a good stress test for the newly integrated cache mechanism.


Feedback welcome.


Regards,

-- 
Nicolas Goaziou

>From 56bbebbd926e04ad4382cc9f37fb9e23d548130a Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Sun, 3 Nov 2013 15:15:07 +0100
Subject: [PATCH] Improve Flyspell check

* lisp/org.el (org-mode-flyspell-verify): Rewrite function using
  "org-element.el".  In particular, it doesn't rely on fontification
  anymore.
(org-remove-flyspell-overlays-in): Remove function.
(org-do-emphasis-faces, org-activate-plain-links)
(org-fontify-meta-lines-and-blocks-1, org-activate-footnote-links)
(org-activate-target-links, org-activate-tags, org-activate-code)
(org-activate-angle-links): Don't call
`org-remove-flyspell-overlays-in'.
* contrib/lisp/org-wikinodes.el (org-wikinodes-activate-links): Don't
  call `org-remove-flyspell-overlays-in'.
---
 contrib/lisp/org-wikinodes.el |   5 --
 lisp/org.el                   | 111 ++++++++++++++++++++++++++----------------
 2 files changed, 70 insertions(+), 46 deletions(-)

diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
index 4efc373..c6f2006 100644
--- a/contrib/lisp/org-wikinodes.el
+++ b/contrib/lisp/org-wikinodes.el
@@ -79,15 +79,10 @@ to `directory'."
       (if (re-search-forward org-wikinodes-camel-regexp limit t)
          (if (equal (char-after (point-at-bol)) ?*)
              (progn
-               ;; in  heading - deactivate flyspell
-               (org-remove-flyspell-overlays-in (match-beginning 0)
-                                                (match-end 0))
                (add-text-properties (match-beginning 0) (match-end 0)
                                     '(org-no-flyspell t))
                t)
            ;; this is a wiki link
-           (org-remove-flyspell-overlays-in (match-beginning 0)
-                                            (match-end 0))
            (add-text-properties (match-beginning 0) (match-end 0)
                                 (list 'mouse-face 'highlight
                                       'face 'org-link
diff --git a/lisp/org.el b/lisp/org.el
index 2382a9c..a7ab90f 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5459,8 +5459,6 @@ The following commands are available:
   (abbrev-table-put org-mode-abbrev-table
                    :parents (list text-mode-abbrev-table)))
 
-(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
-
 (defsubst org-fix-ellipsis-at-bol ()
   (save-excursion (goto-char (window-start)) (recenter 0)))
 
@@ -5685,9 +5683,6 @@ The time stamps may be either active or inactive.")
            (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
                                             'face
                                             (nth 1 a))
-           (and (nth 2 a)
-                (org-remove-flyspell-overlays-in
-                 (match-beginning 0) (match-end 0)))
            (add-text-properties (match-beginning 2) (match-end 2)
                                 '(font-lock-multiline t org-emphasis t))
            (when org-hide-emphasis-markers
@@ -5753,7 +5748,6 @@ prompted for."
   (let (f hl)
     (when (and (re-search-forward (concat org-plain-link-re) limit t)
               (not (org-in-src-block-p)))
-      (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
       (setq f (get-text-property (match-beginning 0) 'face))
       (setq hl (org-match-string-no-properties 0))
       (if (or (eq f 'org-tag)
@@ -5770,7 +5764,6 @@ prompted for."
 (defun org-activate-code (limit)
   (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
       (progn
-       (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
        (remove-text-properties (match-beginning 0) (match-end 0)
                                '(display t invisible t intangible t))
        t)))
@@ -5812,7 +5805,6 @@ by a #."
          (cond
           ((member dc1 '("+html:" "+ascii:" "+latex:"))
            ;; a single line of backend-specific content
-           (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
            (remove-text-properties (match-beginning 0) (match-end 0)
                                    '(display t invisible t intangible t))
            (add-text-properties (match-beginning 1) (match-end 3)
@@ -5901,7 +5893,6 @@ by a #."
   (if (and (re-search-forward org-angle-link-re limit t)
           (not (org-in-src-block-p)))
       (progn
-       (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
        (add-text-properties (match-beginning 0) (match-end 0)
                             (list 'mouse-face 'highlight
                                   'keymap org-mouse-map))
@@ -5913,7 +5904,6 @@ by a #."
   (let ((fn (org-footnote-next-reference-or-definition limit)))
     (when fn
       (let ((beg (nth 1 fn)) (end (nth 2 fn)))
-       (org-remove-flyspell-overlays-in beg end)
        (add-text-properties beg end
                             (list 'mouse-face 'highlight
                                   'keymap org-mouse-map
@@ -5941,7 +5931,6 @@ by a #."
                       'htmlize-link `(:uri ,hl))))
        ;; We need to remove the invisible property here.  Table narrowing
        ;; may have made some of this invisible.
-       (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
        (remove-text-properties (match-beginning 0) (match-end 0)
                                '(invisible nil))
        (if (match-end 3)
@@ -5965,7 +5954,6 @@ by a #."
   (if (and (re-search-forward org-tsr-regexp-both limit t)
           (not (equal (char-before (match-beginning 0)) 91)))
       (progn
-       (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
        (add-text-properties (match-beginning 0) (match-end 0)
                             (list 'mouse-face 'highlight
                                   'keymap org-mouse-map))
@@ -5992,7 +5980,6 @@ by a #."
     (let ((case-fold-search t))
       (if (re-search-forward org-target-link-regexp limit t)
          (progn
-           (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
            (add-text-properties (match-beginning 0) (match-end 0)
                                 (list 'mouse-face 'highlight
                                       'keymap org-mouse-map
@@ -6110,7 +6097,6 @@ between words."
 (defun org-activate-tags (limit)
   (if (re-search-forward (org-re "^\\*+.*[ 
\t]\\(:[[:alnum:address@hidden:]+:\\)[ \r\n]") limit t)
       (progn
-       (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
        (add-text-properties (match-beginning 1) (match-end 1)
                             (list 'mouse-face 'highlight
                                   'keymap org-mouse-map))
@@ -23861,34 +23847,77 @@ To get rid of the restriction, use 
\\[org-agenda-remove-restriction-lock]."
 
 ;;; Fixes and Hacks for problems with other packages
 
-;; Make flyspell not check words in links, to not mess up our keymap
-(defvar org-element-affiliated-keywords) ; From org-element.el
-(defvar org-element-block-name-alist)   ; From org-element.el
 (defun org-mode-flyspell-verify ()
-  "Don't let flyspell put overlays at active buttons, or on
-   {todo,all-time,additional-option-like}-keywords."
-  (require 'org-element) ; For `org-element-affiliated-keywords'
-  (let ((pos (max (1- (point)) (point-min)))
-       (word (thing-at-point 'word)))
-    (and (not (get-text-property pos 'keymap))
-        (not (get-text-property pos 'org-no-flyspell))
-        (not (member word org-todo-keywords-1))
-        (not (member word org-all-time-keywords))
-        (not (member word org-options-keywords))
-        (not (member word (mapcar 'car org-startup-options)))
-        (not (member-ignore-case word org-element-affiliated-keywords))
-        (not (member-ignore-case word (org-get-export-keywords)))
-        (not (member-ignore-case
-              word (mapcar 'car org-element-block-name-alist)))
-        (not (member-ignore-case word '("BEGIN" "END" "ATTR")))
-        (not (org-in-src-block-p)))))
-
-(defun org-remove-flyspell-overlays-in (beg end)
-  "Remove flyspell overlays in region."
-  (and (org-bound-and-true-p flyspell-mode)
-       (fboundp 'flyspell-delete-region-overlays)
-       (flyspell-delete-region-overlays beg end))
-  (add-text-properties beg end '(org-no-flyspell t)))
+  "Function used for `flyspell-generic-check-word-predicate'."
+  (if (org-at-heading-p)
+      ;; At a headline or an inlinetask, check title only.  This is
+      ;; faster than relying on `org-element-at-point'.
+      (and (save-excursion (beginning-of-line)
+                          (and (let ((case-fold-search t))
+                                 (not (looking-at "\\*+ END[ \t]*$")))
+                               (looking-at org-complex-heading-regexp)))
+          (match-beginning 4)
+          (>= (point) (match-beginning 4))
+          (or (not (match-beginning 5))
+              (< (point) (match-beginning 5))))
+    (let* ((element (org-element-at-point))
+          (post-affiliated (org-element-property :post-affiliated element))
+          (object-check
+           (function
+            (lambda (object)
+              ;; Non-nil if flyspell checks can be done in OBJECT.
+              (case (org-element-type object)
+                ;; Prevent checks in links due to keybinding conflict
+                ;; with Flyspell.
+                ((code entity export-snippet inline-babel-call inline-src-block
+                       line-break latex-fragment link macro statistics-cookie
+                       target timestamp verbatim)
+                 nil)
+                (footnote-reference
+                 ;; Only in inline footnotes, within the definition.
+                 (and (eq (org-element-property :type object) 'inline)
+                      (< (save-excursion
+                           (goto-char (org-element-property :begin object))
+                           (search-forward ":" nil t 2))
+                         (point))))
+                (otherwise t))))))
+      (if (and post-affiliated (< (point) post-affiliated))
+         (and (save-excursion
+                (beginning-of-line)
+                (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
+              (> (point) (match-end 0))
+              (funcall object-check (org-element-context element)))
+       (case (org-element-type element)
+         (comment
+          (>= (point) (org-element-property :post-affiliated element)))
+         (comment-block
+          ;; Allow checks between block markers, not on them.
+          (and (> (line-beginning-position)
+                  (org-element-property :post-affiliated element))
+               (save-excursion
+                 (end-of-line)
+                 (skip-chars-forward " \r\t\n")
+                 (< (point) (org-element-property :end element)))))
+         ;; Arbitrary list of keywords where checks are meaningful.
+         ;; Make sure point is on the value part of the element.
+         (keyword
+          (and (member (org-element-property :key element)
+                       '("DESCRIPTION" "TITLE"))
+               (< (save-excursion
+                    (beginning-of-line) (search-forward ":") (point))
+                  (point))))
+         ;; Check is globally allowed in paragraphs verse blocks and
+         ;; table rows (after affiliated keywords) but some objects
+         ;; must not be affected.
+         ((paragraph table-row verse-block)
+          (and (>= (point) (org-element-property :contents-begin element))
+               (< (point) (org-element-property :contents-end element))
+               (funcall object-check (org-element-context element))))
+         (quote-section t)
+         ;; No check everywhere else (including verbatim parts like
+         ;; example blocks and fixed-width areas).
+         (otherwise nil))))))
+(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
 
 ;; Make `bookmark-jump' shows the jump location if it was hidden.
 (eval-after-load "bookmark"
-- 
1.8.4.2