diff options
Diffstat (limited to 'src/property.lisp')
| -rw-r--r-- | src/property.lisp | 57 |
1 files changed, 56 insertions, 1 deletions
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 |