From 72d448e384249103748ee83b587c45924e4bc44d Mon Sep 17 00:00:00 2001
From: sefidel <contact@sefidel.net>
Date: Thu, 10 Feb 2022 00:24:03 +0900
Subject: Initial commit

---
 fnl/nvrc/macro/color.fnl   |  9 ++++++
 fnl/nvrc/macro/event.fnl   | 63 ++++++++++++++++++++++++++++++++++++
 fnl/nvrc/macro/keymap.fnl  | 46 ++++++++++++++++++++++++++
 fnl/nvrc/macro/misc.fnl    |  1 +
 fnl/nvrc/macro/pack.fnl    | 80 ++++++++++++++++++++++++++++++++++++++++++++++
 fnl/nvrc/macro/set.fnl     | 79 +++++++++++++++++++++++++++++++++++++++++++++
 fnl/nvrc/macro/thread.fnl  | 15 +++++++++
 fnl/nvrc/macro/toolkit.fnl | 39 ++++++++++++++++++++++
 8 files changed, 332 insertions(+)
 create mode 100644 fnl/nvrc/macro/color.fnl
 create mode 100644 fnl/nvrc/macro/event.fnl
 create mode 100644 fnl/nvrc/macro/keymap.fnl
 create mode 100644 fnl/nvrc/macro/misc.fnl
 create mode 100644 fnl/nvrc/macro/pack.fnl
 create mode 100644 fnl/nvrc/macro/set.fnl
 create mode 100644 fnl/nvrc/macro/thread.fnl
 create mode 100644 fnl/nvrc/macro/toolkit.fnl

(limited to 'fnl/nvrc/macro')

diff --git a/fnl/nvrc/macro/color.fnl b/fnl/nvrc/macro/color.fnl
new file mode 100644
index 0000000..9636956
--- /dev/null
+++ b/fnl/nvrc/macro/color.fnl
@@ -0,0 +1,9 @@
+(fn tbl? [x]
+  (= :table (type x)))
+
+(fn highlight [group-arg colset]
+  "Add a highlighting group."
+  (each [_ group (ipairs (if (tbl? group-arg) group-arg [group-arg]))]
+      (vim.api.nvim_set_hl 0 group colset)))
+
+{: highlight}
diff --git a/fnl/nvrc/macro/event.fnl b/fnl/nvrc/macro/event.fnl
new file mode 100644
index 0000000..3453431
--- /dev/null
+++ b/fnl/nvrc/macro/event.fnl
@@ -0,0 +1,63 @@
+(import-macros {: as->} :nvrc.macro.thread)
+
+(local {: format} string)
+(local {: insert : concat} table)
+
+(local {: fn? : gensym-checksum : vlua} (require :nvrc.macro.toolkit))
+
+(fn last [xs]
+  (. xs (length xs)))
+
+(fn ->str [x]
+  (tostring x))
+
+(fn includes? [xs x]
+  (accumulate [is? false _ v (ipairs xs) :until is?]
+    (= v x)))
+
+(lambda au! [name ...]
+  "Defines an autocommand group using the vim API."
+  `(do
+     (vim.cmd ,(format "augroup %s" name))
+     (vim.cmd :autocmd!)
+     (do
+       ,...)
+     (vim.cmd "augroup END")))
+
+(lambda aub! [name ...]
+  "Defines a buffer-local autocommand group using the vim API."
+  `(do
+     (vim.cmd ,(format "augroup %s" name))
+     (vim.cmd "autocmd! * <buffer>")
+     (do
+       ,...)
+     (vim.cmd "augroup END")))
+
+(lambda ac! [events pattern ...]
+  "Defines an autocommand using the vim API."
+  (let [events (as-> [$ events] (if (sequence? $) $ [$])
+                     (icollect [_ v (ipairs $)]
+                       (->str v)) (concat $ ","))
+        pattern (as-> [$ pattern] (if (sequence? $) $ [$])
+                      (icollect [_ v (ipairs $)]
+                        (->str v)) (concat $ ","))
+        once? (or (includes? [...] `++once) (includes? [...] :++once))
+        nested? (or (includes? [...] `++nested) (includes? [...] :++nested))
+        command (last [...])]
+    (if (fn? command)
+        (let [fsym (gensym-checksum "__" command)]
+          `(do
+             (global ,fsym ,command)
+             (vim.cmd ,(format (if (and once? nested?)
+                                   "autocmd %s %s ++once ++nested call %s" once?
+                                   "autocmd %s %s ++once call %s" nested?
+                                   "autocmd %s %s ++nested call %s"
+                                   "autocmd %s %s call %s")
+                               events pattern (vlua fsym)))))
+        `(vim.cmd ,(format (if (and once? nested?)
+                               "autocmd %s %s ++once ++nested %s" once?
+                               "autocmd %s %s ++once %s" nested?
+                               "autocmd %s %s ++nested %s" "autocmd %s %s %s")
+                           events pattern command)))))
+
+{: au! : aub! : ac!}
diff --git a/fnl/nvrc/macro/keymap.fnl b/fnl/nvrc/macro/keymap.fnl
new file mode 100644
index 0000000..7a784ab
--- /dev/null
+++ b/fnl/nvrc/macro/keymap.fnl
@@ -0,0 +1,46 @@
+(local {: gmatch} string)
+(local {: insert} table)
+
+(local {: fn?} (require :nvrc.macro.toolkit))
+
+(fn ->str [x]
+  (tostring x))
+
+(fn nil? [x]
+  (= nil x))
+
+(fn str? [x]
+  (= :string (type x)))
+
+(fn tbl? [x]
+  (= :table (type x)))
+
+(lambda map! [[modes & options] lhs rhs ?desc]
+  "Defines a new mapping using the lua API.
+  Supports all the options that the API supports."
+  (assert-compile (sym? modes) "expected symbol for modes" modes)
+  (assert-compile (tbl? options) "expected table for options" options)
+  (assert-compile (str? lhs) "expected string for lhs" lhs)
+  (assert-compile (or (str? rhs) (list? rhs) (fn? rhs) (sym? rhs))
+                  "expected string or list or function or symbol for rhs" rhs)
+  (assert-compile (or (nil? ?desc) (str? ?desc))
+                  "expected string or nil for description" ?desc)
+  (let [modes (icollect [char (gmatch (->str modes) ".")]
+                char)
+        options (collect [_ v (ipairs options)]
+                  (->str v)
+                  true)
+        rhs (if (and (not (fn? rhs)) (list? rhs)) `#,rhs rhs)
+        desc (if (and (not ?desc) (or (fn? rhs) (sym? rhs))) (view rhs) ?desc)
+        options (if desc (doto options (tset :desc desc)) options)]
+    `(vim.keymap.set ,modes ,lhs ,rhs ,options)))
+
+(lambda mapb! [[modes & options] lhs rhs ?description]
+  "Defines a new mapping using the lua API.
+  Supports all the options that the API supports.
+  Automatically sets the `:buffer` option."
+  (let [options (doto options
+                  (insert :buffer))]
+    (map! [modes (unpack options)] lhs rhs ?description)))
+
+{: map! : mapb!}
diff --git a/fnl/nvrc/macro/misc.fnl b/fnl/nvrc/macro/misc.fnl
new file mode 100644
index 0000000..cde60ce
--- /dev/null
+++ b/fnl/nvrc/macro/misc.fnl
@@ -0,0 +1 @@
+{:disable-builtins! #(vim.tbl_map #(tset vim.g (.. :loaded_ $) 1) $)}
diff --git a/fnl/nvrc/macro/pack.fnl b/fnl/nvrc/macro/pack.fnl
new file mode 100644
index 0000000..5ba7896
--- /dev/null
+++ b/fnl/nvrc/macro/pack.fnl
@@ -0,0 +1,80 @@
+(fn str? [x]
+  (= :string (type x)))
+
+(fn nil? [x]
+  (= nil x))
+
+(fn tbl? [x]
+  (= :table (type x)))
+
+(local {: format} string)
+(local {: insert} table)
+
+(global nvrc/pack [])
+(global nvrc/rock [])
+
+(lambda pack [identifier ?options]
+  "Returns a mixed table with the identifier as the first sequential element
+  and options as hash-table items.
+  See https://github.com/wbthomason/packer.nvim for information about the
+  options."
+  (assert-compile (str? identifier) "expected string for identifier" identifier)
+  (assert-compile (or (nil? ?options) (tbl? ?options))
+                  "expected table for options" ?options)
+  (let [options (or ?options {})
+        options (collect [k v (pairs options)]
+                         (if
+                           (= k :req) (values :config (format "require('nvrc.packs.%s')" v))
+                           (= k :init) (values :config (format "require('%s').setup()" v))
+                           (= k :defer) (values :setup (format "require('nvrc.utils').defer_unpack('%s', 5)" v))
+                           (values k v)))]
+    (doto options
+          (tset 1 identifier))))
+
+(lambda pack! [identifier ?options]
+  "Declares a plugin with its options.
+  This is a mixed table saved on the global compile-time variable nvrc/pack.
+  See https://github.com/wbthomason/packer.nvim for information about the
+  options."
+  (assert-compile (str? identifier) "expected string for identifier" identifier)
+  (assert-compile (or (nil? ?options) (tbl? ?options))
+                  "expected table for options" ?options)
+  (insert nvrc/pack (pack identifier ?options)))
+
+(lambda rock [identifier ?options]
+  "Returns a mixed table with the identifier as the first sequential element
+  and options as hash-table items.
+  See https://github.com/wbthomason/packer.nvim for information about the
+  options."
+  (assert-compile (str? identifier) "expected string for identifier" identifier)
+  (assert-compile (or (nil? ?options) (tbl? ?options))
+                  "expected table for options" ?options)
+  (let [options (or ?options {})]
+    (doto options
+          (tset 1 identifier))))
+
+(lambda rock! [identifier ?options]
+  "Declares a plugin with its options.
+  This is a mixed table saved on the global compile-time variable nvrc/rock.
+  See https://github.com/wbthomason/packer.nvim for information about the
+  options."
+  (assert-compile (str? identifier) "expected string for identifier" identifier)
+  (assert-compile (or (nil? ?options) (tbl? ?options))
+                  "expected table for options" ?options)
+  (insert nvrc/rock (rock identifier ?options)))
+
+(lambda unpack! []
+  "Initializes the plugin manager with the previously declared plugins and
+  their options."
+  (let [packs (icollect [_ v (ipairs nvrc/pack)]
+                        `(use ,v))
+        rocks (icollect [_ v (ipairs nvrc/rock)]
+                        `(use_rocks ,v))]
+    `((. (require :packer) :startup) #(do
+         ,(unpack (icollect [_ v (ipairs packs) :into rocks] v))))))
+
+{: pack
+ : pack!
+ : rock
+ : rock!
+ : unpack!}
diff --git a/fnl/nvrc/macro/set.fnl b/fnl/nvrc/macro/set.fnl
new file mode 100644
index 0000000..144bdef
--- /dev/null
+++ b/fnl/nvrc/macro/set.fnl
@@ -0,0 +1,79 @@
+(local {: fn? : gensym-checksum : vlua} (require :nvrc.macro.toolkit))
+
+(fn str? [x]
+  (= :string (type x)))
+
+(fn ->str [x]
+  (tostring x))
+
+(fn nil? [x]
+  (= nil x))
+
+(fn includes? [xs x]
+  (accumulate [is? false _ v (ipairs xs) :until is?]
+    (= v x)))
+
+(lambda set! [name ?value]
+  "Set a vim option via the lua API.
+  The name of the option must a symbol.
+  If no value is specified, if the name begins with 'no' the value
+  becomes false, true otherwise."
+  (assert-compile (sym? name) "expected symbol for name" name)
+  (let [name (->str name)
+        value (or ?value (not (name:match "^no")))
+        name (or (name:match "^no(.+)$") name)]
+    (if (fn? value)
+      (let [vsym (gensym-checksum "__" value)]
+        `(do
+            (global ,vsym ,value)
+            (tset vim.opt ,name ,(vlua vsym))))
+      (match (name:sub -1)
+        "+" `(: (. vim.opt ,(name:sub 1 -2)) :append ,value)
+        "-" `(: (. vim.opt ,(name:sub 1 -2)) :remove ,value)
+        "^" `(: (. vim.opt ,(name:sub 1 -2)) :prepend ,value)
+        _ `(tset vim.opt ,name ,value)))))
+
+(lambda setl! [name ?value]
+  "Set a vim local option via the lua API.
+  The name of the option must a symbol.
+  If no value is specified, if the name begins with 'no' the value
+  becomes false, true otherwise."
+  (assert-compile (sym? name) "expected symbol for name" name)
+  (let [name (->str name)
+        value (or ?value
+                  (not (name:match "^no")))
+        name (or (name:match "^no(.+)$")
+                 name)]
+    (if (fn? value)
+      (let [fsym (gensym-checksum "__" value)]
+        `(do
+           (global ,fsym ,value)
+           (tset vim.opt_local ,name ,(vlua fsym))))
+      (match (name:sub -1)
+        :+ `(: (. vim.opt_local ,(name:sub 1 -2)) :append ,value)
+        :- `(: (. vim.opt_local ,(name:sub 1 -2)) :remove ,value)
+        :^ `(: (. vim.opt_local ,(name:sub 1 -2)) :prepend ,value)
+        _ `(tset vim.opt_local ,name ,value)))))
+
+(lambda setv! [name value]
+  "Set a vim variable via the lua API.
+  The name can be either a symbol or a string.
+  If the name begins with [gbwt] followed by [/:.], the name
+  is scoped to the respective scope."
+  (assert-compile (or (str? name) (sym? name))
+                  "expected string or symbol for name" name)
+  (let [name (->str name)
+        scope (when (includes? ["g/" "b/" "w/" "t/"
+                                "g." "b." "w." "t."
+                                "g:" "b:" "w:" "t:"] (name:sub 1 2))
+                (name:sub 1 1))
+        name (if
+               (nil? scope) name
+               (name:sub 3))]
+    `(tset ,(match scope
+              :b 'vim.b
+              :w 'vim.w
+              :t 'vim.t
+              _ 'vim.g) ,name ,value)))
+
+{: set! : setl! : setv!}
diff --git a/fnl/nvrc/macro/thread.fnl b/fnl/nvrc/macro/thread.fnl
new file mode 100644
index 0000000..9060b04
--- /dev/null
+++ b/fnl/nvrc/macro/thread.fnl
@@ -0,0 +1,15 @@
+(local {: insert} table)
+
+(lambda as-> [[binding expr] ...]
+  "A threading macro where the first argument is the value binded to the
+  second argument, which must be a symbol.
+  This binding is valid for the whole body of the threading macro."
+  (assert-compile (sym? binding) "expected symbol for binding" binding)
+  `(let [,binding ,expr
+         ,(unpack (accumulate [exprs [] _ expr (ipairs [...])]
+                    (doto exprs
+                      (insert binding)
+                      (insert expr))))]
+     ,binding))
+
+{: as->}
diff --git a/fnl/nvrc/macro/toolkit.fnl b/fnl/nvrc/macro/toolkit.fnl
new file mode 100644
index 0000000..8a2bc50
--- /dev/null
+++ b/fnl/nvrc/macro/toolkit.fnl
@@ -0,0 +1,39 @@
+(local {: format} string)
+
+(fn ->str [x]
+  (tostring x))
+
+(fn head [xs]
+  (. xs 1))
+
+(fn fn? [x]
+  "Returns whether the parameter(s) is a function.
+  A function is defined as any list with 'fn or 'hashfn as
+  their first element."
+  (and (list? x) (or (= `fn (head x)) (= `hashfn (head x)))))
+
+(lambda gensym-checksum [...]
+  "Generates a new symbol from the checksum of the object
+  passed as a parameter.
+  The parameter first is casted into a string using the
+  function `fennel.view`.
+  If only one parameter is passed to the function the return
+  value is the checksum as a symbol.
+  If two parameters are passed, the first one is considered
+  the prefix.
+  If three parameters are passed, the first one is considered
+  the prefix and the last one is considered the suffix.
+  This function depends on the md5 library and the fennel library."
+  (match [...]
+    [prefix object suffix] (let [{: view} (require :fennel)
+                                 {:sumhexa md5} (require :md5)]
+                              (sym (.. prefix (md5 (view object)) suffix)))
+    [prefix object] (gensym-checksum prefix object "")
+    [object] (gensym-checksum "" object "")))
+
+(lambda vlua [x]
+  "Return a symbol mapped to `v:lua.%s()`, where `%s` is the symbol."
+  (assert-compile (sym? x) "expected symbol for x" x)
+  (format "v:lua.%s()" (->str x)))
+
+{: fn? : gensym-checksum : vlua}
-- 
cgit 1.4.1