/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.124 by heller, Mon Feb 23 07:21:07 2004 UTC revision 1.125 by heller, Tue Feb 24 23:27:43 2004 UTC
# Line 682  exists." Line 682  exists."
682      (cond (package (values symbol package))      (cond (package (values symbol package))
683            (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))            (t (error "Unknown symbol: ~S [in ~A]" string default-package)))))
684    
685    ;;; We use a special pprint-dispatch table for printing the arglist.
686    ;;; An argument is either a symbol or a list.  The name of the
687    ;;; argument is PRINCed but the other components of an argument
688    ;;; --default value or type-- are PPRINTed.  We do this to nicely
689    ;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too
690    ;;; much code for such a minor feature?
691    
692    (defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch nil))
693    
694    (defun print-cons-argument (stream object)
695      (pprint-logical-block (stream object :prefix "(" :suffix ")")
696        (princ (car object) stream)
697        (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
698          (pprint-fill stream (cdr object) nil))))
699    
700    (defun print-symbol-argument (stream object)
701      (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
702        (princ object stream)))
703    
704    (defvar *arglist-pprint-dispatch-table*
705      (let ((table (copy-pprint-dispatch nil)))
706        (set-pprint-dispatch 'cons #'print-cons-argument 0 table)
707        (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)
708        table))
709    
710  (defun format-arglist (function-name lambda-list-fn)  (defun format-arglist (function-name lambda-list-fn)
711    "Use LAMBDA-LIST-FN to format the arglist for FUNCTION-NAME.    "Use LAMBDA-LIST-FN to format the arglist for FUNCTION-NAME.
712  Call LAMBDA-LIST-FN with the symbol corresponding to FUNCTION-NAME."  Call LAMBDA-LIST-FN with the symbol corresponding to FUNCTION-NAME."
# Line 690  Call LAMBDA-LIST-FN with the symbol corr Line 715  Call LAMBDA-LIST-FN with the symbol corr
715        (ignore-errors        (ignore-errors
716          (let ((symbol (find-symbol-or-lose function-name)))          (let ((symbol (find-symbol-or-lose function-name)))
717            (values (funcall lambda-list-fn symbol))))            (values (funcall lambda-list-fn symbol))))
718      (cond (condition  (format nil "(-- ~A)" condition))      (cond (condition (format nil "(-- ~A)" condition))
719            (t (let ((*print-case* :downcase)            (t (let ((*print-case* :downcase)
720                     (*print-pretty* nil))                     (*print-pprint-dispatch* *arglist-pprint-dispatch-table*)
721                 (format nil "(~{~A~^ ~})" arglist))))))                     (*print-level* nil)
722                       (*print-length* nil))
723                   (with-output-to-string (stream)
724                     (pprint-fill stream arglist)))))))
725    
726    
727  ;;;; Debugger  ;;;; Debugger
# Line 1482  a time.") Line 1510  a time.")
1510  (defslimefun quit-thread-browser ()  (defslimefun quit-thread-browser ()
1511    (setq *thread-list* nil))    (setq *thread-list* nil))
1512    
   
1513  ;;; Local Variables:  ;;; Local Variables:
1514  ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))  ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
1515  ;;; End:  ;;; End:

Legend:
Removed from v.1.124  
changed lines
  Added in v.1.125

  ViewVC Help
Powered by ViewVC 1.1.5