[nongnu] elpa/forth-mode 16f359442e 109/153: Add tests for word movement commands

[ELPA Syncer]

branch: elpa/forth-mode
commit 16f359442e24bb9f71b9dbed0eae267e2574992c
Author: Helmut Eller <eller.helmut@gmail.com>
Commit: Helmut Eller <eller.helmut@gmail.com>

    Add tests for word movement commands
    
    * test/tests.el (forth-word-movements): New test.
    (forth-assert-forward-word): New helper.
    
    * forth-syntax.el (forth-syntax--state-normal): Use "word constituent"
    ("w") instead of "symbol constituent" ("_"), so that word movements
    works better.
    (forth-syntax--set-syntax): New helper.
---
 forth-syntax.el | 42 +++++++++++++++++++-----------------------
 test/tests.el   | 15 +++++++++++++++
 2 files changed, 34 insertions(+), 23 deletions(-)

diff --git a/forth-syntax.el b/forth-syntax.el
index 8f3bd27a0d..39133fd6d5 100644
--- a/forth-syntax.el
+++ b/forth-syntax.el
@@ -22,6 +22,10 @@
       (cond ((= start (point)) nil)
            (t (buffer-substring-no-properties start (point)))))))
 
+(defmacro forth-syntax--set-syntax (start end syntax)
+  "Set the 'syntax-table property in the region START/END to SYNTAX.
+SYNTAX must be a valid argument for `string-to-syntax'."
+  `(put-text-property ,start ,end 'syntax-table ',(string-to-syntax syntax)))
 
 
 ;;; State functions
@@ -39,35 +43,31 @@
 ;; One line strings
 (defun forth-syntax--state-string ()
   (re-search-backward "\"\\=")
-  (put-text-property (point) (1+ (point))
-                    'syntax-table (string-to-syntax "\""))
+  (forth-syntax--set-syntax (point) (1+ (point)) "\"")
   (forward-char)
   (cond ((re-search-forward "[\"\n]" nil t)
-        (put-text-property (1- (point)) (point)
-                           'syntax-table (string-to-syntax "\""))
+        (forth-syntax--set-syntax (1- (point)) (point) "\"")
         #'forth-syntax--state-normal)
        (t
         (goto-char (point-max))
-        #'forth-syntax--state-normal)))
+        #'forth-syntax--state-eob)))
 
 (defun forth-syntax--state-s\\\" ()
   (re-search-backward "\"\\=")
-  (put-text-property (point) (1+ (point))
-                    'syntax-table (string-to-syntax "\""))
+  (forth-syntax--set-syntax (point) (1+ (point)) "\"")
   (forward-char)
   (while (and (re-search-forward "\\([\"\n]\\|\\\\\"\\)" nil t)
              (cond ((= (char-after (match-beginning 0)) ?\\)
-                    (put-text-property (match-beginning 0)
-                                       (1+ (match-beginning 0))
-                                       'syntax-table (string-to-syntax "\\"))
+                    (forth-syntax--set-syntax (match-beginning 0)
+                                              (1+ (match-beginning 0))
+                                              "\\")
                     t))))
   (cond ((looking-back "[\"\n]" 1)
-        (put-text-property (1- (point)) (point)
-                           'syntax-table (string-to-syntax "\""))
+        (forth-syntax--set-syntax (1- (point)) (point) "\"")
         #'forth-syntax--state-normal)
        (t
         (goto-char (point-max))
-        #'forth-syntax--state-normal)))
+        #'forth-syntax--state-eob)))
 
 ;; State for words that parse the following word, e.g. POSTPONE S"
 ;; where POSTPONE parses S".
@@ -77,23 +77,20 @@
     (skip-chars-forward forth-syntax--non-whitespace)
     (cond ((= start (point)) #'forth-syntax--state-eob)
          (t
-          (put-text-property start (point)
-                             'syntax-table (string-to-syntax "_"))
+          (forth-syntax--set-syntax start (point) "w")
           #'forth-syntax--state-normal))))
 
 (defun forth-syntax--parse-comment (backward-regexp forward-regexp)
   (let ((pos (point)))
     (re-search-backward backward-regexp)
-    (put-text-property (point) (1+ (point))
-                      'syntax-table (string-to-syntax "<"))
+    (forth-syntax--set-syntax (point) (1+ (point)) "<")
     (goto-char pos)
     (cond ((re-search-forward forward-regexp nil t)
-          (put-text-property (1- (point)) (point)
-                             'syntax-table (string-to-syntax ">"))
+          (forth-syntax--set-syntax (1- (point)) (point) ">")
           #'forth-syntax--state-normal)
          (t
           (goto-char (point-max))
-          #'forth-syntax--state-normal))))
+          #'forth-syntax--state-eob))))
 
 ;; Define a state-function for comments.  The comment starts with
 ;; the string BEGIN and ends with the string END.
@@ -138,7 +135,7 @@
   (gethash (downcase word) forth-syntax--parsers))
 
 ;; Look for the next whitespace delimited word; mark all its
-;; characters as "symbol constituents"; finally return state-function
+;; characters as "word constituents"; finally return state-function
 ;; for the word.
 (defun forth-syntax--state-normal ()
   (skip-chars-forward forth-syntax--whitespace)
@@ -146,8 +143,7 @@
     (skip-chars-forward forth-syntax--non-whitespace)
     (cond ((= start (point)) #'forth-syntax--state-eob)
          (t
-          (put-text-property start (point)
-                             'syntax-table (string-to-syntax "_"))
+          (forth-syntax--set-syntax start (point) "w")
           (let ((word (buffer-substring-no-properties start (point))))
             (cond ((forth-syntax--lookup word))
                   (t
diff --git a/test/tests.el b/test/tests.el
index 1681a10389..2125eb33fe 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -56,6 +56,12 @@ The whitespace before and including \"|\" on each line is 
removed."
     (forward-sexp)
     (should (= (point) end))))
 
+(defun forth-assert-forward-word (content start end)
+  (forth-with-temp-buffer content
+    (goto-char start)
+    (forward-word)
+    (should (= (point) end))))
+
 (ert-deftest forth-paren-comment-font-lock ()
   (forth-assert-face "( )" 1 font-lock-comment-delimiter-face)
   (forth-assert-face ".( )" 1 font-lock-comment-face)
@@ -181,3 +187,12 @@ The whitespace before and including \"|\" on each line is 
removed."
   (forth-assert-forward-sexp " : foo bar ; \ x" 2 13)
   (forth-assert-forward-sexp " :noname foo bar ; \ x" 2 19)
   (forth-assert-forward-sexp " if drop exit else 1+ then bar " 2 27))
+
+;; IDEA 1: in words like foo-bar give the "-" a "word constituent"
+;; syntax so that word movement works like in Lisp mode (which
+;; everybody is used to :-).
+;;
+;; IDEA 2: give the filename in "include filename" string syntax.
+(ert-deftest forth-word-movements ()
+  (forth-assert-forward-word "include /tmp/foo.fth \ bar" 1 8)
+  (forth-assert-forward-word "include /tmp/foo.fth \ bar" 8 21))