;;; lisp-skeletons.el --- Skeletons for generating Common Lisp code       -*- lexical-binding: t; tab-width: 8; -*-

 
 ;; Copyright (C) 2017 Edward Langley
 
 ;; Author: Edward Langley <fwoar@elangley.org>
 ;; Keywords: lisp
 ;; Version: 0.0.1
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or
 ;; (at your option) any later version.
 
 ;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;; Put a description of the package here
 
 ;;; Code:
 
 ;; code goes here
 (require 'skeleton)
 (require 'evil)
 
 (defvar *skeleton-markers* nil
   "Markers for locations saved in skeleton-positions.")
 
 (defun skeleton-make-markers ()
   "..."
   (while *skeleton-markers*
     (set-marker (pop *skeleton-markers*) nil))
   (setq *skeleton-markers*
         (mapcar 'copy-marker (reverse skeleton-positions))))
 
 (defun skeleton-next-position (&optional reverse)
   "Jump to next position in skeleton.
 REVERSE - Jump to previous position in skeleton"
   (interactive "P")
 
   (let* ((positions (mapcar 'marker-position *skeleton-markers*))
          (positions (if reverse (reverse positions) positions))
          (comp (if reverse '> '<))
          pos)
     (when positions
       (if (catch 'break
             (while (setq pos (pop positions))
               (when (funcall comp (point) pos)
                 (throw 'break t))))
           (goto-char pos)
         (goto-char (marker-position
                     (car *skeleton-markers*))))))
   (when (fboundp 'evil-insert)
     (evil-insert 1)))
 

 (defun skeleton-prev-position ()
       (interactive "P")
       (skeleton-next-position t))
 

 (define-skeleton skel-defun
   "Insert a defun template."
   "Name: "
   "(defun " str " (" @ - ")" \n
   @ _ ")"  \n
   '(when (fboundp 'evil-insert)
      (evil-insert 1)))
 
 (define-skeleton skel-defmacro
   "Insert a defmacro template."
   "Name: "
   "(defmacro " str " (" @ - ")" \n
   @ _ ")"  \n
   '(evil-insert 1))
 
 (define-skeleton skel-defparameter
   "Insert a defmacro template."
   "Name: "
   "(defparameter " str @ _ ")"  \n
   '(evil-insert 1))
 
 (define-skeleton skel-defvar
   "Insert a defmacro template."
   "Name: "
   "(defvar " str @ _ ")"  \n
   '(evil-insert 1))
 

 (defvar fwoar::*package-prefix* "fwoar"
   "A prefix applied to lisp packages")
 

 (define-skeleton skel-defpackage
   "Insert a defpackage template"
   (skeleton-read "Package Name: "
                  (if v1

                      (format "%s.%s"
                              fwoar::*package-prefix*

                              (file-name-sans-extension
                               (file-name-nondirectory
                                (buffer-file-name))))))

   '(setq v1 (bobp))
   "(defpackage :" @ str "
   (:use :cl "  _ @ - ")
   (:export " @  "))

 (in-package :" str ")" \n

   @)

 (define-skeleton skel-defsystem
   "Insert a defsystem template"
   (skeleton-read "System Name: " (if v1
                                      (file-name-sans-extension
                                       (file-name-nondirectory
                                        (buffer-file-name)))))
   & (if (setq v1 (bobp))
         ";;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-")
   & \n
   & "(in-package :asdf-user)"
   & \n
   & \n
   "(defsystem :" @ str " 
   :description \"\"
   :author \"Ed L <edward@elangley.org>\"
   :license \"MIT\"
   :depends-on (#:alexandria
                #:uiop
                #:serapeum
                " @ - ")
   :serial t
   :components (" @ "
   " _ "))"
   '(save-excursion
      (indent-region (point-min) (point-max) nil)))

 (provide 'lisp-skeletons)