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

Diff of /slime/swank-cmucl.lisp

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

revision 1.195 by heller, Mon Sep 15 10:41:03 2008 UTC revision 1.196 by heller, Wed Sep 17 06:19:48 2008 UTC
# Line 199  specific functions.") Line 199  specific functions.")
199       (when ready (return ready)))       (when ready (return ready)))
200     (when timeout (return nil))     (when timeout (return nil))
201     (when (check-slime-interrupts) (return :interrupt))     (when (check-slime-interrupts) (return :interrupt))
202     (let* ((f (constantly t))     (let* (#+(or)(lisp::*descriptor-handlers* '()) ; ignore other handlers
203              (f (constantly t))
204            (handlers (loop for s in streams            (handlers (loop for s in streams
205                            collect (add-one-shot-handler s f))))                            collect (add-one-shot-handler s f))))
206       (unwind-protect       (unwind-protect
# Line 449  the error-context redundant." Line 450  the error-context redundant."
450           (pos (c::compiler-read-error-position condition)))           (pos (c::compiler-read-error-position condition)))
451      (cond ((and (eq file :stream) *buffer-name*)      (cond ((and (eq file :stream) *buffer-name*)
452             (make-location (list :buffer *buffer-name*)             (make-location (list :buffer *buffer-name*)
453                            (list :position (+ *buffer-start-position* pos))))                            (list :offset *buffer-start-position* pos)))
454            ((and (pathnamep file) (not *buffer-name*))            ((and (pathnamep file) (not *buffer-name*))
455             (make-location (list :file (unix-truename file))             (make-location (list :file (unix-truename file))
456                            (list :position (1+ pos))))                            (list :position (1+ pos))))
# Line 474  Return a `location' record, or (:error R Line 475  Return a `location' record, or (:error R
475  (defun locate-compiler-note (file source source-path)  (defun locate-compiler-note (file source source-path)
476    (cond ((and (eq file :stream) *buffer-name*)    (cond ((and (eq file :stream) *buffer-name*)
477           ;; Compiling from a buffer           ;; Compiling from a buffer
478           (let ((position (+ *buffer-start-position*           (make-location (list :buffer *buffer-name*)
479                              (source-path-string-position                          (list :offset *buffer-start-position*
480                               source-path *buffer-substring*))))                                (source-path-string-position
481             (make-location (list :buffer *buffer-name*)                                 source-path *buffer-substring*))))
                           (list :position position))))  
482          ((and (pathnamep file) (null *buffer-name*))          ((and (pathnamep file) (null *buffer-name*))
483           ;; Compiling from a file           ;; Compiling from a file
484           (make-location (list :file (unix-truename file))           (make-location (list :file (unix-truename file))
485                          (list :position                          (list :position (1+ (source-path-file-position
486                                (1+ (source-path-file-position                                               source-path file)))))
                                    source-path file)))))  
487          ((and (eq file :lisp) (stringp source))          ((and (eq file :lisp) (stringp source))
488           ;; No location known, but we have the source form.           ;; No location known, but we have the source form.
489           ;; XXX How is this case triggered?  -luke (16/May/2004)           ;; XXX How is this case triggered?  -luke (16/May/2004)
# Line 784  This only succeeds if the code was compi Line 783  This only succeeds if the code was compi
783                      string)))                      string)))
784      (make-location      (make-location
785       (list :buffer (getf info :emacs-buffer))       (list :buffer (getf info :emacs-buffer))
786       (list :position (+ (getf info :emacs-buffer-offset) position))       (list :offset (getf info :emacs-buffer-offset) position)
787       (list :snippet (with-input-from-string (s string)       (list :snippet (with-input-from-string (s string)
788                        (file-position s position)                        (file-position s position)
789                        (read-snippet s))))))                        (read-snippet s))))))
# Line 1131  Signal an error if no constructor can be Line 1130  Signal an error if no constructor can be
1130        (with-input-from-string (s emacs-buffer-string)        (with-input-from-string (s emacs-buffer-string)
1131          (let ((pos (form-number-stream-position tlf-number form-number s)))          (let ((pos (form-number-stream-position tlf-number form-number s)))
1132            (make-location `(:buffer ,emacs-buffer)            (make-location `(:buffer ,emacs-buffer)
1133                           `(:position ,(+ emacs-buffer-offset pos))))))))                           `(:offset ,emacs-buffer-offset ,pos)))))))
1134    
1135  ;; XXX predicates for 18e backward compatibilty.  Remove them when  ;; XXX predicates for 18e backward compatibilty.  Remove them when
1136  ;; we're 19a only.  ;; we're 19a only.

Legend:
Removed from v.1.195  
changed lines
  Added in v.1.196

  ViewVC Help
Powered by ViewVC 1.1.5