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

Diff of /slime/swank-lispworks.lisp

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

revision 1.14 by heller, Tue Jan 13 22:51:56 2004 UTC revision 1.15 by heller, Sun Jan 18 07:15:49 2004 UTC
# Line 27  Line 27 
27     stream:stream-line-column     stream:stream-line-column
28     ))     ))
29    
 (defun without-interrupts* (body)  
   (lispworks:without-interrupts (funcall body)))  
   
 (defconstant +sigint+ 2)  
   
30  ;;; TCP server  ;;; TCP server
31    
32  (defun socket-fd (socket)  (defun socket-fd (socket)
# Line 68  Line 63 
63    ;; Set SIGINT handler on Swank request handler thread.    ;; Set SIGINT handler on Swank request handler thread.
64    (sys:set-signal-handler +sigint+ #'sigint-handler))    (sys:set-signal-handler +sigint+ #'sigint-handler))
65    
66    ;;; Unix signals
67    
68  (defun sigint-handler (&rest args)  (defun sigint-handler (&rest args)
69    (declare (ignore args))    (declare (ignore args))
70    (invoke-debugger "SIGINT"))    (invoke-debugger "SIGINT"))
71    
72  ;;;  (defmethod call-without-interrupts (fn)
73      (lispworks:without-interrupts (funcall fn)))
74    
75  (defslimefun getpid ()  (defmethod getpid ()
   "Return the process ID of this superior Lisp."  
76    (system::getpid))    (system::getpid))
77    
78    ;;;
79    
80  (defmethod arglist-string (fname)  (defmethod arglist-string (fname)
81    "Return the lambda list for function FNAME as a string."    (format-arglist fname #'lw:function-lambda-list))
   (let ((*print-case* :downcase))  
     (multiple-value-bind (function condition)  
         (ignore-errors (values  
                         (find-symbol-designator fname *buffer-package*)))  
       (when condition  
         (return-from arglist-string (format nil "(-- ~A)" condition)))  
       (let ((arglist (and (fboundp function)  
                           (lispworks:function-lambda-list function))))  
         (if arglist  
             (princ-to-string arglist)  
             "(-- <Unknown-Function>)")))))  
82    
83  (defmethod macroexpand-all (form)  (defmethod macroexpand-all (form)
84    (walker:walk-form form))    (walker:walk-form form))

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

  ViewVC Help
Powered by ViewVC 1.1.5