slynk-indentation.lisp (5846B)
1 (in-package :slynk) 2 3 (defvar *application-hints-tables* '() 4 "A list of hash tables mapping symbols to indentation hints (lists 5 of symbols and numbers as per cl-indent.el). Applications can add hash 6 tables to the list to change the auto indentation sly sends to 7 emacs.") 8 9 (defun has-application-indentation-hint-p (symbol) 10 (let ((default (load-time-value (gensym)))) 11 (dolist (table *application-hints-tables*) 12 (let ((indentation (gethash symbol table default))) 13 (unless (eq default indentation) 14 (return-from has-application-indentation-hint-p 15 (values indentation t)))))) 16 (values nil nil)) 17 18 (defun application-indentation-hint (symbol) 19 (let ((indentation (has-application-indentation-hint-p symbol))) 20 (labels ((walk (indentation-spec) 21 (etypecase indentation-spec 22 (null nil) 23 (number indentation-spec) 24 (symbol (string-downcase indentation-spec)) 25 (cons (cons (walk (car indentation-spec)) 26 (walk (cdr indentation-spec))))))) 27 (walk indentation)))) 28 29 ;;; override slynk version of this function 30 (defun symbol-indentation (symbol) 31 "Return a form describing the indentation of SYMBOL. 32 33 The form is to be used as the `sly-common-lisp-indent-function' property 34 in Emacs." 35 (cond 36 ((has-application-indentation-hint-p symbol) 37 (application-indentation-hint symbol)) 38 ((and (macro-function symbol) 39 (not (known-to-emacs-p symbol))) 40 (let ((arglist (arglist symbol))) 41 (etypecase arglist 42 ((member :not-available) 43 nil) 44 (list 45 (macro-indentation arglist))))) 46 (t nil))) 47 48 ;;; More complex version. 49 (defun macro-indentation (arglist) 50 (labels ((frob (list &optional base) 51 (if (every (lambda (x) 52 (member x '(nil "&rest") :test #'equal)) 53 list) 54 ;; If there was nothing interesting, don't return anything. 55 nil 56 ;; Otherwise substitute leading NIL's with 4 or 1. 57 (let ((ok t)) 58 (substitute-if (if base 59 4 60 1) 61 (lambda (x) 62 (if (and ok (not x)) 63 t 64 (setf ok nil))) 65 list)))) 66 (walk (list level &optional firstp) 67 (when (consp list) 68 (let ((head (car list))) 69 (if (consp head) 70 (let ((indent (frob (walk head (+ level 1) t)))) 71 (cons (list* "&whole" (if (zerop level) 72 4 73 1) 74 indent) (walk (cdr list) level))) 75 (case head 76 ;; &BODY is &BODY, this is clear. 77 (&body 78 '("&body")) 79 ;; &KEY is tricksy. If it's at the base level, we want 80 ;; to indent them normally: 81 ;; 82 ;; (foo bar quux 83 ;; :quux t 84 ;; :zot nil) 85 ;; 86 ;; If it's at a destructuring level, we want indent of 1: 87 ;; 88 ;; (with-foo (var arg 89 ;; :foo t 90 ;; :quux nil) 91 ;; ...) 92 (&key 93 (if (zerop level) 94 '("&rest" nil) 95 '("&rest" 1))) 96 ;; &REST is tricksy. If it's at the front of 97 ;; destructuring, we want to indent by 1, otherwise 98 ;; normally: 99 ;; 100 ;; (foo (bar quux 101 ;; zot) 102 ;; ...) 103 ;; 104 ;; but 105 ;; 106 ;; (foo bar quux 107 ;; zot) 108 (&rest 109 (if (and (plusp level) firstp) 110 '("&rest" 1) 111 '("&rest" nil))) 112 ;; &WHOLE and &ENVIRONMENT are skipped as if they weren't there 113 ;; at all. 114 ((&whole &environment) 115 (walk (cddr list) level firstp)) 116 ;; &OPTIONAL is indented normally -- and the &OPTIONAL marker 117 ;; itself is not counted. 118 (&optional 119 (walk (cdr list) level)) 120 ;; Indent normally, walk the tail -- but 121 ;; unknown lambda-list keywords terminate the walk. 122 (otherwise 123 (unless (member head lambda-list-keywords) 124 (cons nil (walk (cdr list) level)))))))))) 125 (frob (walk arglist 0 t) t))) 126 127 #+nil 128 (progn 129 (assert (equal '(4 4 ("&whole" 4 "&rest" 1) "&body") 130 (macro-indentation '(bar quux (&rest slots) &body body)))) 131 (assert (equal nil 132 (macro-indentation '(a b c &rest more)))) 133 (assert (equal '(4 4 4 "&body") 134 (macro-indentation '(a b c &body more)))) 135 (assert (equal '(("&whole" 4 1 1 "&rest" 1) "&body") 136 (macro-indentation '((name zot &key foo bar) &body body)))) 137 (assert (equal nil 138 (macro-indentation '(x y &key z))))) 139 140 (provide :slynk/indentation)