Templates

extensions/template/README.md

@@ -0,0 +1,52 @@
+# lem-template
+
+A templating extension to generate boilerplate in new files.
+
+# Usage
+
+Here is an example template file that generates a simple `.asd` to help get you started.
+
+```
+(asdf:defsystem "<%= (pathname-name (@ path)) %>"
+  :author ""
+  :license "MIT"
+  :depends-on ()
+  :components ((:module "src"
+                :components ((:file "core")))))
+```
+
+Assuming this file exists in `~/.config/lem/templates/asd.clt`, you can register it like this:
+
+```lisp
+(lem-template:register-template
+ :pattern ".*\.asd"
+ :file (merge-pathnames "templates/asd.clt" (lem-home)))
+```
+
+If you provide multiple templates for the same pattern, with the `:name` option (examples below), you will be prompted to choose a template.
+
+You can create any kind of template you want in the [cl-template](https://github.com/alpha123/cl-template) format, `buffer` and `path` are passed to the template and you can read it with `(@ buffer)`, `(@ path)` etc.
+
+Templating can be disabled if you put this in your config:
+
+```lisp
+(setf lem-template:*auto-template* nil)
+```
+
+# Examples
+
+See [my templates](https://github.com/garlic0x1/.lem/tree/master/templates) for more examples, I used the plural `register-templates` to register them like this:
+
+```lisp
+(lem-template:register-templates
+  (:pattern ".*\.asd"
+   :name "Basic ASD"
+   :file (merge-pathnames "templates/asd.clt" (lem-home)))
+  (:pattern ".*\.asd"
+   :name "Test ASD"
+   :file (merge-pathnames "templates/test.asd.clt" (lem-home)))
+  (:pattern ".*\.lisp"
+   :file (merge-pathnames "templates/lisp.clt" (lem-home))))
+```
+
+When you create a new `.asd` file, you will be prompted to choose `Test ASD` or `Basic ASD`.  When you create a new `.lisp` file, it will automatically insert the single template.

extensions/template/lem-template.asd

@@ -0,0 +1,11 @@
+(asdf:defsystem "lem-template"
+  :author "garlic0x1"
+  :license "MIT"
+  :description "A system for snippets and new file templates."
+  :depends-on (:cl-template)
+  :components ((:file "utils")
+               (:file "render")
+               (:file "prompt")
+               (:file "template")
+               (:file "snippet")
+               (:file "package")))

extensions/template/package.lisp

@@ -0,0 +1,5 @@
+(uiop:define-package #:lem-template
+  (:use :cl :lem)
+  (:use-reexport #:lem-template/render)
+  (:use-reexport #:lem-template/template)
+  (:use-reexport #:lem-template/snippet))

extensions/template/prompt.lisp

@@ -0,0 +1,18 @@
+(defpackage #:lem-template/prompt
+  (:use :cl :lem)
+  (:import-from #:alexandria-2 #:hash-table-keys #:rcurry)
+  (:export #:prompt-hash-table))
+(in-package :lem-template/prompt)
+
+(defun prompt-hash-table (prompt table &key with-none-option)
+  "Prompt the keys of a hash-table, return the corresponding value."
+  (gethash
+   (prompt-for-string
+    prompt
+    :completion-function
+    (rcurry #'completion
+            (if with-none-option
+                (cons "none" (hash-table-keys table))
+                (hash-table-keys table))
+            :test #'lem-core::fuzzy-match-p))
+   table))

extensions/template/render.lisp

@@ -0,0 +1,15 @@
+(defpackage #:lem-template/render
+  (:use :cl :lem)
+  (:export #:render-file #:render-string))
+(in-package :lem-template/render)
+
+(defun render-string (string &optional args)
+  "Render a cl-template string to a string."
+  (funcall (cl-template:compile-template string) args))
+
+(defun render-file (template-file &optional args)
+  "Render a cl-template file to a string."
+  (funcall
+   (cl-template:compile-template
+    (uiop:read-file-string template-file))
+   args))

extensions/template/snippet.lisp

@@ -0,0 +1,52 @@
+(defpackage #:lem-template/snippet
+  (:use :cl :lem)
+  (:import-from #:lem-template/render
+                #:render-string)
+  (:import-from #:lem-template/prompt
+                #:prompt-hash-table)
+  (:import-from #:alexandria-2
+                #:if-let)
+  (:export #:*format-after-snippet*
+           #:register-snippet
+           #:register-snippets
+           #:insert-snippet))
+(in-package :lem-template/snippet)
+
+(defvar *format-after-snippet* t
+  "When enabled, formats buffer after inserting snippet.")
+
+(defvar *mode-snippets* (make-hash-table)
+  "Table mapping mode to another table of named snippets.")
+
+(defun register-snippet (&key mode name file string)
+  "Register a snippet used in mode."
+  (if-let ((snips (gethash mode *mode-snippets*)))
+    (if file
+        (setf (gethash name snips) (uiop:read-file-string file))
+        (setf (gethash name snips) string))
+    (progn (setf (gethash mode *mode-snippets*) (make-hash-table :test #'equal))
+           (register-snippet :mode mode :name name :file file :string string))))
+
+(defmacro register-snippets (&body snippets)
+  "Register multiple templates with `register-template`."
+  `(progn ,@(mapcar (lambda (it) `(register-snippet ,@it)) snippets)))
+
+(define-command insert-snippet () ()
+  "Select a snippet to insert at point."
+  (let* ((buffer (current-buffer))
+         (point (current-point))
+         (mode (buffer-major-mode buffer)))
+    (if-let ((snips (gethash mode *mode-snippets*)))
+      (progn
+        ;; insert the snippet
+        (insert-string point (render-string
+                              (prompt-hash-table "Snippet: " snips)
+                              `(:buffer ,buffer
+                                :path ,(buffer-filename buffer))))
+        ;; format the new snippet
+        (when *format-after-snippet*
+          (write-to-file-without-write-hook buffer (buffer-filename buffer))
+          (lem:format-buffer :buffer buffer :auto t))
+        ;; alert the user
+        (message "Snippet inserted."))
+      (message "No snippets for mode ~a" mode))))

extensions/template/template.lisp

@@ -0,0 +1,70 @@
+(defpackage #:lem-template/template
+  (:use :cl :lem)
+  (:import-from #:lem-template/render
+                #:render-file)
+  (:import-from #:lem-template/prompt
+                #:prompt-hash-table)
+  (:import-from #:lem-template/utils
+                #:new-file-p
+                #:hash-table-first)
+  (:import-from #:alexandria-2
+                #:when-let
+                #:rcurry
+                #:if-let)
+  (:export #:*auto-template*
+           #:register-template
+           #:register-templates
+           #:insert-template))
+(in-package :lem-template/template)
+
+(defvar *tmpl-patterns* nil
+  "List of registered file patterns.")
+
+(defparameter *auto-template* t
+  "Enable automatically populating new files with templates.")
+
+(defstruct tmpl-pattern
+  pattern
+  templates)
+
+(defun register-template (&key pattern file (name "default"))
+  "Register a template used for filenames matching pattern."
+  (if-let ((p (find-if (lambda (it) (equal pattern (tmpl-pattern-pattern it))) *tmpl-patterns*)))
+    (setf (gethash name (tmpl-pattern-templates p)) file)
+    (progn (push (make-tmpl-pattern :pattern pattern
+                                    :templates (make-hash-table :test #'equal))
+                 *tmpl-patterns*)
+           (register-template :pattern pattern :file file :name name))))
+
+(defmacro register-templates (&body templates)
+  "Register multiple templates with `register-template`."
+  `(progn ,@(mapcar (lambda (it) `(register-template ,@it)) templates)))
+
+(defun template-match-p (template filename)
+  "Template pattern matches filename."
+  (cl-ppcre:scan (tmpl-pattern-pattern template) filename))
+
+(defun find-match (buffer-filename)
+  "Find template where pattern matches filename."
+  (when-let ((p (find-if (rcurry #'template-match-p buffer-filename) *tmpl-patterns*)))
+    (let ((tmpls (tmpl-pattern-templates p)))
+      (if (= 1 (hash-table-count tmpls))
+          (hash-table-first tmpls)
+          (prompt-hash-table "Template: " tmpls :with-none-option t)))))
+
+(defun insert-template (buffer)
+  "Insert registered template into buffer."
+  (when-let (file (find-match (buffer-filename buffer)))
+    (handler-case
+        (insert-string
+         (buffer-start-point buffer)
+         (render-file file `(:buffer ,buffer
+                             :path ,(buffer-filename buffer))))
+      (error (c)
+        (message "Render error: ~a" c)
+        (message "Failed to render template: ~a" file)))))
+
+(add-hook *find-file-hook*
+          (lambda (buffer)
+            (when (and *auto-template* (new-file-p buffer) (buffer-empty-p buffer))
+              (insert-template buffer))))

extensions/template/utils.lisp

@@ -0,0 +1,13 @@
+(defpackage #:lem-template/utils
+  (:use :cl :lem)
+  (:import-from #:alexandria-2 #:hash-table-keys)
+  (:export #:new-file-p #:hash-table-first))
+(in-package :lem-template/utils)
+
+(defun new-file-p (buffer)
+  "Buffer is a new file, and does not already exist on disk."
+  (not (uiop:file-exists-p (buffer-filename buffer))))
+
+(defun hash-table-first (table)
+  "Get one item out of a hash-table."
+  (gethash (car (hash-table-keys table)) table))

lem.asd

@@ -205,6 +205,7 @@
 
 (defsystem "lem/extensions"
   :depends-on (#+sbcl
+               "lem-template"
                "lem-welcome"
                "lem-lsp-mode"
                "lem-vi-mode"

qlfile

@@ -8,3 +8,4 @@ git cl-sdl2 https://github.com/lem-project/cl-sdl2.git
 git cl-sdl2-ttf https://github.com/lem-project/cl-sdl2-ttf.git
 git cl-sdl2-image https://github.com/lem-project/cl-sdl2-image.git
 git jsonrpc https://github.com/cxxxr/jsonrpc.git
+git cl-template https://github.com/alpha123/cl-template

qlfile.lock

@@ -42,3 +42,7 @@
  (:class qlot/source/git:source-git
   :initargs (:remote-url "https://github.com/cxxxr/jsonrpc.git")
   :version "git-28c4c962cfe936c7cd00dcab3bcae47b6f9de071"))
+("cl-template" .
+ (:class qlot/source/git:source-git
+  :initargs (:remote-url "https://github.com/alpha123/cl-template")
+  :version "git-46193a9a389bb950530e579eae7e6e5a18184832"))

src/buffer/internal/buffer.lisp

@@ -405,3 +405,8 @@ Options that can be specified by arguments are ignored if `temporary` is NIL and
 (defun clear-buffer-edit-history (buffer)
   (setf (buffer-edit-history buffer)
         (make-array 0 :adjustable t :fill-pointer 0)))
+
+(defun buffer-empty-p (buffer)
+  "If start and end points are equal, buffer is empty."
+  (point= (buffer-start-point buffer)
+          (buffer-end-point buffer)))

src/buffer/package.lisp

@@ -80,7 +80,8 @@
    :clear-buffer-edit-history
    ;; TODO: delete ugly exports
    :%buffer-clear-keep-binfo
-   :%buffer-keep-binfo)
+   :%buffer-keep-binfo
+   :buffer-empty-p)
   (:export
    :buffer-list
    :any-modified-buffer-p
@@ -301,7 +302,7 @@
   (:use :cl
         :lem/buffer/internal
         :lem/buffer/encodings
-	:lem/common/hooks
+        :lem/common/hooks
         :lem/common/var)
   (:export
    :*find-file-hook*

src/config.lisp

@@ -2,10 +2,10 @@
 
 (defun lem-home ()
   (let ((xdg-lem (uiop:xdg-config-home "lem/"))
-	(dot-lem (merge-pathnames ".lem/" (user-homedir-pathname))))
+        (dot-lem (merge-pathnames ".lem/" (user-homedir-pathname))))
     (or (uiop:getenv "LEM_HOME")
-	(and (probe-file dot-lem) dot-lem)
-	xdg-lem)))
+        (and (probe-file dot-lem) dot-lem)
+        xdg-lem)))
 
 (defun lem-logdir-pathname ()
   (merge-pathnames "logs/" (lem-home)))