WIP: Adding pretty-declarations and pretty-expr functions

ts-mode/verilog-ts-mode.el

@@ -132,7 +132,8 @@ Snippet fetched from `treesit--indent-1'."
        "always_construct"
        "initial_construct"
        "final_construct"
-       "generate_region"))))
+       "generate_region"
+       "seq_block"))))
 
 (defun verilog-ts-module-at-point ()
   "Return node of module at point."
@@ -147,7 +148,27 @@ Snippet fetched from `treesit--indent-1'."
          (block-node (verilog-ts--node-has-parent-recursive node-at-point block-re)))
     block-node))
 
-(defun verilog-ts-nodes-current-buffer (pred &optional start)
+(defun verilog-ts-nodes-current-buffer (pred)
+  "Return current buffer NODES that match PRED."
+  (let ((root-node (treesit-buffer-root-node)))
+    (mapcar #'car (cdr (treesit-induce-sparse-tree root-node pred)))))
+
+(defun verilog-ts-nodes-block-at-point (pred)
+  "Return block at point NODES that match PRED."
+  (let ((block-node (verilog-ts-block-at-point)))
+    (mapcar #'car (cdr (treesit-induce-sparse-tree block-node pred)))))
+
+(defun verilog-ts-search-forward-node-block-at-point (pred &optional backward all)
+  "Search forward for node matching PRED inside block at point."
+  (let ((block-node (verilog-ts-block-at-point)))
+    (treesit-search-forward (verilog-ts--node-at-point)
+                            (lambda (node)
+                              (and (string-match pred (treesit-node-type node))
+                                   (< (treesit-node-end node) (treesit-node-end block-node))))
+                            backward
+                            all)))
+
+(defun verilog-ts-nodes-current-buffer-1 (pred &optional start)
   "Return node names and positions that satisfy PRED in current buffer."
   (interactive)
   (let* ((root-node (or start (treesit-buffer-root-node)))
@@ -162,33 +183,31 @@ Snippet fetched from `treesit--indent-1'."
 
 (defun verilog-ts-class-attributes ()
   "Return class attributes of current file."
-  (verilog-ts-nodes-current-buffer "class_property"))
+  (verilog-ts-nodes-current-buffer-1 "class_property"))
 
 (defun verilog-ts-class-methods ()
   "Return class methods of current file."
-  (delete-dups (verilog-ts-nodes-current-buffer "class_\\(constructor\\|method\\)")))
+  (delete-dups (verilog-ts-nodes-current-buffer-1 "class_\\(constructor\\|method\\)")))
 
 (defun verilog-ts-class-constraints ()
   "Return class constraints of current file."
-  (verilog-ts-nodes-current-buffer "constraint_declaration"))
+  (verilog-ts-nodes-current-buffer-1 "constraint_declaration"))
 
 (defun verilog-ts-module-instances ()
   "Return module instances of current file."
-  (verilog-ts-nodes-current-buffer "module_instantiation"))
+  (verilog-ts-nodes-current-buffer-1 "module_instantiation"))
 
 (defun verilog-ts-module-declarations ()
   "Return module declarations of current file."
-  (verilog-ts-nodes-current-buffer "module_declaration"))
+  (verilog-ts-nodes-current-buffer-1 "module_declaration"))
 
 (defun verilog-ts-always-blocks ()
   "Return always blocks of current file."
-  (verilog-ts-nodes-current-buffer "always_keyword"))
+  (verilog-ts-nodes-current-buffer-1 "always_keyword"))
 
 (defun verilog-ts-instance-nodes ()
   "Return instance nodes of current buffer."
-  (let ((root-node (treesit-buffer-root-node)))
-    (mapcar #'car (cdr (treesit-induce-sparse-tree root-node
-                                                   "module_instantiation")))))
+  (verilog-ts-nodes-current-buffer "module_instantiation"))
 
 
 ;;;; Navigation
@@ -1222,6 +1241,64 @@ Return nil if there is no name or if NODE is not a defun node."
                 "class_method")))
 
 ;;; Beautify
+;; TODO: Implement for port declarations, localparams?
+;; TODO: Implement if region is active
+;; TODO: Implement tests!
+(defun verilog-ts-pretty-declarations ()
+  "Line up declarations around point."
+  (interactive)
+  (let* ((decl-node-re "list_of_\\(net\\|variable\\)_decl_assignments")
+         (nodes (verilog-ts-nodes-block-at-point decl-node-re))
+         (indent-levels (mapcar (lambda (node)
+                                  (save-excursion
+                                    (goto-char (treesit-node-start node))
+                                    (skip-chars-backward " \t\n\r")
+                                    (forward-char)
+                                    (current-column)))
+                                nodes))
+         (indent-level-max (when indent-levels
+                             (apply #'max indent-levels)))
+         current-node)
+    ;; Start processing
+    (when nodes
+      (save-excursion
+        (goto-char (treesit-node-start (car nodes)))
+        (while (setq current-node (verilog-ts-search-forward-node-block-at-point decl-node-re))
+          (goto-char (treesit-node-start current-node))
+          (just-one-space)
+          (indent-to indent-level-max)
+          (goto-char (treesit-node-end (verilog-ts-search-forward-node-block-at-point decl-node-re))))))))
+
+;; TODO: Beware that nonblocking_assignment has no node that points to the operator (only re "<=")
+;; unlike blocking_assignments, that have "assignment_operator", which is "=" and can be queried!
+;; TODO: Implement if region is active
+;; TODO: Implement tests!
+(defun verilog-ts-pretty-expr ()
+  "Line up expressions around point."
+  (interactive)
+  (let* ((decl-node-re "\\(non\\)?blocking_assignment")
+         (nodes (verilog-ts-nodes-block-at-point decl-node-re))
+         (indent-levels (mapcar (lambda (node)
+                                  (save-excursion
+                                    (goto-char (treesit-node-start node))
+                                    (skip-chars-backward " \t\n\r")
+                                    (forward-char)
+                                    (current-column)))
+                                nodes))
+         (indent-level-max (when indent-levels
+                             (apply #'max indent-levels)))
+         current-node)
+    ;; Start processing
+    (when nodes
+      (save-excursion
+        (goto-char (treesit-node-start (car nodes)))
+        (while (setq current-node (verilog-ts-search-forward-node-block-at-point decl-node-re))
+          (goto-char (treesit-node-start current-node))
+          (just-one-space)
+          (indent-to indent-level-max)
+          ;; TODO: So far only difference with `verilog-ts-pretty-declarations'
+          (goto-char (treesit-node-end (verilog-ts-search-forward-node-block-at-point "operator_assignment"))))))))
+
 (defun verilog-ts-beautify-block-at-point ()
   "Beautify/indent block at point.
 
@@ -1303,7 +1380,7 @@ Complete with keywords and current buffer identifiers."
          (end (cdr bds))
          candidates)
     (setq candidates (remove (thing-at-point 'symbol :no-props)
-                             (append (mapcar #'car (verilog-ts-nodes-current-buffer "simple_identifier"))
+                             (append (verilog-ts-nodes-current-buffer "simple_identifier")
                                      verilog-keywords)))
     (list start end candidates . nil)))