feat: support 0.4.0 grammar

Author: johnstonskj

README.md

@@ -203,6 +203,10 @@ file in the repository for details.
 
 ## Changes
 
+### Version 0.2.0
+
+* Feature: update the grammar support for the underlying 0.4.0 release of tree-sitter-sdml.
+
 ### Version 0.1.9
 
 * Feature: added new `sdml-mode-ctags-mode` minor mode that provides a command to

sdml-mode-cli.el

@@ -116,25 +116,27 @@ to `sdml-cli-default-error-buffer-name'.
 
 The boolean REFRESH-FN indicates that a refresh function should
 be added to the buffer with a key binding to \"g\"."
-  (let ((output-buffer-name (or output-buffer-name sdml-mode-cli-default-output-buffer-name))
+  (let ((is-special (null output-buffer-name))
+        (output-buffer-name (or output-buffer-name sdml-mode-cli-default-output-buffer-name))
         (load-path (concat (or (getenv "SDML_PATH") "")
                            (string-join sdml-mode-cli-load-path ":"))))
     (with-environment-variables (("SDML_PATH" load-path))
       (shell-command command
                      output-buffer-name
                      (or error-buffer-name sdml-mode-cli-default-error-buffer-name))
-      (pop-to-buffer output-buffer-name)
-      ;; colorize output
-      (ansi-color-apply-on-region (point-min) (point-max))
-      ;; make read-only
-      (special-mode)
-      (when refresh-fn
+      (when is-special
+        (pop-to-buffer output-buffer-name)
+        ;; colorize output
+        (ansi-color-apply-on-region (point-min) (point-max))
+        ;; make read-only
+        (special-mode)
+        (when refresh-fn
         ;; install refresh command
         (use-local-map (copy-keymap special-mode-map))
         (local-set-key "g" (sdml-mode-cli--make-refresh-cmd command
                                                             load-path
                                                             output-buffer-name
-                                                            error-buffer-name))))))
+                                                            error-buffer-name)))))))
 
 (provide 'sdml-mode-cli)
 

sdml-mode-hl.el

@@ -49,6 +49,7 @@
     "assert"
     "class"
     "datatype"
+    "dimension"
     "entity"
     "enum"
     "event"
@@ -97,8 +98,12 @@
    (import_statement [ "[" "]" ] @punctuation.bracket)
 
    (member_import name: (qualified_identifier) @type)
+   (member_import "as" @keyword)
+   (member_import rename: (identifier) @type)
 
    (module_import name: (identifier) @module)
+   (module_import "as" @keyword)
+   (module_import rename: (identifier) @module)
 
    ;; -------------------------------------------------------------------
    ;; Annotations and Constraints (Note property => label)
@@ -127,8 +132,6 @@
    (function_parameter name: (identifier) @variable.parameter)
    (function_parameter target: (_) @type)
 
-   (optional) @operator
-
    (function_cardinality_expression (sequence_ordering) @keyword)
    (function_cardinality_expression (sequence_uniqueness) @keyword)
    (function_cardinality_expression [ "{" "}" ] @punctuation.bracket)
@@ -197,19 +200,22 @@
    (data_type_def base: (identifier_reference) @type)
    (data_type_def opaque: (opaque) @keyword)
 
+   (dimension_def name: (identifier) @type.definition)
+
    (entity_def name: (identifier) @type.definition)
 
    (enum_def name: (identifier) @type.definition)
 
-   (event_def "source" @keyword)
-   (event_def
-    name: (identifier) @type.definition
-    source: (identifier_reference) @type)
+   (event_def name: (identifier) @type.definition)
 
    (structure_def name: (identifier) @type.definition)
 
    (union_def name: (identifier) @type.definition)
 
+   (source_entity "source" @keyword entity: (identifier_reference) @type)
+   (source_entity "with" @keyword)
+   (source_entity member: (identifier) @variable.field)
+
    ;; -------------------------------------------------------------------
    ;; RDF Definitions
    ;; -------------------------------------------------------------------
@@ -243,13 +249,19 @@
 
    (entity_identity "identity" @keyword)
 
-   (member_def name: (identifier) @variable.field)
-   (member_def target: (type_reference) @type)
+   (member_def
+    name: (identifier) @variable.field
+    target: (type_reference) @type)
 
    (property_ref
     "ref" @keyword
     property: (identifier_reference) @variable.field)
 
+   (dimension_parent
+    "parent" @keyword
+    name: (identifier) @variable.field
+    parent: (identifier_reference) @type)
+
    (value_variant name: (identifier) @constant)
 
    (type_variant (identifier_reference) @type)

sdml-mode-hydra.el

@@ -0,0 +1,55 @@
+
+(require 'sdml-mode)
+(require 'sdml-mode-ctags)
+(require 'pretty-hydra)
+
+(cond
+ ((featurep 'pretty-hydra)
+  (pretty-hydra-define sdml-mode-hydra
+    (:color blue :quit-key "q" :title "SDML")
+    ("Edit"
+     (("t"     sdml-mode-current-buffer-dependency-tree  "Open dependency tree")
+      ("T"     sdml-mode-current-buffer-dependency-graph "Open dependency graph")
+      ("v"     sdml-mode-validate-current-buffer         "Validate current buffer")
+      ("V"     sdml-mode-validate-file                   "Validate file")
+      ("g"     sdml-mode-ctags-generate                  "Generate ctags")
+      ("f"     flycheck-list-errors                      "Open Flycheck errors")
+      ("n"     display-line-numbers-mode                 "Toggle line numbers" :toggle t))
+     "Document"
+     (("d d"   sdml-mode-document-module                 "Document module")
+      ("d b"   sdml-mode-document-project                "Document project")
+      ("d c"   sdml-mode-draw-concept                    "Draw concept diagram")
+      ("d e"   sdml-mode-draw-entities                   "Draw E/R diagram")
+      ("d u"   sdml-mode-draw-uml                        "Draw UML diagram"))
+     "Generate"
+     (("c r"   sdml-mode-generate-rdf                    "Generate RDF representation")
+      ("c s"   sdml-mode-generate-scheme                 "Generate scheme representation")
+      ("c j"   sdml-mode-generate-json                   "Generate JSON representation")
+      ("c t"   sdml-mode-generate-with-tera              "Generate using Tera templates"))
+     "Debug"
+     (("h d"   tree-sitter-debug-mode                    "Toggle ts debug tree mode" :toggle t)
+      ("h q"   tree-sitter-query-builder                 "Open ts query builder"))))
+  (bind-key "C-c C-s h" 'sdml-mode-hydra/body)
+  (bind-key "<f9> s" 'sdml-mode-hydra/body))
+ 
+
+ ;;    ((featurep 'hydra) (message "plain")
+ ;;     (defhydra sdml-mode-hydra (:color pink :hint nil)
+ ;;       "
+ ;; ^Edit^                       ^Document^           ^Tree-Sitter^
+ ;; ^^^^^^^^-----------------------------------------------------------------
+ ;; _t_: dependency tree         _u_: unmark          _d_: debug tree
+ ;; _T_: dependency graph        _U_: unmark up       _q_: query builder
+ ;; _v_: validate buffer
+ ;; _V_: validate file
+ ;; "
+ ;;       ("t" sdml-mode-current-buffer-dependency-tree)
+ ;;       ("T" sdml-mode-current-buffer-dependency-graph)
+ ;;       ("v" sdml-mode-validate-current-buffer)
+ ;;       ("V" sdml-mode-validate-file)
+ ;;       ("u" nil)
+ ;;       ("U" Buffer-menu-save)
+ ;;       ("d" tree-sitter-debug-mode)
+ ;;       ("q" tree-sitter-query-builder)))
+ (t
+  (message "Install 'hydra or 'pretty-hydra")))

sdml-mode-indent.el

@@ -48,7 +48,9 @@
                    function_body
                    constant_def
                    informal_constraint
-                   constraint_sentence))
+                   constraint_sentence
+                   source_entity
+                   dimension_parent))
 
     ;; If parent node is one of this and current node is not first → indent
     (indent-rest . ())
@@ -58,8 +60,8 @@
                     import_statement
                     annotation_only_body
                     ;; entity_body << this double indents.
+                    dimension_body
                     enum_body
-                    property_body
                     structure_body
                     union_body
                     type_class_body

sdml-mode.el

@@ -1,8 +1,8 @@
 ;;; sdml-mode.el --- Major mode for SDML -*- lexical-binding: t; -*-
 
 ;; Author: Simon Johnston <[email protected]>
-;; Version: 0.1.9
-;; Package-Requires: ((emacs "28.1") (tree-sitter "0.18.0") (tree-sitter-indent "0.3"))
+;; Version: 0.2.0
+;; Package-Requires: ((emacs "28.1") (tree-sitter "0.18.0") (tree-sitter-indent "0.4"))
 ;; URL: https://github.com/johnstonskj/emacs-sdml-mode
 ;; Keywords: languages tools
 
@@ -180,7 +180,7 @@ platform-specific extension in `tree-sitter-load-suffixes'."
                  '(sdml-mode . sdml))))
 
 ;; --------------------------------------------------------------------------
-;; Buffer Commands  Validation
+;; Commands  Validation
 ;; --------------------------------------------------------------------------
 
 (defconst sdml-mode-validation-error-regexp
@@ -239,7 +239,7 @@ usual."
 
 
 ;; --------------------------------------------------------------------------
-;; Buffer Commands  Dependencies
+;; Commands  Dependencies
 ;; --------------------------------------------------------------------------
 
 
@@ -285,6 +285,103 @@ using the key `q', and it's content may be refreshed with the key
         (sdml-mode-cli-run-command cmd-line "*SDML Dependencies*" nil t))))
 
 
+;; --------------------------------------------------------------------------
+;; Commands  Placeholders
+;; --------------------------------------------------------------------------
+
+(defun sdml-mode-document-module ()
+  "Generate standard documentation for module in current buffer."
+  (interactive nil sdml-mode)
+  (let* ((inp-file (buffer-file-name))
+         (out-file (if (null inp-file) "-"
+                     (concat (file-name-sans-extension inp-file) ".org")))
+         (out-buffer (if (null inp-file) "*SDML Documentation*" nil)))
+    (let ((cmd-line (sdml-mode-cli-make-command
+                     "doc"
+                     (sdml-mode-cli-make-arg 'output-format 'org-mode)
+                     (sdml-mode-cli-make-arg 'output out-file)
+                     'current-buffer)))
+      (when cmd-line
+        (sdml-mode-cli-run-command cmd-line out-buffer nil t)
+        (cond
+         ((not (null out-buffer))
+          (with-current-buffer out-buffer
+            (org-mode)))
+         ((not (eq out-file "-"))
+          (find-file out-file)))))))
+
+(defun sdml-mode-document-project ()
+  "Do something."
+  (interactive nil sdml-mode)
+  t)
+
+(defun sdml-mode-draw-concept ()
+  "Do something."
+  (interactive nil sdml-mode)
+  t)
+
+(defun sdml-mode-draw-entities ()
+  "Do something."
+  (interactive nil sdml-mode)
+  t)
+
+(defun sdml-mode-draw-uml ()
+  "Do something."
+  (interactive nil sdml-mode)
+  t)
+
+(defun sdml-mode-generate-rdf ()
+  "Do something."
+  (interactive nil sdml-mode)
+  t)
+
+(defun sdml-mode-generate-scheme ()
+  "Generate Scheme representation of the current buffer."
+  (interactive nil sdml-mode)
+  (let* ((inp-file (buffer-file-name))
+         (out-file (if (null inp-file) "-"
+                     (concat (file-name-sans-extension inp-file) ".scm")))
+         (out-buffer (if (null inp-file) "*SDML Parse-tree Scheme*" nil)))
+    (let ((cmd-line (sdml-mode-cli-make-command
+                     "convert"
+                     (sdml-mode-cli-make-arg 'output-format 's-expr)
+                     (sdml-mode-cli-make-arg 'output out-file)
+                     'current-buffer)))
+      (when cmd-line
+        (sdml-mode-cli-run-command cmd-line out-buffer nil t)
+        (cond
+         ((and (not (null out-buffer)) (featurep 'scheme-mode))
+          (with-current-buffer out-buffer
+            (scheme-mode)))
+         ((not (eq out-file "-"))
+          (find-file out-file)))))))
+
+(defun sdml-mode-generate-json ()
+  "Generate JSON representation of current buffer."
+  (interactive nil sdml-mode)
+  (let* ((inp-file (buffer-file-name))
+         (out-file (if (null inp-file) "-"
+                     (concat (file-name-sans-extension inp-file) ".json")))
+         (out-buffer (if (null inp-file) "*SDML Parse-tree JSON*" nil)))
+    (let ((cmd-line (sdml-mode-cli-make-command
+                     "convert"
+                     (sdml-mode-cli-make-arg 'output-format 'json-pretty)
+                     (sdml-mode-cli-make-arg 'output out-file)
+                     'current-buffer)))
+      (when cmd-line
+        (sdml-mode-cli-run-command cmd-line out-buffer nil t)
+        (cond
+         ((and (not (null out-buffer)) (featurep 'json-mode))
+          (with-current-buffer out-buffer
+            (json-mode)))
+         ((not (eq out-file "-"))
+          (find-file out-file)))))))
+
+(defun sdml-mode-generate-with-tera ()
+  "Do something."
+  (interactive nil sdml-mode)
+  t)
+
 ;; --------------------------------------------------------------------------
 ;; Key Bindings
 ;; --------------------------------------------------------------------------