/[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.40 by dbarlow, Wed Dec 10 19:02:35 2003 UTC revision 1.41 by dbarlow, Thu Dec 11 02:20:13 2003 UTC
# Line 159  The request is read from the socket as a Line 159  The request is read from the socket as a
159              (princ-to-string arglist)              (princ-to-string arglist)
160              "(-- <Unknown-Function>)")))))              "(-- <Unknown-Function>)")))))
161    
162  (defvar *buffername*)  (defvar *buffername* nil)
163  (defvar *buffer-offset*)  (defvar *buffer-offset*)
 (defvar *compile-filename*)  
164    
165  (defvar *previous-compiler-condition* nil  (defvar *previous-compiler-condition* nil
166    "Used to detect duplicates.")    "Used to detect duplicates.")
# Line 197  information." Line 196  information."
196             (sb-c::compiler-error-context-file-name context)             (sb-c::compiler-error-context-file-name context)
197             (sb-c::compiler-error-context-file-position context)             (sb-c::compiler-error-context-file-position context)
198             (current-compiler-error-source-path context)))             (current-compiler-error-source-path context)))
199      (cond ((and (boundp '*buffername*) *buffername*)      (cond (*buffername*
200             ;; account for the added lambda, replace leading             ;; account for the added lambda, replace leading
201             ;; position with 0             ;; position with 0
202             (make-location             (make-location
# Line 209  information." Line 208  information."
208                (make-location                (make-location
209                 (list :file (namestring (truename file-name)))                 (list :file (namestring (truename file-name)))
210                 (list :source-path source-path file-pos)))))                 (list :source-path source-path file-pos)))))
211            ((or *compile-file-truename* *compile-filename*)            (*compile-file-truename*
212             (make-location             (make-location
213              (list :file (namestring (or *compile-file-truename*              (list :file (namestring *compile-file-truename*))
                                         *compile-filename*)))  
214              (list :source-path '(0) 1)))              (list :source-path '(0) 1)))
215            (t            (t
216             (list :error "No source location")))))             (list :error "No source location")))))
# Line 242  compiler state." Line 240  compiler state."
240           (reverse           (reverse
241            (sb-c::compiler-error-context-original-source-path context)))))            (sb-c::compiler-error-context-original-source-path context)))))
242    
243  (defmacro with-compilation-hooks (() &body body)  (defmethod call-with-compilation-hooks (function)
244    `(handler-bind ((sb-c:compiler-error  #'handle-notification-condition)    (handler-bind ((sb-c:compiler-error  #'handle-notification-condition)
245                    (sb-ext:compiler-note #'handle-notification-condition)                   (sb-ext:compiler-note #'handle-notification-condition)
246                    (style-warning        #'handle-notification-condition)                   (style-warning        #'handle-notification-condition)
247                    (warning              #'handle-notification-condition))                   (warning              #'handle-notification-condition))
248      ,@body))      (funcall function)))
249    
250  (defmethod compile-file-for-emacs (filename load-p)  (defmethod compile-file-for-emacs (filename load-p)
251    (with-compilation-hooks ()    (with-compilation-hooks ()
252      (let* ((*buffername* nil)      (multiple-value-bind (fasl-file w-p f-p) (compile-file filename)
253             (*buffer-offset* nil)        (cond ((and fasl-file (not f-p) load-p)
            (*compile-filename* filename)  
            (fasl-file (compile-file filename)))  
       (cond ((and fasl-file load-p)  
254               (load fasl-file))               (load fasl-file))
255              (t fasl-file)))))              (t fasl-file)))))
256    
257    (defmethod compile-system-for-emacs (system-name)
258      (with-compilation-hooks ()
259        (asdf:operate 'asdf:load-op system-name)))
260    
261  (defmethod compile-string-for-emacs (string &key buffer position)  (defmethod compile-string-for-emacs (string &key buffer position)
262    (with-compilation-hooks ()    (with-compilation-hooks ()
263      (let ((*package* *buffer-package*)      (let ((*package* *buffer-package*)

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.41

  ViewVC Help
Powered by ViewVC 1.1.5