/[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.116 by heller, Mon Sep 15 21:11:19 2008 UTC revision 1.117 by heller, Wed Sep 17 06:19:49 2008 UTC
# Line 459  Return NIL if the symbol is unbound." Line 459  Return NIL if the symbol is unbound."
459               (delete-file binary-filename))))               (delete-file binary-filename))))
460      (delete-file filename)))      (delete-file filename)))
461    
462  (defun dspec-buffer-position (dspec offset)  (defun dspec-function-name-position (dspec fallback)
463    (etypecase dspec    (etypecase dspec
464      (cons (let ((name (dspec:dspec-primary-name dspec)))      (cons (let ((name (dspec:dspec-primary-name dspec)))
465              (typecase name              (typecase name
466                ((or symbol string)                ((or symbol string)
467                 (list :function-name (string name)))                 (list :function-name (string name)))
468                (t (list :position offset)))))                (t fallback))))
469      (null (list :position offset))      (null fallback)
470      (symbol (list :function-name (string dspec)))))      (symbol (list :function-name (string dspec)))))
471    
472  (defmacro with-fairly-standard-io-syntax (&body body)  (defmacro with-fairly-standard-io-syntax (&body body)
# Line 480  Return NIL if the symbol is unbound." Line 480  Return NIL if the symbol is unbound."
480                (*readtable* ,readtable))                (*readtable* ,readtable))
481            ,@body)))))            ,@body)))))
482    
483    (defun skip-comments (stream)
484      (let ((pos0 (file-position stream)))
485        (cond ((equal (ignore-errors (list (read-delimited-list #\( stream)))
486                      '(()))
487               (file-position stream (1- (file-position stream))))
488              (t (file-position stream pos0)))))
489    
490  #-(or lispworks4.1 lispworks4.2) ; no dspec:parse-form-dspec prior to 4.3  #-(or lispworks4.1 lispworks4.2) ; no dspec:parse-form-dspec prior to 4.3
491  (defun dspec-stream-position (stream dspec)  (defun dspec-stream-position (stream dspec)
492    (with-fairly-standard-io-syntax    (with-fairly-standard-io-syntax
493      (loop (let* ((pos (file-position stream))      (loop (let* ((pos (progn (skip-comments stream) (file-position stream)))
494                   (form (read stream nil '#1=#:eof)))                   (form (read stream nil '#1=#:eof)))
495              (when (eq form '#1#)              (when (eq form '#1#)
496                (return nil))                (return nil))
# Line 517  Return NIL if the symbol is unbound." Line 524  Return NIL if the symbol is unbound."
524               #-(or lispworks4.1 lispworks4.2)               #-(or lispworks4.1 lispworks4.2)
525               (dspec-stream-position stream dspec)))               (dspec-stream-position stream dspec)))
526          (if pos          (if pos
527              (list :position (1+ pos) t)              (list :position (1+ pos))
528              (dspec-buffer-position dspec 1))))))              (dspec-function-name-position dspec `(:position 1)))))))
529    
530  (defun emacs-buffer-location-p (location)  (defun emacs-buffer-location-p (location)
531    (and (consp location)    (and (consp location)
# Line 540  Return NIL if the symbol is unbound." Line 547  Return NIL if the symbol is unbound."
547       (destructuring-bind (_ buffer offset string) location       (destructuring-bind (_ buffer offset string) location
548         (declare (ignore _ string))         (declare (ignore _ string))
549         (make-location `(:buffer ,buffer)         (make-location `(:buffer ,buffer)
550                        (dspec-buffer-position dspec offset)                        (dspec-function-name-position dspec `(:offset ,offset 0))
551                        hints)))))                        hints)))))
552    
553  (defun make-dspec-progenitor-location (dspec location)  (defun make-dspec-progenitor-location (dspec location)

Legend:
Removed from v.1.116  
changed lines
  Added in v.1.117

  ViewVC Help
Powered by ViewVC 1.1.5