Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv20022
Modified Files: dev-commands.lisp Log Message: Slightly better editability in the listener: now fboundp (setf foo) things stand a chance of having the Edit Definition command work.
Printing methods with EQL specializers works better.
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/03/29 10:43:37 1.34 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/04/10 21:24:53 1.35 @@ -37,10 +37,20 @@
;;; Presentation types
-(define-presentation-type class () :inherit-from 'expression) +(define-presentation-type specializer () :inherit-from 'expression) +(define-presentation-type class () :inherit-from 'specializer) +(define-presentation-type eql-specializer () :inherit-from 'specializer) (define-presentation-type class-name () :inherit-from 'symbol) (define-presentation-type slot-definition () :inherit-from 'expression) -(define-presentation-type function-name () :inherit-from 'symbol) + +(define-presentation-type-abbreviation function-name () + `(and expression (satisfies legal-and-fboundp))) + +(defun legal-and-fboundp (object) + (and #+sbcl (sb-int:valid-function-name-p object) + #-sbcl (typep object '(or symbol (cons (eql setf)))) + (fboundp object))) + (define-presentation-type process () :inherit-from 'expression) (define-presentation-type generic-function () :inherit-from 't)
@@ -67,9 +77,7 @@
(define-presentation-type package-name () :inherit-from 'string) (define-presentation-method presentation-typep (object (type package-name)) - (find-package 'object)) - - + (find-package object))
;;; Presentation methods
@@ -98,8 +106,10 @@ (write-char #( stream) (present arg 'symbol :stream stream) (write-char #\space stream) - (with-output-as-presentation (stream spec 'class) - (format stream "~S" (clim-mop:class-name spec))) + (with-output-as-presentation (stream spec 'specializer) + (if (typep spec 'class) + (format stream "~S" (clim-mop:class-name spec)) + (format stream "~S" `(eql ,(clim-mop:eql-specializer-object spec))))) (write-char #) stream)))) (when optional (format stream " &optional ~{~A ~^ ~}" optional)) @@ -187,13 +197,31 @@ (object) (clim-mop:class-name object))
+(define-presentation-translator expression-to-function-name + (expression function-name lisp-dev-commands + :documentation ((object stream) (format stream "~A" object)) + :gesture t + :tester ((object) (legal-and-fboundp object)) + :tester-definitive t) + (object) + object) (define-presentation-translator symbol-to-function-name (symbol function-name lisp-dev-commands - :documentation ((object stream) (format stream "Function ~A" object)) + :documentation ((object stream) (format stream "~A" object)) :gesture t - :tester ((object) (fboundp object)) + :tester ((object) (legal-and-fboundp object)) :tester-definitive t) - (object) object) + (object) + object) +#+nil ; doesn't work for some reason +(define-presentation-translator sequence-to-function-name + ((sequence t) function-name lisp-dev-commands + :documentation ((object stream) (format stream "~A" object)) + :gesture t + :tester ((object) (legal-and-fboundp object)) + :tester-definitive t) + (object) + object)
;;; Application commands
@@ -336,7 +364,7 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword nil) - ((fsym 'function-name :prompt "function-name")) + ((fsym 'function-name :prompt "function name")) (if (fboundp fsym) (progn (eval `(trace ,fsym)) @@ -347,7 +375,7 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword nil) - ((fsym 'symbol :prompt "function name")) + ((fsym 'function-name :prompt "function name")) (if (fboundp fsym) (progn (eval `(untrace ,fsym)) @@ -572,10 +600,16 @@ (note "No accessors") (progn (with-ink (readers) - (if readers (dolist (reader readers) (format t "~A~%" reader)) - (note "No readers~%"))) + (if readers + (dolist (reader readers) + (hackish-present reader) + (terpri)) + (note "No readers~%"))) (with-ink (writers) - (if writers (dolist (writer writers) (format t "~A~%" writer)) + (if writers + (dolist (writer writers) + (hackish-present writer) + (terpri)) (note "No writers"))))))
(fcell (documentation :left) @@ -1379,19 +1413,14 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword nil) - ((symbol 'symbol :prompt "function-name")) - (clim-sys:make-process (lambda () (ed symbol)))) - -(defun editable-definition-p (symbol) - (fboundp symbol)) + ((function-name 'function-name :prompt "function name")) + (clim-sys:make-process (lambda () (ed function-name))))
(define-presentation-to-command-translator edit-definition - (symbol com-edit-definition lisp-commands :gesture :select + (function-name com-edit-definition lisp-commands :gesture :select :pointer-documentation ((object stream) (format stream "Edit Definition of ~A" object)) - :documentation ((stream) (format stream "Edit Definition")) - :tester ((object) - (editable-definition-p object))) + :documentation ((stream) (format stream "Edit Definition"))) (object) (list object))