From 3b4891ce80580f8f43f3d64ab54c1d9ae66976db Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 9 Mar 2021 09:36:20 -0700 Subject: store and export some indentation information for Emacs Signed-off-by: Sean Whitton --- emacs/put-forms.el | 13 ++++++++++++ src/package.lisp | 4 +++- src/property.lisp | 57 +++++++++++++++++++++++++++++++++++++++++++++++++- src/property/file.lisp | 1 + 4 files changed, 73 insertions(+), 2 deletions(-) create mode 100644 emacs/put-forms.el diff --git a/emacs/put-forms.el b/emacs/put-forms.el new file mode 100644 index 0000000..91273bb --- /dev/null +++ b/emacs/put-forms.el @@ -0,0 +1,13 @@ +;; automatically generated by +;; CONSFIGURATOR::DUMP-PROPERTIES-FOR-EMACS; do not edit + +(put 'consfigurator:deploys. 'common-lisp-indent-function '2) +(put 'consfigurator:deploys-these. 'common-lisp-indent-function '2) +(put 'file:has-content 'common-lisp-indent-function '1) +(put 'file:has-content. 'common-lisp-indent-function '1) +(put 'file:contains-lines. 'common-lisp-indent-function '1) +(put 'file:data-uploaded. 'common-lisp-indent-function '2) +(put 'file:secret-uploaded. 'common-lisp-indent-function '2) +(put 'file:regex-replaced-lines. 'common-lisp-indent-function '2) +(put 'os:debian-stable. 'common-lisp-indent-function '1) +(put 'chroot:%os-bootstrapped. 'common-lisp-indent-function '2) diff --git a/src/package.lisp b/src/package.lisp index 8ad4c4e..4206f33 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -22,7 +22,8 @@ #:getenv #:subdirectories #:directory-files - #:file-exists-p) + #:file-exists-p + #:with-current-directory) (:export ;; re-export from UIOP #:strcat #:string-prefix-p @@ -43,6 +44,7 @@ #:subdirectories #:directory-files #:file-exists-p + #:with-current-directory ;; util.lisp #:lines diff --git a/src/property.lisp b/src/property.lisp index 2af68c4..f6910e1 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -26,7 +26,7 @@ ;; make it a bit more difficult for someone who hasn't read that part of the ;; docs to accidentally violate immutability. -(defun setprop (sym type &key args desc preprocess hostattrs check apply unapply) +(defun setprop (sym type &key args desc preprocess hostattrs check apply unapply indent) ;; use non-keyword keys to avoid clashes with other packages (when type (setf (get sym 'type) type)) @@ -54,6 +54,7 @@ :no-change))) (when unapply (setf (get sym 'unapply) unapply)) + (store-indentation-info-for-emacs sym args indent) (setf (get sym 'property) t) sym) @@ -102,6 +103,49 @@ (defun propappunapply (propapp) (apply #'propunapply propapp)) +(defvar *properties-for-emacs* nil + "List of properties whose symbols have Emacs indentation information.") + +(defun dump-properties-for-emacs (dir) + (with-current-directory (dir) + (with-open-file (s "emacs/put-forms.el" + :direction :output :if-exists :supersede) + (format s ";; automatically generated by~%") + (format s ";; CONSFIGURATOR::DUMP-PROPERTIES-FOR-EMACS; do not edit~%~%") + (loop for (prop . indent) in (nreverse + (mappend (lambda (s) (get s 'indent)) + *properties-for-emacs*)) + do (format s "(put '~A 'common-lisp-indent-function '~A)~%" + prop indent))) + (run-program '("git" "add" "emacs/put-forms.el")))) + +(defun store-indentation-info-for-emacs (sym args &optional info) + (let* ((short-name + (string-downcase + (strcat + (lastcar (split-string (package-name *package*) :separator ".")) + ":" + (symbol-name sym)))) + (dotted-name (strcat short-name ".")) + indent) + (cond + (info + (push (cons short-name info) indent) + (push (cons dotted-name info) indent)) + ((not (find '&key args)) + (let ((n (1- (loop with n = 0 + for arg in args + if (member arg '(&rest &body &aux)) + return (1+ n) + unless (eq arg '&optional) + do (incf n) + finally (return n))))) + (when (plusp n) + (push (cons dotted-name n) indent))))) + (when indent + (setf (get sym 'indent) indent) + (pushnew sym *properties-for-emacs*)))) + ;;; supported way to write properties is to use one of these two macros (defmacro defprop (name type args &body forms) @@ -109,6 +153,12 @@ ;; if first element of forms is a plain string, consider it a docstring, ;; and ignore (when (stringp (car forms)) (pop forms)) + ;; now extract any DECLARE form + (when (and (listp (car forms)) + (eql 'declare (caar forms))) + ;; currently INDENT is the only supported declaration so we can just + ;; take the cadadr + (setf (getf slots :indent) (cadadr (pop forms)))) (loop for form in forms if (keywordp (car form)) do (setf (getf slots (car form)) (cdr form))) @@ -156,6 +206,11 @@ subroutines at the right time." :apply '(lambda (propspec &rest ignore) (declare (ignore ignore)) (eval-propspec propspec))))) + (when (and (listp (car properties)) + (eql 'declare (caar properties))) + ;; currently INDENT is the only supported declaration so we can just + ;; take the cadadr + (setf (getf slots :indent) (cadadr (pop properties)))) (when (and (listp (car properties)) (eq :desc (caar properties))) (setf (getf slots :desc) `(lambda ,new-args diff --git a/src/property/file.lisp b/src/property/file.lisp index cce1f1b..f536c79 100644 --- a/src/property/file.lisp +++ b/src/property/file.lisp @@ -31,6 +31,7 @@ point in doing that here because WRITEFILE is synchronous." (defprop has-content :posix (path content) "Ensure there is a file at PATH whose content is CONTENT. CONTENT can be a list of lines or a single string." + (declare (indent 1)) (:apply (writefile path (if (listp content) (unlines content) content)))) (defprop contains-lines :posix (path lines) -- cgit v1.2.3