[nongnu] elpa/forth-mode 1cb3071930 117/153: Move the font-locking for defining words to forth-syntax.el

[ELPA Syncer]

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

    Move the font-locking for defining words to forth-syntax.el
    
    By doing all font-locking in forth-syntax.el we have a (slightly)
    better chance to get it right.
    
    * forth-mode.el (forth-font-lock-keywords)
    (forth-match-definition): Deleted.
    (forth-mode): Set font-lock-defaults to '(nil), i.e. we have no
    keywords to search, but font-lock-mode is still enabled.
    
    * forth-syntax.el (forth-syntax--state-parsing-word): Split into
    three variants:
    1. state-parsing-word: no font-lock, just syntax-table
    2. state-parsing-keyword: syntax-table + keyword-face
    3. state-defining-word: syntax-table + keyword-face + function-face.
    (forth-syntax--state-defining-word)
    (forth-syntax--state-parsing-keyword): New.
    
    (forth-syntax--current-word-start): New global variable, to avoid
    some backward scanning.
    (forth-syntax--mark-font-lock-keyword): Use it.
    (forth-syntax--state-normal): Set forth-syntax--current-word-start.
    
    (forth-syntax--parsing-words, forth-syntax--defining-words)
    (forth-syntax--font-lock-keywords): New variables. Just some lists
    of words to simplify initialization.
    
    (forth-syntax--skip-word): New helper.
    (forth-syntax--word-at): Use it.
    
    (forth-syntax--state-string, forth-syntax--state-s\\\"):  Simplify
    a little.
---
 forth-mode.el   |  12 +------
 forth-syntax.el | 106 ++++++++++++++++++++++++++++++++++++++------------------
 2 files changed, 74 insertions(+), 44 deletions(-)

diff --git a/forth-mode.el b/forth-mode.el
index b546837caa..631849fe95 100644
--- a/forth-mode.el
+++ b/forth-mode.el
@@ -63,9 +63,6 @@
 
 (defvar forth-mode-hook)
 
-(defvar forth-font-lock-keywords
-  '((forth-match-definition 3 font-lock-function-name-face)))
-
 (defun forth-symbol-start ()
   (save-excursion
     (re-search-backward "[^[:graph:]]")
@@ -132,7 +129,7 @@
                     :syntax-table forth-mode-syntax-table
   (if (forth-block-p)
       (forth-block-mode))
-  (setq font-lock-defaults '(forth-font-lock-keywords))
+  (setq font-lock-defaults '(nil))
   (setq-local completion-at-point-functions '(forth-expand-symbol))
   (when (boundp 'syntax-propertize-function)
     (setq-local syntax-propertize-function #'forth-syntax-propertize))
@@ -165,13 +162,6 @@
     (speedbar-add-supported-extension ".fth")
     (speedbar-add-supported-extension ".4th")))
 
-;;; : ; does> variable constant value
-;;; if else then  do loop begin while repeat again until  postpone
-
-(defun forth-match-definition (limit)
-  (search-forward-regexp 
"\\(^\\|\\s-\\)\\(\\S-*:\\|code\\|defer\\|2?variable\\|create\\|2?value\\|2?constant\\)\\s-+\\([[:graph:]]+\\)"
-                        limit t))
-
 (defun forth-beginning ()
   (goto-char (point-min)))
 
diff --git a/forth-syntax.el b/forth-syntax.el
index e2bb516a9b..9992404522 100644
--- a/forth-syntax.el
+++ b/forth-syntax.el
@@ -1,4 +1,4 @@
-;; forth-syntax.el -- syntax-propertize function for forth-mode
+;;; forth-syntax.el -- syntax-propertize function       -*-lexical-binding:t-*-
 
 ;; This code mimics the Forth text interpreter and adds text
 ;; properties as side effect.
@@ -11,14 +11,20 @@
 (defvar forth-syntax--whitespace " \t\n\f\r")
 (defvar forth-syntax--non-whitespace (concat "^" forth-syntax--whitespace))
 
+;; Skip forward over whitespace and the following word. Return the
+;; start position of the word.
+(defun forth-syntax--skip-word ()
+  (skip-chars-forward forth-syntax--whitespace)
+  (let ((start (point)))
+    (skip-chars-forward forth-syntax--non-whitespace)
+    start))
+
 ;; Return the whitespace-delimited word at position POS.
 ;; Return nil if POS is at end-of-buffer.
 (defun forth-syntax--word-at (pos)
   (save-excursion
     (goto-char pos)
-    (skip-chars-forward forth-syntax--whitespace)
-    (let ((start (point)))
-      (skip-chars-forward forth-syntax--non-whitespace)
+    (let ((start (forth-syntax--skip-word)))
       (cond ((= start (point)) nil)
            (t (buffer-substring-no-properties start (point)))))))
 
@@ -57,9 +63,7 @@ SYNTAX must be a valid argument for `string-to-syntax'."
 
 ;; One line strings
 (defun forth-syntax--state-string ()
-  (re-search-backward "\"\\=")
-  (forth-syntax--set-syntax (point) (1+ (point)) "|")
-  (forward-char)
+  (forth-syntax--set-syntax (1- (point)) (point) "|")
   (cond ((re-search-forward "[\"\n]" nil t)
         (forth-syntax--set-syntax (1- (point)) (point) "|")
         #'forth-syntax--state-normal)
@@ -68,9 +72,7 @@ SYNTAX must be a valid argument for `string-to-syntax'."
         #'forth-syntax--state-eob)))
 
 (defun forth-syntax--state-s\\\" ()
-  (re-search-backward "\"\\=")
-  (forth-syntax--set-syntax (point) (1+ (point)) "|")
-  (forward-char)
+  (forth-syntax--set-syntax (1- (point)) (point) "|")
   (while (and (re-search-forward "\\([\"\n]\\|\\\\\\\\\\|\\\\\"\\)" nil t)
              (cond ((= (char-after (match-beginning 0)) ?\\)
                     (forth-syntax--set-syntax (match-beginning 0)
@@ -84,27 +86,54 @@ SYNTAX must be a valid argument for `string-to-syntax'."
         (goto-char (point-max))
         #'forth-syntax--state-eob)))
 
+;; The position where the current word started.  It is setup by
+;; `forth-syntax--state-normal'.  It avoids the need to scan backward
+;; so often.
+(defvar forth-syntax--current-word-start -1)
+
 ;; For the word before point, set the font-lock-face property.
 (defun forth-syntax--mark-font-lock-keyword ()
-  (let ((pos (point)))
-    (skip-chars-backward forth-syntax--non-whitespace)
-    (put-text-property (point) pos 'font-lock-face font-lock-keyword-face)
-    (goto-char pos)))
+  (let ((start forth-syntax--current-word-start))
+    (put-text-property start (point) 'font-lock-face font-lock-keyword-face)))
 
 (defun forth-syntax--state-font-lock-keyword ()
   (forth-syntax--mark-font-lock-keyword)
   (forth-syntax--state-normal))
 
+
 ;; State for words that parse the following word, e.g. POSTPONE S"
 ;; where POSTPONE parses S".
+;;
+;; FIXME: It would nice be to know if we are in compilation state for
+;; things like this: : FOO CREATE , ;
+;; Because in this case CREATE doesn't parse immediately.
 (defun forth-syntax--state-parsing-word ()
+  (let ((start (forth-syntax--skip-word)))
+    (cond ((= start (point))
+          #'forth-syntax--state-eob)
+         (t
+          (forth-syntax--set-word-syntax start (point))
+          #'forth-syntax--state-normal))))
+
+;; This is like `forth-syntax--state-parsing-word' but additionally
+;; sets the font-lock-keyword-face.
+(defun forth-syntax--state-parsing-keyword ()
   (forth-syntax--mark-font-lock-keyword)
-  (skip-chars-forward forth-syntax--whitespace)
-  (let ((start (point)))
-    (skip-chars-forward forth-syntax--non-whitespace)
-    (cond ((= start (point)) #'forth-syntax--state-eob)
+  (forth-syntax--state-parsing-word))
+
+;; This is also like `forth-syntax--state-parsing-word' but
+;; additionally set font-lock-keyword-face for the current word and
+;; font-lock-function-name-face for the following word.
+;; It's intended for thigs like: DEFER S"
+(defun forth-syntax--state-defining-word ()
+  (forth-syntax--mark-font-lock-keyword)
+  (let ((start (forth-syntax--skip-word)))
+    (cond ((= start (point))
+          #'forth-syntax--state-eob)
          (t
           (forth-syntax--set-word-syntax start (point))
+          (put-text-property start (point) 'font-lock-face
+                             font-lock-function-name-face)
           #'forth-syntax--state-normal))))
 
 (defun forth-syntax--parse-comment (backward-regexp forward-regexp)
@@ -156,19 +185,31 @@ SYNTAX must be a valid argument for `string-to-syntax'."
 (forth-syntax--define ".(" #'forth-syntax--state-.\()
 (forth-syntax--define "{:" #'forth-syntax--state-{:)
 
-(forth-syntax--define "postpone" #'forth-syntax--state-parsing-word)
-(forth-syntax--define "'" #'forth-syntax--state-parsing-word)
-(forth-syntax--define "[']" #'forth-syntax--state-parsing-word)
-(forth-syntax--define ":" #'forth-syntax--state-parsing-word)
+(forth-syntax--define "postpone" #'forth-syntax--state-parsing-keyword)
+
+(defvar forth-syntax--parsing-words
+  '("'" "[']" "char" "[char]"))
+
+(defvar forth-syntax--defining-words
+  '(":" "create" "synonym" "defer" "code"
+    "constant" "2constant" "fconstant"
+    "value" "2value" "fvalue"
+    "variable" "2variable" "fvariable"))
 
 (defvar forth-syntax--font-lock-keywords
-  '("variable" "constant" "value" "create"
-    "if" "else" "then"
+  '("if" "else" "then"
     "?do" "do" "unloop" "exit" "loop" "+loop"
     "begin" "while" "repeat" "again" "until"
     "case" "of" "endof" "endcase"
-    ":noname" ";" "does>"
-    "literal" "immediate"))
+    ":noname" ";" "does>" "immediate"
+    "is" "to"
+    "literal" "2literal" "fliteral" "sliteral"))
+
+(dolist (w forth-syntax--parsing-words)
+  (forth-syntax--define w #'forth-syntax--state-parsing-word))
+
+(dolist (w forth-syntax--defining-words)
+  (forth-syntax--define w #'forth-syntax--state-defining-word))
 
 (dolist (w forth-syntax--font-lock-keywords)
   (forth-syntax--define w #'forth-syntax--state-font-lock-keyword))
@@ -177,16 +218,15 @@ SYNTAX must be a valid argument for `string-to-syntax'."
 ;; characters as "word constituents"; finally return state-function
 ;; for the word.
 (defun forth-syntax--state-normal ()
-  (skip-chars-forward forth-syntax--whitespace)
-  (let ((start (point)))
-    (skip-chars-forward forth-syntax--non-whitespace)
-    (cond ((= start (point)) #'forth-syntax--state-eob)
+  (let ((start (forth-syntax--skip-word)))
+    (cond ((= start (point))
+          #'forth-syntax--state-eob)
          (t
           (forth-syntax--set-word-syntax start (point))
+          (setq forth-syntax--current-word-start start)
           (let ((word (buffer-substring-no-properties start (point))))
-            (cond ((forth-syntax--lookup word))
-                  (t
-                   #'forth-syntax--state-normal)))))))
+            (or (forth-syntax--lookup word)
+                #'forth-syntax--state-normal))))))
 
 
 ;;; Guess initial state