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

Diff of /slime/swank-allegro.lisp

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

revision 1.20 by heller, Tue Mar 9 12:46:27 2004 UTC revision 1.21 by heller, Tue Mar 9 19:35:36 2004 UTC
# Line 9  Line 9 
9  ;;; Edition "5.0 [Linux/X86] (8/29/98 10:57)".  ;;; Edition "5.0 [Linux/X86] (8/29/98 10:57)".
10  ;;;  ;;;
11    
12    (in-package :swank-backend)
13    
14  (eval-when (:compile-toplevel :load-toplevel :execute)  (eval-when (:compile-toplevel :load-toplevel :execute)
15    (require :sock)    (require :sock)
16    (require :process))    (require :process))
17    
18    <<<<<<< swank-allegro.lisp
19    =======
20  (in-package :swank-backend)  (in-package :swank-backend)
21    
22    >>>>>>> 1.20
23  (import  (import
24   '(excl:fundamental-character-output-stream   '(excl:fundamental-character-output-stream
25     excl:stream-write-char     excl:stream-write-char
# Line 30  Line 35 
35    
36  ;;;; TCP Server  ;;;; TCP Server
37    
38    <<<<<<< swank-allegro.lisp
39    (defimplementation preferred-communication-style ()
40      :spawn)
41    =======
42  (defimplementation preferred-communication-style ()  (defimplementation preferred-communication-style ()
43     :spawn)     :spawn)
44    >>>>>>> 1.20
45    
46  (defimplementation create-socket (host port)  (defimplementation create-socket (host port)
47    (socket:make-socket :connect :passive :local-port port    (socket:make-socket :connect :passive :local-port port
# Line 61  Line 71 
71    
72  ;;;; Misc  ;;;; Misc
73    
74    <<<<<<< swank-allegro.lisp
75    (defimplementation arglist (symbol)
76      (excl:arglist symbol))
77    
78    (defimplementation macroexpand-all (form)
79      (excl::walk form))
80    =======
81  (defimplementation arglist (symbol)  (defimplementation arglist (symbol)
82    (excl:arglist symbol))    (excl:arglist symbol))
83    >>>>>>> 1.20
84    
85  (defimplementation describe-symbol-for-emacs (symbol)  (defimplementation describe-symbol-for-emacs (symbol)
86    (let ((result '()))    (let ((result '()))
# Line 82  Line 100 
100                    (doc 'class)))                    (doc 'class)))
101        result)))        result)))
102    
103    <<<<<<< swank-allegro.lisp
104    (defimplementation describe-definition (symbol namespace)
105      (ecase namespace
106        (:variable
107         (describe symbol))
108        ((:function :generic-function)
109         (describe (symbol-function symbol)))
110        (:class
111         (describe (find-class symbol)))))
112    =======
113  (defimplementation macroexpand-all (form)  (defimplementation macroexpand-all (form)
114    (excl::walk form))    (excl::walk form))
115    
# Line 93  Line 121 
121       (describe (symbol-function symbol)))       (describe (symbol-function symbol)))
122      (:class      (:class
123       (describe (find-class symbol)))))       (describe (find-class symbol)))))
124    >>>>>>> 1.20
125    
126  ;;;; Debugger  ;;;; Debugger
127    
# Line 103  Line 132 
132          (excl::*break-hook* nil))          (excl::*break-hook* nil))
133      (funcall debugger-loop-fn)))      (funcall debugger-loop-fn)))
134    
 (defun format-restarts-for-emacs ()  
   (loop for restart in *sldb-restarts*  
         collect (list (princ-to-string (restart-name restart))  
                       (princ-to-string restart))))  
   
135  (defun nth-frame (index)  (defun nth-frame (index)
136    (do ((frame *sldb-topframe* (excl::int-next-older-frame frame))    (do ((frame *sldb-topframe* (excl::int-next-older-frame frame))
137         (i index (1- i)))         (i index (1- i)))
# Line 134  Line 158 
158    (declare (ignore index))    (declare (ignore index))
159    nil)    nil)
160    
161    (defimplementation disassemble-frame (index)
162      (disassemble (debugger:frame-function (nth-frame index))))
163    
164  (defimplementation frame-source-location-for-emacs (index)  (defimplementation frame-source-location-for-emacs (index)
165    (list :error (format nil "Cannot find source for frame: ~A"    (list :error (format nil "Cannot find source for frame: ~A"
166                         (nth-frame index))))                         (nth-frame index))))
# Line 150  Line 177 
177               form               form
178               (debugger:environment-of-frame frame)))))               (debugger:environment-of-frame frame)))))
179    
180  ;;; XXX doens't work for frames with arguments  ;;; XXX doesn't work for frames with arguments
181  (defimplementation restart-frame (frame-number)  (defimplementation restart-frame (frame-number)
182    (let ((frame (nth-frame frame-number)))    (let ((frame (nth-frame frame-number)))
183      (debugger:frame-retry frame (debugger:frame-function frame))))      (debugger:frame-retry frame (debugger:frame-function frame))))
# Line 198  Line 225 
225    
226  ;;;; Definition Finding  ;;;; Definition Finding
227    
228    <<<<<<< swank-allegro.lisp
229    (defun find-fspec-location (fspec type)
230      (let ((file (excl::fspec-pathname fspec type)))
231        (etypecase file
232          (pathname
233           (let ((start (scm:find-definition-in-file fspec type file)))
234             (make-location (list :file (namestring (truename file)))
235                            (if start
236                                (list :position (1+ start))
237                                (list :function-name (string fspec))))))
238          ((member :top-level)
239           (list :error (format nil "Defined at toplevel: ~A" fspec)))
240          (null
241           (list :error (format nil "Unkown source location for ~A" fspec))))))
242    
243    (defun fspec-definition-locations (fspec)
244    =======
245  (defun find-fspec-location (fspec type)  (defun find-fspec-location (fspec type)
246    (let ((file (excl::fspec-pathname fspec type)))    (let ((file (excl::fspec-pathname fspec type)))
247      (etypecase file      (etypecase file
# Line 213  Line 257 
257         (list :error (format nil "Unkown source location for ~A" fspec))))))         (list :error (format nil "Unkown source location for ~A" fspec))))))
258    
259  (defun fspec-source-locations (fspec)  (defun fspec-source-locations (fspec)
260    >>>>>>> 1.20
261    (let ((defs (excl::find-multiple-definitions fspec)))    (let ((defs (excl::find-multiple-definitions fspec)))
262    <<<<<<< swank-allegro.lisp
263        (loop for (fspec type) in defs
264              collect (list fspec (find-fspec-location fspec type)))))
265    
266    (defimplementation find-definitions (symbol)
267      (fspec-definition-locations symbol))
268    =======
269      (loop for (fspec type) in defs      (loop for (fspec type) in defs
270            collect (list fspec (find-fspec-location fspec type)))))            collect (list fspec (find-fspec-location fspec type)))))
271    
272  (defimplementation find-definitions (symbol)  (defimplementation find-definitions (symbol)
273    (fspec-source-locations symbol))    (fspec-source-locations symbol))
274    >>>>>>> 1.20
275    
276  ;;;; XREF  ;;;; XREF
277    
278    <<<<<<< swank-allegro.lisp
279    (defmacro defxref (name relation name1 name2)
280      `(defimplementation ,name (x)
281        (xref-result (xref:get-relation ,relation ,name1 ,name2))))
282    
283    (defxref who-calls        :calls       :wild x)
284    (defxref who-references   :uses        :wild x)
285    (defxref who-binds        :binds       :wild x)
286    (defxref who-macroexpands :macro-calls :wild x)
287    (defxref who-sets         :sets        :wild x)
288    (defxref list-callees     :calls       x :wild)
289    
290    (defun xref-result (fspecs)
291      (loop for fspec in fspecs
292            append (fspec-definition-locations fspec)))
293    =======
294  (defun xrefs (fspecs)  (defun xrefs (fspecs)
295    (loop for fspec in fspecs    (loop for fspec in fspecs
296          nconc (loop for (ref location) in (fspec-source-locations fspec)          nconc (loop for (ref location) in (fspec-source-locations fspec)
# Line 244  Line 313 
313    
314  (defimplementation list-callees (name)  (defimplementation list-callees (name)
315    (xrefs (xref:get-relation :calls name :wild)))    (xrefs (xref:get-relation :calls name :wild)))
316    >>>>>>> 1.20
317    
318  ;;;; Inspecting  ;;;; Inspecting
319    

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

  ViewVC Help
Powered by ViewVC 1.1.5