From 56bbebbd926e04ad4382cc9f37fb9e23d548130a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou 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:]_@#%:]+:\\)[ \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