mirror of
https://github.com/roswell/roswell.git
synced 2026-09-10 07:16:17 -04:00
96 lines
3.6 KiB
Common Lisp
96 lines
3.6 KiB
Common Lisp
#!/bin/sh
|
|
#|-*- mode:lisp -*-|#
|
|
#|Indent lisp source.
|
|
exec ros -Q -N roswell -- $0 "$@"
|
|
|#
|
|
(progn ;;init forms
|
|
(ros:ensure-asdf)
|
|
#+sbcl (require "sb-introspect")
|
|
#+quicklisp (ql:quickload '("cl-indentify") :silent t))
|
|
|
|
(defpackage :ros.script.fmt.3707812168
|
|
(:use :cl))
|
|
(in-package :ros.script.fmt.3707812168)
|
|
|
|
(defun function-lambda-list (fn)
|
|
"Portably retrieve a function's lambda list."
|
|
(ignore-errors
|
|
#+sbcl
|
|
(funcall (find-symbol "FUNCTION-LAMBDA-LIST" "SB-INTROSPECT") fn)
|
|
#-sbcl nil))
|
|
|
|
(defun register-macro-templates ()
|
|
"Auto-detect macros with &body and register cl-indentify templates."
|
|
(do-all-symbols (sym)
|
|
(when (macro-function sym)
|
|
(let* ((arglist (function-lambda-list (macro-function sym)))
|
|
(body-pos (position '&body arglist)))
|
|
(when body-pos
|
|
(setf (indentify:indent-template sym)
|
|
`(:style :call :count ,body-pos)))))))
|
|
|
|
(defun system (path)
|
|
(let ((* (when (and (probe-file path)
|
|
(equal (pathname-type path) "asd"))
|
|
(asdf:load-asd path)
|
|
(pathname-name path))))
|
|
(labels ((r (c)
|
|
(typecase c
|
|
(asdf:system
|
|
(append
|
|
(directory (merge-pathnames "roswell/*.ros" (asdf:component-pathname c)))
|
|
(loop for child in (asdf:component-children c)
|
|
append (r child))))
|
|
(asdf:module
|
|
(loop for child in (asdf:component-children c)
|
|
append (r child)))
|
|
(asdf:cl-source-file
|
|
(list (asdf:component-pathname c)))
|
|
(t
|
|
(list c)))))
|
|
(when *
|
|
(ql:quickload * :silent (not (ros:verbose)))
|
|
(register-macro-templates)
|
|
(r (asdf:find-system *))))))
|
|
|
|
(defun register-standard-templates ()
|
|
"Override templates to match Lem/Emacs/SLIME indentation."
|
|
;; if: (&rest nil) in Lem - all args aligned with first arg
|
|
(setf (indentify:indent-template 'if) '(:count 3))
|
|
;; case/typecase: (4 &rest (&whole 2 &rest 1)) - clause body at paren+1
|
|
(dolist (sym '(case ccase ecase typecase ctypecase etypecase))
|
|
(setf (indentify:indent-template sym)
|
|
'(:count 1 :sub (nil nil (:style :list)))))
|
|
;; cond: (&rest (&whole 2 &rest 1)) - clause body at paren+1
|
|
(setf (indentify:indent-template 'cond)
|
|
'(:count 0 :sub (nil (:style :list)))))
|
|
|
|
(defun format-file (file)
|
|
(let ((result (with-output-to-string (out)
|
|
(with-open-file (in file)
|
|
(indentify:indentify in out)))))
|
|
(with-open-file (out file :direction :output :if-exists :supersede)
|
|
(with-input-from-string (in result)
|
|
(loop for line = (read-line in nil)
|
|
while line
|
|
do (write-string (string-right-trim '(#\Space #\Tab) line) out)
|
|
(terpri out))))))
|
|
|
|
(defun main (&rest argv)
|
|
"go fmt like something"
|
|
(indentify:load-default-templates)
|
|
(register-standard-templates)
|
|
(dolist (arg (if argv
|
|
(loop for arg in argv
|
|
append (or (system arg) (list arg)))
|
|
(ignore-errors
|
|
(let* ((name (first (last (pathname-directory *default-pathname-defaults*))))
|
|
(path (probe-file (make-pathname :name name :type "asd"))))
|
|
(or (and path (system path))
|
|
(append (directory "*.lisp")
|
|
(directory "*.ros")))))))
|
|
(if (probe-file arg)
|
|
(format-file arg)
|
|
(format *error-output* "~A does not exist" arg))))
|
|
;;; vim: set ft=lisp lisp:
|