Skip to content
GitLab
Commit 14114560 authored by Luís Oliveira's avatar Luís Oliveira
Browse files

slime-autodoc: don't print newline after the operator 

Avoid adding a newline after things like with-open-file when
doing multiline display. Fixes issue #7.

* swank-arglists.lisp (print-decoded-arglist): Don't
  pprint-newline when adding a space after the operator.
parent 89528e79
Hide whitespace changes
Inline Side-by-side
Showing
with 98 additions and 87 deletions
+98 -87
contrib/ChangeLog
+ 8
- 0
View file @ 14114560
2014-03-08 Luís Oliveira <loliveira@common-lisp.net>
slime-autodoc: avoid adding a newline after things like
with-open-file when doing multiline display.
* swank-arglists.lisp (print-decoded-arglist): Don't
pprint-newline when adding a space after the operator.
2014-03-07 João Távora <joaotavora@gmail.com>
* slime-trace-dialog.el (slime-trace-dialog--open-detail): Fix
......
contrib/swank-arglists.lisp
+ 90
- 87
View file @ 14114560
......@@ -228,93 +228,96 @@ Otherwise NIL is returned."
(prin1-to-string x)))
(defun print-decoded-arglist (arglist &key operator provided-args highlight)
(macrolet ((space ()
;; Kludge: When OPERATOR is not given, we don't want to
;; print a space for the first argument.
`(if (not operator)
(setq operator t)
(progn (write-char #\space)
(pprint-newline :fill))))
(with-highlighting ((&key index) &body body)
`(if (eql ,index (car highlight))
(progn (princ "===> ") ,@body (princ " <==="))
(progn ,@body)))
(print-arglist-recursively (argl &key index)
`(if (eql ,index (car highlight))
(print-decoded-arglist ,argl :highlight (cdr highlight))
(print-decoded-arglist ,argl))))
(let ((index 0))
(pprint-logical-block (nil nil :prefix "(" :suffix ")")
(when operator
(print-arg operator)
(pprint-indent :current 1)) ; 1 due to possibly added space
(do-decoded-arglist (remove-given-args arglist provided-args)
(&provided (arg)
(space)
(print-arg arg :literal-strings t)
(incf index))
(&required (arg)
(space)
(if (arglist-p arg)
(print-arglist-recursively arg :index index)
(with-highlighting (:index index)
(print-arg arg)))
(incf index))
(&optional :initially
(when (arglist.optional-args arglist)
(space)
(princ '&optional)))
(&optional (arg init-value)
(space)
(if (arglist-p arg)
(print-arglist-recursively arg :index index)
(with-highlighting (:index index)
(if (null init-value)
(print-arg arg)
(format t "~:@<~A ~A~@:>"
(undummy arg) (undummy init-value)))))
(incf index))
(&key :initially
(when (arglist.key-p arglist)
(space)
(princ '&key)))
(&key (keyword arg init)
(space)
(if (arglist-p arg)
(pprint-logical-block (nil nil :prefix "(" :suffix ")")
(prin1 keyword) (space)
(print-arglist-recursively arg :index keyword))
(with-highlighting (:index keyword)
(cond ((and init (keywordp keyword))
(format t "~:@<~A ~A~@:>" keyword (undummy init)))
(init
(format t "~:@<(~A ..) ~A~@:>"
(undummy keyword) (undummy init)))
((not (keywordp keyword))
(format t "~:@<(~S ..)~@:>" keyword))
(t
(princ keyword))))))
(&key :finally
(when (arglist.allow-other-keys-p arglist)
(space)
(princ '&allow-other-keys)))
(&any :initially
(when (arglist.any-p arglist)
(space)
(princ '&any)))
(&any (arg)
(space)
(print-arg arg))
(&rest (args bodyp)
(space)
(princ (if bodyp '&body '&rest))
(space)
(if (arglist-p args)
(print-arglist-recursively args :index index)
(with-highlighting (:index index)
(print-arg args))))
;; FIXME: add &UNKNOWN-JUNK?
)))))
(let ((first-space-after-operator (and operator t)))
(macrolet ((space ()
;; Kludge: When OPERATOR is not given, we don't want to
;; print a space for the first argument.
`(if (not operator)
(setq operator t)
(progn (write-char #\space)
(if first-space-after-operator
(setq first-space-after-operator nil)
(pprint-newline :fill)))))
(with-highlighting ((&key index) &body body)
`(if (eql ,index (car highlight))
(progn (princ "===> ") ,@body (princ " <==="))
(progn ,@body)))
(print-arglist-recursively (argl &key index)
`(if (eql ,index (car highlight))
(print-decoded-arglist ,argl :highlight (cdr highlight))
(print-decoded-arglist ,argl))))
(let ((index 0))
(pprint-logical-block (nil nil :prefix "(" :suffix ")")
(when operator
(print-arg operator)
(pprint-indent :current 1)) ; 1 due to possibly added space
(do-decoded-arglist (remove-given-args arglist provided-args)
(&provided (arg)
(space)
(print-arg arg :literal-strings t)
(incf index))
(&required (arg)
(space)
(if (arglist-p arg)
(print-arglist-recursively arg :index index)
(with-highlighting (:index index)
(print-arg arg)))
(incf index))
(&optional :initially
(when (arglist.optional-args arglist)
(space)
(princ '&optional)))
(&optional (arg init-value)
(space)
(if (arglist-p arg)
(print-arglist-recursively arg :index index)
(with-highlighting (:index index)
(if (null init-value)
(print-arg arg)
(format t "~:@<~A ~A~@:>"
(undummy arg) (undummy init-value)))))
(incf index))
(&key :initially
(when (arglist.key-p arglist)
(space)
(princ '&key)))
(&key (keyword arg init)
(space)
(if (arglist-p arg)
(pprint-logical-block (nil nil :prefix "(" :suffix ")")
(prin1 keyword) (space)
(print-arglist-recursively arg :index keyword))
(with-highlighting (:index keyword)
(cond ((and init (keywordp keyword))
(format t "~:@<~A ~A~@:>" keyword (undummy init)))
(init
(format t "~:@<(~A ..) ~A~@:>"
(undummy keyword) (undummy init)))
((not (keywordp keyword))
(format t "~:@<(~S ..)~@:>" keyword))
(t
(princ keyword))))))
(&key :finally
(when (arglist.allow-other-keys-p arglist)
(space)
(princ '&allow-other-keys)))
(&any :initially
(when (arglist.any-p arglist)
(space)
(princ '&any)))
(&any (arg)
(space)
(print-arg arg))
(&rest (args bodyp)
(space)
(princ (if bodyp '&body '&rest))
(space)
(if (arglist-p args)
(print-arglist-recursively args :index index)
(with-highlighting (:index index)
(print-arg args))))
;; FIXME: add &UNKNOWN-JUNK?
))))))
(defun print-arg (arg &key literal-strings)
(let ((arg (if (arglist-dummy-p arg)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

免费DevSecOps平台，让您的项目体验完整的DevSecOps流程，让项目更安全