diff --git a/ts-fold-parsers.el b/ts-fold-parsers.el index 668bb77..cf9456e 100644 --- a/ts-fold-parsers.el +++ b/ts-fold-parsers.el @@ -45,6 +45,7 @@ (declare-function ts-fold-range-c-preproc-elif "ts-fold.el") (declare-function ts-fold-range-c-preproc-else "ts-fold.el") (declare-function ts-fold-range-html "ts-fold.el") +(declare-function ts-fold-range-ocaml "ts-fold.el") (declare-function ts-fold-range-python "ts-fold.el") (declare-function ts-fold-range-ruby "ts-fold.el") (declare-function ts-fold-range-rust-macro "ts-fold.el") @@ -171,6 +172,13 @@ (ts-fold-range-line-comment node offset "#") (ts-fold-range-c-like-comment node offset)))))) +(defun ts-fold-parsers-ocaml () + "Rule sets for OCaml." + '((comment . ts-fold-range-ocaml-comment) + (module_definition . ts-fold-range-ocaml-module-definition) + (type_definition . ts-fold-range-ocaml-type-definition) + (value_definition . ts-fold-range-ocaml-value-definition))) + (defun ts-fold-parsers-python () "Rule sets for Python." '((function_definition . ts-fold-range-python) diff --git a/ts-fold.el b/ts-fold.el index 7d47842..096cfcf 100644 --- a/ts-fold.el +++ b/ts-fold.el @@ -90,6 +90,7 @@ The alist is in form of (major-mode . (foldable-node-type)).") (sh-mode . ,(ts-fold-parsers-bash)) (scala-mode . ,(ts-fold-parsers-scala)) (swift-mode . ,(ts-fold-parsers-swift)) + (tuareg-mode . ,(ts-fold-parsers-ocaml)) (typescript-mode . ,(ts-fold-parsers-typescript))) "An alist of (major-mode . (foldable-node-type . function)). @@ -446,6 +447,75 @@ more information." (end (tsc-node-start-position end-node))) (ts-fold--cons-add (cons beg end) offset))) +;;+ OCaml + +(defun one-liner-node (node) + "Helper function to check if NODE is on one line only." + (/= (car (aref (tsc-node-range node) 2)) (car (aref (tsc-node-range node) 3)))) + +(defun ts-fold-range-ocaml-comment (node offset) + "Define fold range for `comment'. + +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for +more information." + (unless (one-liner-node node) + (when-let* + ((text (tsc-node-text node)) + (beg (if (string-prefix-p "(* " text) + (+ 2 (tsc-node-start-position node)) + (+ 3 (tsc-node-start-position node)))) + (end (- (tsc-node-end-position node) 2))) + (cons beg end)))) + +(defun ts-fold-range-ocaml-module-definition (node offset) + "Define fold range for `module_definition'. + +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for +more information." + (unless (one-liner-node node) + (when-let* + ((module-binding (tsc-get-nth-named-child node 0)) + (body (tsc-get-child-by-field module-binding :body)) + ;; body is struct ... end + (beg (+ 6 (tsc-node-start-position body))) + (end (- (tsc-node-end-position node) 3))) + (cons beg end)))) + +(defun ts-fold-range-ocaml-type-definition (node offset) + "Define fold range for `type_definition'. + +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for +more information." + (unless (one-liner-node node) + (when-let* + ((type-definition (tsc-get-nth-named-child node 0)) + (body (tsc-get-child-by-field type-definition :body)) + (text (tsc-node-text (tsc-get-nth-child body 0))) + (beg + (if (string-equal "{" text) + (1+ (tsc-node-start-position body)) + (tsc-node-end-position (tsc-get-prev-sibling body)))) + (end + (if (string-equal "{" text) + (1- (tsc-node-end-position node)) + (tsc-node-end-position node)))) + (cons beg end)))) + +(defun ts-fold-range-ocaml-value-definition (node offset) + "Define fold range for `value_definition'. + +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for +more information." + (unless (one-liner-node node) + (when-let* + ((let-binding (tsc-get-nth-named-child node 0)) + (body (tsc-get-child-by-field let-binding :body)) + (beg (tsc-node-end-position (tsc-get-prev-sibling body))) + (end (tsc-node-end-position node))) + (cons beg end)))) + +;;- OCaml + (defun ts-fold-range-python (node offset) "Define fold range for `function_definition' and `class_definition'.