diff options
Diffstat (limited to 'vim/bundle/slimv/slime/contrib/swank-indentation.lisp')
| -rw-r--r-- | vim/bundle/slimv/slime/contrib/swank-indentation.lisp | 140 |
1 files changed, 140 insertions, 0 deletions
diff --git a/vim/bundle/slimv/slime/contrib/swank-indentation.lisp b/vim/bundle/slimv/slime/contrib/swank-indentation.lisp new file mode 100644 index 0000000..67e638d --- /dev/null +++ b/vim/bundle/slimv/slime/contrib/swank-indentation.lisp @@ -0,0 +1,140 @@ +(in-package :swank) + +(defvar *application-hints-tables* '() + "A list of hash tables mapping symbols to indentation hints (lists +of symbols and numbers as per cl-indent.el). Applications can add hash +tables to the list to change the auto indentation slime sends to +emacs.") + +(defun has-application-indentation-hint-p (symbol) + (let ((default (load-time-value (gensym)))) + (dolist (table *application-hints-tables*) + (let ((indentation (gethash symbol table default))) + (unless (eq default indentation) + (return-from has-application-indentation-hint-p + (values indentation t)))))) + (values nil nil)) + +(defun application-indentation-hint (symbol) + (let ((indentation (has-application-indentation-hint-p symbol))) + (labels ((walk (indentation-spec) + (etypecase indentation-spec + (null nil) + (number indentation-spec) + (symbol (string-downcase indentation-spec)) + (cons (cons (walk (car indentation-spec)) + (walk (cdr indentation-spec))))))) + (walk indentation)))) + +;;; override swank version of this function +(defun symbol-indentation (symbol) + "Return a form describing the indentation of SYMBOL. + +The form is to be used as the `common-lisp-indent-function' property +in Emacs." + (cond + ((has-application-indentation-hint-p symbol) + (application-indentation-hint symbol)) + ((and (macro-function symbol) + (not (known-to-emacs-p symbol))) + (let ((arglist (arglist symbol))) + (etypecase arglist + ((member :not-available) + nil) + (list + (macro-indentation arglist))))) + (t nil))) + +;;; More complex version. +(defun macro-indentation (arglist) + (labels ((frob (list &optional base) + (if (every (lambda (x) + (member x '(nil "&rest") :test #'equal)) + list) + ;; If there was nothing interesting, don't return anything. + nil + ;; Otherwise substitute leading NIL's with 4 or 1. + (let ((ok t)) + (substitute-if (if base + 4 + 1) + (lambda (x) + (if (and ok (not x)) + t + (setf ok nil))) + list)))) + (walk (list level &optional firstp) + (when (consp list) + (let ((head (car list))) + (if (consp head) + (let ((indent (frob (walk head (+ level 1) t)))) + (cons (list* "&whole" (if (zerop level) + 4 + 1) + indent) (walk (cdr list) level))) + (case head + ;; &BODY is &BODY, this is clear. + (&body + '("&body")) + ;; &KEY is tricksy. If it's at the base level, we want + ;; to indent them normally: + ;; + ;; (foo bar quux + ;; :quux t + ;; :zot nil) + ;; + ;; If it's at a destructuring level, we want indent of 1: + ;; + ;; (with-foo (var arg + ;; :foo t + ;; :quux nil) + ;; ...) + (&key + (if (zerop level) + '("&rest" nil) + '("&rest" 1))) + ;; &REST is tricksy. If it's at the front of + ;; destructuring, we want to indent by 1, otherwise + ;; normally: + ;; + ;; (foo (bar quux + ;; zot) + ;; ...) + ;; + ;; but + ;; + ;; (foo bar quux + ;; zot) + (&rest + (if (and (plusp level) firstp) + '("&rest" 1) + '("&rest" nil))) + ;; &WHOLE and &ENVIRONMENT are skipped as if they weren't there + ;; at all. + ((&whole &environment) + (walk (cddr list) level firstp)) + ;; &OPTIONAL is indented normally -- and the &OPTIONAL marker + ;; itself is not counted. + (&optional + (walk (cdr list) level)) + ;; Indent normally, walk the tail -- but + ;; unknown lambda-list keywords terminate the walk. + (otherwise + (unless (member head lambda-list-keywords) + (cons nil (walk (cdr list) level)))))))))) + (frob (walk arglist 0 t) t))) + +#+nil +(progn + (assert (equal '(4 4 ("&whole" 4 "&rest" 1) "&body") + (macro-indentation '(bar quux (&rest slots) &body body)))) + (assert (equal nil + (macro-indentation '(a b c &rest more)))) + (assert (equal '(4 4 4 "&body") + (macro-indentation '(a b c &body more)))) + (assert (equal '(("&whole" 4 1 1 "&rest" 1) "&body") + (macro-indentation '((name zot &key foo bar) &body body)))) + (assert (equal nil + (macro-indentation '(x y &key z))))) + +(provide :swank-indentation) |