store and export some indentation information for Emacs

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

4 files changed, 73 insertions, 2 deletions

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)