[nongnu] elpa/forth-mode 8471704670 116/153: Add more font lock keywords

[ELPA Syncer]

branch: elpa/forth-mode
commit 847170467044bbd74be1754ee85a0f7613f297bd
Author: Helmut Eller <helmut@msibook>
Commit: Lars Brinkhoff <lars@nocrew.org>

    Add more font lock keywords
    
    As we already scan the buffer to set the syntax-table property,
    I thought that we could also set the font-lock-face property.
    
    This adds a lot of color, perhaps too much.
    
    * forth-syntax.el (forth-syntax--state-font-lock-keyword) New parser.
    (forth-syntax--mark-font-lock-keyword): New helper
    (forth-syntax--font-lock-keywords): New variable.
    (forth-syntax--state-parsing-word): Also mark POSTPONE and friends as
    keywords.
    (forth-syntax-propertize): Clear stale font-lock-face props.
---
 forth-syntax.el | 31 ++++++++++++++++++++++++++++---
 1 file changed, 28 insertions(+), 3 deletions(-)

diff --git a/forth-syntax.el b/forth-syntax.el
index 1aee67f6f0..e2bb516a9b 100644
--- a/forth-syntax.el
+++ b/forth-syntax.el
@@ -84,9 +84,21 @@ SYNTAX must be a valid argument for `string-to-syntax'."
         (goto-char (point-max))
         #'forth-syntax--state-eob)))
 
+;; 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)))
+
+(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".
 (defun forth-syntax--state-parsing-word ()
+  (forth-syntax--mark-font-lock-keyword)
   (skip-chars-forward forth-syntax--whitespace)
   (let ((start (point)))
     (skip-chars-forward forth-syntax--non-whitespace)
@@ -128,6 +140,10 @@ SYNTAX must be a valid argument for `string-to-syntax'."
 (defun forth-syntax--define (word parsing-function)
   (setf (gethash (downcase word) forth-syntax--parsers) parsing-function))
 
+;; Find the parsing function for WORD.
+(defun forth-syntax--lookup (word)
+  (gethash (downcase word) forth-syntax--parsers))
+
 (forth-syntax--define "s\"" #'forth-syntax--state-string)
 (forth-syntax--define ".\"" #'forth-syntax--state-string)
 (forth-syntax--define "c\"" #'forth-syntax--state-string)
@@ -145,9 +161,17 @@ SYNTAX must be a valid argument for `string-to-syntax'."
 (forth-syntax--define "[']" #'forth-syntax--state-parsing-word)
 (forth-syntax--define ":" #'forth-syntax--state-parsing-word)
 
-;; Find the parsing function for WORD.
-(defun forth-syntax--lookup (word)
-  (gethash (downcase word) forth-syntax--parsers))
+(defvar forth-syntax--font-lock-keywords
+  '("variable" "constant" "value" "create"
+    "if" "else" "then"
+    "?do" "do" "unloop" "exit" "loop" "+loop"
+    "begin" "while" "repeat" "again" "until"
+    "case" "of" "endof" "endcase"
+    ":noname" ";" "does>"
+    "literal" "immediate"))
+
+(dolist (w forth-syntax--font-lock-keywords)
+  (forth-syntax--define w #'forth-syntax--state-font-lock-keyword))
 
 ;; Look for the next whitespace delimited word; mark all its
 ;; characters as "word constituents"; finally return state-function
@@ -195,6 +219,7 @@ SYNTAX must be a valid argument for `string-to-syntax'."
 ;; until the position END is reached.
 (defun forth-syntax-propertize (start end)
   (save-excursion
+    (remove-text-properties start end '(font-lock-face))
     (let* ((guess (forth-syntax--guess-state start))
           (state (cdr guess)))
       ;;(message "forth-syntax-propertize: %s %s %s" start end guess)