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

Diff of /slime/swank-sbcl.lisp

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

revision 1.21 by heller, Sat Nov 8 00:40:27 2003 UTC revision 1.22 by heller, Thu Nov 13 00:36:56 2003 UTC
# Line 186  until the remote Emacs goes away." Line 186  until the remote Emacs goes away."
186    75)    75)
187    
188  (defmethod sb-gray:stream-force-output ((stream slime-output-stream))  (defmethod sb-gray:stream-force-output ((stream slime-output-stream))
189    (with-slots (buffer fill-pointer last-charpos) stream    (with-slots (buffer fill-pointer) stream
190      (let ((end fill-pointer))      (let ((end fill-pointer))
191        (unless (zerop end)        (unless (zerop end)
192          (send-to-emacs `(:read-output ,(subseq buffer 0 end)))          (send-to-emacs `(:read-output ,(subseq buffer 0 end)))
# Line 266  information." Line 266  information."
266                         file-name))                         file-name))
267               (note               (note
268                (list                (list
                :position file-pos  
                :filename (etypecase file  
                            (symbol file)  
                            ((or string pathname)  
                             (namestring (truename file))))  
                :source-path (current-compiler-error-source-path context)  
269                 :severity (etypecase condition                 :severity (etypecase condition
270                             (sb-c:compiler-error :error)                             (sb-c:compiler-error :error)
271                             (sb-ext:compiler-note :note)                             (sb-ext:compiler-note :note)
272                             (style-warning :style-warning)                             (style-warning :style-warning)
273                             (warning :warning))                             (warning :warning))
274                 :message (brief-compiler-message-for-emacs condition context)                 :message (brief-compiler-message-for-emacs condition context)
275                 :buffername (if (boundp '*buffername*) *buffername*)                 :location
276                 :buffer-offset (if (boundp '*buffer-offset*) *buffer-offset*))))                 (list
277                    :sbcl
278                    :buffername (if (boundp '*buffername*) *buffername*)
279                    :buffer-offset (if (boundp '*buffer-offset*) *buffer-offset*)
280                    :position file-pos
281                    :filename (etypecase file
282                                (symbol file)
283                                ((or string pathname)
284                                 (namestring (truename file))))
285                    :source-path (current-compiler-error-source-path context)))))
286          #+nil          #+nil
287          (let ((*print-length* nil))          (let ((*print-length* nil))
288            (format *terminal-io* "handle-notification-condition ~A ~%" note))            (format *terminal-io* "handle-notification-condition ~A ~%" note))
289          (push note *compiler-notes*)          (push note *compiler-notes*)))))
         (push note (gethash file *notes-database*))))))  
290    
291  (defun brief-compiler-message-for-emacs (condition error-context)  (defun brief-compiler-message-for-emacs (condition error-context)
292    "Briefly describe a compiler error for Emacs.    "Briefly describe a compiler error for Emacs.
# Line 334  compiler state." Line 336  compiler state."
336             (eval (from-string             (eval (from-string
337                    (format nil "(funcall (compile nil '(lambda () ~A)))"                    (format nil "(funcall (compile nil '(lambda () ~A)))"
338                            string)))                            string)))
339           (setf *compiler-notes*           (loop for n  in *compiler-notes*
340                 (loop for n in *compiler-notes*                 for loc = (getf n :location)
341                       for sp = (getf n :source-path)                 for (_ . l) = loc
342                       ;; account for the added lambda, replace leading                 for sp = (getf l :source-path)
343                       ;; position with 0                 ;; account for the added lambda, replace leading
344                       do (setf (getf n :source-path) (cons 0 (cddr sp)))                 ;; position with 0
345                       collect (list* :buffername buffer                 do (setf (getf l :source-path) (cons 0 (cddr sp))
346                                      :buffer-offset start                          (getf l :buffername) buffer
347                                      n))))))))                          (getf l :buffer-offset) start)))))))
348    
349  ;;;; xref stuff doesn't exist for sbcl yet  ;;;; xref stuff doesn't exist for sbcl yet
350    
# Line 374  This is useful when debugging the defini Line 376  This is useful when debugging the defini
376    (let* ((def (sb-introspect:find-definition-source function))    (let* ((def (sb-introspect:find-definition-source function))
377           (pathname (sb-introspect:definition-source-pathname def))           (pathname (sb-introspect:definition-source-pathname def))
378           (path (sb-introspect:definition-source-form-path def)))           (path (sb-introspect:definition-source-form-path def)))
379      (list :from :file      (list :sbcl
380            :filename (and pathname (namestring pathname))            :filename (and pathname (namestring pathname))
381            :position (sb-introspect:definition-source-character-offset def)            :position (sb-introspect:definition-source-character-offset def)
           :info nil                     ; should be a source-info structure  
382            :path path            :path path
383            ;; source-paths depend on the file having been compiled with            ;; source-paths depend on the file having been compiled with
384            ;; lotsa debugging.  If not present, return the function name            ;; lotsa debugging.  If not present, return the function name
385            ;; for emacs to attempt to find with a regex            ;; for emacs to attempt to find with a regex
386            :function-name (unless path fname)            :function-name (unless path fname))))
           :source-form nil)))  
387    
388  (defslimefun function-source-location-for-emacs (fname-string)  (defslimefun function-source-location-for-emacs (fname-string)
389    "Return the source-location of FNAME's definition."    "Return the source-location of FNAME's definition."
# Line 406  This is useful when debugging the defini Line 406  This is useful when debugging the defini
406            (finder fname)            (finder fname)
407            (handler-case (finder fname)            (handler-case (finder fname)
408              (error (e) (list :error (format nil "Error: ~A" e))))))))              (error (e) (list :error (format nil "Error: ~A" e))))))))
409    ;; (function-source-location-for-emacs "read-next-form")
410  (defun briefly-describe-symbol-for-emacs (symbol)  (defun briefly-describe-symbol-for-emacs (symbol)
411    "Return a plist describing SYMBOL.    "Return a plist describing SYMBOL.
412  Return NIL if the symbol is unbound."  Return NIL if the symbol is unbound."
# Line 597  stack." Line 597  stack."
597           (from (sb-di:debug-source-from debug-source))           (from (sb-di:debug-source-from debug-source))
598           (name (sb-di:debug-source-name debug-source)))           (name (sb-di:debug-source-name debug-source)))
599      (list      (list
600         :sbcl
601       :from from       :from from
602       :filename (if (eq from :file)       :filename (if (eq from :file)
603                     (namestring (truename name)))                     (namestring (truename name)))
# Line 616  stack." Line 617  stack."
617      (t (c) (list :error (princ-to-string c)))))      (t (c) (list :error (princ-to-string c)))))
618    
619  (defslimefun frame-source-location-for-emacs (index)  (defslimefun frame-source-location-for-emacs (index)
620    (safe-source-location-for-emacs (sb-di:frame-code-location (nth-frame index))))    (safe-source-location-for-emacs
621       (sb-di:frame-code-location (nth-frame index))))
622    
623  #+nil  #+nil
624  (defslimefun eval-string-in-frame (string index)  (defslimefun eval-string-in-frame (string index)

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

  ViewVC Help
Powered by ViewVC 1.1.5