141 lines
5.7 KiB
Common Lisp
141 lines
5.7 KiB
Common Lisp
|
(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)
|