Created
September 21, 2023 21:00
-
-
Save rpgoldman/44a7b4e0645d9dafae699eb770553e3f to your computer and use it in GitHub Desktop.
Revisions
-
rpgoldman created this gist
Sep 21, 2023 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,227 @@ ;;; -*- Mode: emacs-lisp; -*- ;; templates are handy.... (require 'tempo) (tempo-define-template "read-only-slot" (list '(p "Slot name? " slot-name 'noinsert) "(" '(s slot-name) 'n> ":initarg :" '(s slot-name) 'n> ":reader " '(s slot-name) 'n> ")" )) (tempo-define-template "read-write-slot" (list '(p "Slot name? " slot-name 'noinsert) "(" '(s slot-name) 'n> ":initarg :" '(s slot-name) 'n> ":accessor " '(s slot-name) 'n> ")" )) (tempo-define-template "defclass" (list '(p "Class name? " class-name 'noinsert) '(p "Superclasses? " superclass-list 'noinsert) "(defclass " '(s class-name) " (" '(s superclass-list) ")" 'n> "()" 'n> ;; slots ")" 'n> )) (tempo-define-template "defun" (list '(p "function name? " fun-name 'noinsert) '(p "arguments? " arg-list 'noinsert) "(defun " '(s fun-name) " (" '(s arg-list) ")" 'n> 'p ")" 'n> '(prog1 nil (tempo-backward-mark)) )) (tempo-define-template "define-condition" (list '(p "Condition name? " class-name 'noinsert) '(p "Superclasses? " superclass-list 'noinsert) "(define-condition " '(s class-name) " (" '(s superclass-list) ")" 'n> "()" 'n> ;; slots ")" 'n> )) (tempo-define-template "defgeneric" (list "(defgeneric " '(p "function name? ") " (" '(p "arguments? ") ")" 'n> '(p "doc string?" docstring noinsert) '(unless (equal (tempo-lookup-named 'docstring) "") (list 'l "(:documentation \"" '(s docstring) "\")" 'n>)) ")" 'n> )) (tempo-define-template "defgeneric-method" (list "(:method " '(p "Qualifier? ") " (" '(p "arguments? ") ")" 'n> ")" 'n>)) (tempo-define-template "defmethod" (list "(defmethod " '(p "function name? ") " (" '(p "arguments? ") ")" 'n> '(p "doc string?" docstring noinsert) '(unless (equal (tempo-lookup-named 'docstring) "") (list 'l "\"" '(s docstring) "\"" 'n>)) ")" 'n> )) (tempo-define-template "defstruct" (list "(defstruct " '(p "structure name? ") " (" '(p "arguments? ") ")" 'n> "\"" '(p "doc string?") "\"" 'n> ")" 'n> )) (tempo-define-template "documentation" (list '(p "doc string?" docstr 'noinsert) "(:documentation \"" '(s docstr) "\")" )) (tempo-define-template "defvar" (list "(defvar " '(p "variable name? ") 'n> '(p "initial value? ") 'n> "\"" '(p "doc string?" ) "\")" 'n> )) (tempo-define-template "defpackage" (list "(defpackage " '(p "package name? ") 'n> '(p "uses package (list or single package)? " uses noinsert) '(let ((uses (first (read-from-string (tempo-lookup-named 'uses))))) (cond ((null uses) nil) ((listp uses) `(l "(:use" ,@(loop for x in uses collect " " collect (symbol-name x)) ")")) (t `(l "(:use " (s uses) ")")))) ;; nicknames would be a nice addition... ")" 'n> )) (tempo-define-template "asdf-prefix" (list "(defpackage " ":" '(p "system name? " name) "-asd" 'n> "(:use :common-lisp :asdf)" 'n> ")" 'n> "(in-package " ":" '(s name) "-asd" ")" 'n> "(defsystem " '(s name) 'n> ":depends-on ()" 'n> ":components ()" 'n> ")" )) (tempo-define-template "defstruct" (list '(p "Struct type name? " class-name 'noinsert) "(defstruct " '(s class-name) 'n> 'n>;; slots ")" 'n> )) (tempo-define-template "in-package" (list '(p "Package name? " pkg-name 'noinsert) "(in-package #:" '(s pkg-name) ")" )) (tempo-define-template "function-declaration" (list "(declaim" 'n> "(ftype" 'n> "(function " '(p "function name? " fname t) "(" '(p "argument types? ") ")" 'n> "(values " '(p "return values? ") " &optional))" 'n> '(s fname) "))" '> )) (defun make-cl-tempo-map (map &optional map-key) (unless map-key (setf map-key (kbd "C-c C-c"))) (let ((tempo-map (make-sparse-keymap "lisp-tempo-map"))) (define-key map map-key tempo-map) (cl-template-populate-tempo-map tempo-map))) (defun cl-template-populate-tempo-map (tempo-map) (define-key tempo-map "r" 'tempo-template-read-only-slot) (define-key tempo-map "w" 'tempo-template-read-write-slot) (let ((defgeneric-submap (make-sparse-keymap "lisp-defgeneric-tempo-map"))) (define-key tempo-map "g" defgeneric-submap) (define-key defgeneric-submap "g" 'tempo-template-defgeneric) (define-key defgeneric-submap "m" 'tempo-template-defgeneric-method) (define-key defgeneric-submap "d" 'tempo-template-documentation)) (define-key tempo-map "c" 'tempo-template-defclass) (define-key tempo-map "C" 'tempo-template-define-condition) (define-key tempo-map "p" 'tempo-template-defpackage) (define-key tempo-map "d" 'tempo-template-documentation) (define-key tempo-map "m" 'tempo-template-defmethod) (define-key tempo-map "v" 'tempo-template-defvar) (define-key tempo-map "a" 'tempo-template-asdf-prefix) (define-key tempo-map "s" 'tempo-template-defstruct) (define-key tempo-map "f" 'tempo-template-defun) (define-key tempo-map "i" 'tempo-template-in-package) ) (defun cl-template-populate-tempo-menu (parent-keymap) "Add a submenu to the PARENT-KEYMAP for CL templates." (easy-menu-define sly-cl-template-menu parent-keymap "Menu of Common Lisp Templates" '("CL Templates" ("Defclass helpers" [ "New DEFCLASS " tempo-template-defclass] ["Add read-only slot" tempo-template-read-only-slot] ["Add read-write slot" tempo-template-read-write-slot] ["Add docstring" tempo-template-documentation] ) ("Defgeneric helpers" [ "New DEFGENERIC " tempo-template-defgeneric] [ "Internal method definition" tempo-template-defgeneric-method] ["Add docstring" tempo-template-documentation] ) ("Other Top level constructs" ["Define condition" tempo-template-define-condition] ["Define method" tempo-template-defmethod] ["Define variable" tempo-template-defvar] ["Define function" tempo-template-defun] ["Define structure" tempo-template-defstruct] ) ("Misc" ["ASDF file header" tempo-template-asdf-prefix] ["IN-PACKAGE" tempo-template-in-package])))) (provide 'cl-templates)