changeset 677: |
585f14458a65 |
parent: |
ca09f470abb3
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Tue, 24 Sep 2024 22:19:05 -0400 |
permissions: |
-rw-r--r-- |
description: |
tweaks |
1 ;;; sk.el --- skel Emacs Mode -*- lexical-binding:t -*- 3 ;; skel-mode, skel-minor-mode,skt-minor-mode, sk-classes 5 ;; Copyright (C) 2023 The Compiler Company 7 ;; Author: ellis <ellis@rwest.io> 8 ;; Keywords: languages, lisp 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 28 (eval-and-compile (require 'eieio) 30 (require 'sxp (expand-file-name "sxp.el" (join-paths user-emacs-directory "lib/"))) 36 (defvar skel-debug nil) 37 (when skel-debug (require 'ede))) 39 (defvar skel-version "0.1.0") 42 "skel customization group." 45 (defcustom skel-minor-mode-map-prefix "C-c C-." 46 "Prefix for `skel-minor-mode' keymap." 50 (defcustom skel-triggers nil 51 "Association of symbols to a specific condition which can be used 52 to trigger `skel-actions' based on the `skel-behavior' value." 53 :type '(list function) 56 (defcustom skel-actions nil 57 "Array of actions which may be performed on skeletons." 61 (defcustom skel-id-prefix "sk" 62 "Default prefix for `make-id'." 66 (defvar-keymap skel-minor-mode-map 67 :doc "skel-minor-mode keymap." 69 :prefix 'skel-minor-mode-map) 71 (define-minor-mode skel-minor-mode 76 :keymap skel-minor-mode-map 77 :version skel-version) 80 (define-derived-mode skel-mode lisp-mode "SKEL" 84 (org-babel-make-language-alias "skel" "lisp") 86 (defun maybe-skel-minor-mode () 87 "Check the current environment and determine if `skel-minor-mode' should 88 be enabled. This function is added as a hook to 89 `lisp-data-mode-hook'.") 91 (defvar skel-hashtable (make-hash-table :test #'equal) 92 "Internal table of available skeletons.") 94 (defvar skel-stack nil "Internal stack of skeletons.") 96 (defcustom skel-state 'passive 97 "State toggle for the `skel' system. Base states are passive and 102 (defvar skel-active-map nil 103 "List of cons cells of the form (SYM . BODY...) where SYM is a member of 106 (defvar skel-passive-map nil 107 "list of cons cells of the form (SYM . BODY...) where SYM is a member of 110 (defmacro make-id (&optional pre) 111 `(let ((pre ,(if-let (pre) (concat skel-id-prefix "-" pre "-") (concat skel-id-prefix "-"))) 112 (current-time-list nil)) 113 (symb pre (prog1 gensym-counter (setq gensym-counter (1+ gensym-counter))) (format "%x" (car (current-time)))))) 115 (defmacro defcmd (name &rest body) `(defun ,name nil (interactive) ,@body)) 118 ((id :initarg :id :initform (make-id))) 119 :documentation "Base class for skeleton objects. Inherits from `sxp'." 122 (defcmd sk-classes (eieio-class-children 'sk)) 124 (defmacro def-sk-class (name doc &optional slots superclasses) 125 "Define a new class with superclass of `skel'+SUPERCLASSES, SLOTS, 128 `(defclass ,(symb "sk-" name) 129 ,(if superclasses `(sk ,@superclasses) '(sk)) 132 (:id :initarg :id :initform (make-id ,(symbol-name name)) :accessor id)) 133 `((:id :initarg :id :initform (make-id ,(symbol-name name)) :accessor id))) 134 :documentation ,doc)) 136 (def-sk-class target "Target skeleton class.") 137 (def-sk-class source "Source skeleton class.") 139 "Config skeleton class." 140 ((target :initarg :target :initform nil :type (or null sk-target)) 141 (rules :initarg :source :initform nil :type (or null sk-source)))) 143 (def-sk-class project 144 "Project skeleton class." 145 ((type :initarg :type :initform nil :accessor sk-project-type :type (or null symbol)) 146 (rules :initarg :rules :initform nil :accessor sk-project-rules :type list))) 149 "Initialize the skel library." 151 (add-to-list 'auto-mode-alist '("skelfile" . skel-mode)) 152 (add-to-list 'auto-mode-alist '("\\.sk" . skel-mode))) 154 (defun project-skelfile-path (&optional project) 155 "Find skelfile associated with PROJECT. Defaults to current 156 directory and returns name of skelfile. When PROJECT is T uses 158 (let* ((dir (unless (eql t project) (expand-file-name (or project default-directory)))) 159 (project-root (project-root (project-current nil dir)))) 165 (rx (or "skelfile" (and (* any) ".sk"))) 166 (file-name-nondirectory x)) 168 (directory-files dir t))) 170 (cl-find-if (lambda (x) 171 (when (string-match (rx (or "skelfile" (and (* any) ".sk"))) 172 (file-name-nondirectory x)) 174 (directory-files project-root t)))))) 176 (defun read-skelfile-bind (&optional project) 177 (let ((buffer (find-file-noselect (project-skelfile-path project)))) 178 (with-current-buffer buffer 179 (goto-char (point-min)) 180 (goto-char (search-forward-regexp (rx bol ":bind" (* space)))) 183 (defun project-skelfile-dir-locals (&optional project) 184 "Return a list of dir-local bindings from a skelfile." 185 (let ((form (read-skelfile-bind project))) 186 (cl-loop for f in form 188 ((eql (car f) :dir-locals) (cl-return (cdr f))) 189 ;; when used as second element, the first is the name 190 ;; of the CL-local binding, here we discard it and 191 ;; just take the CDDR. 192 ((eql (cadr f) :dir-locals) (cl-return (cddr f))))))) 194 (defun skel-dir-local--get-variables () 195 "Compute and return the list of :DIR-LOCAL bindings found in the current 196 project's skelfile, if any. Typically added to 197 `hack-dir-local--get-variables'." 198 (let ((root (project-root (project-current)))) 199 (cons (expand-file-name root) (project-skelfile-dir-locals root)))) 201 (defun skel-dir-local-get-variables () 202 (let ((root (expand-file-name (project-root (project-current))))) 203 (unless (assoc-string root dir-locals-class-alist) 204 (push (skel-dir-local--get-variables) dir-locals-class-alist)))) 206 ;; (add-hook 'skel-minor-mode-hook '%skel-dir-local--get-variables)