/[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.232 by heller, Sat Jan 10 12:25:16 2009 UTC revision 1.233 by trittweiler, Tue Jan 27 14:56:14 2009 UTC
# Line 32  Line 32 
32    ;; Generate a form suitable for testing for stepper support (0.9.17)    ;; Generate a form suitable for testing for stepper support (0.9.17)
33    ;; with #+.    ;; with #+.
34    (defun sbcl-with-new-stepper-p ()    (defun sbcl-with-new-stepper-p ()
35      (if (find-symbol "ENABLE-STEPPING" "SB-IMPL")      (with-symbol 'enable-stepping 'sb-impl))
         '(:and)  
         '(:or)))  
36    ;; Ditto for weak hash-tables    ;; Ditto for weak hash-tables
37    (defun sbcl-with-weak-hash-tables ()    (defun sbcl-with-weak-hash-tables ()
38      (if (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")      (with-symbol 'hash-table-weakness 'sb-ext))
         '(:and)  
         '(:or)))  
39    ;; And for xref support (1.0.1)    ;; And for xref support (1.0.1)
40    (defun sbcl-with-xref-p ()    (defun sbcl-with-xref-p ()
41      (if (find-symbol "WHO-CALLS" "SB-INTROSPECT")      (with-symbol 'who-calls 'sb-introspect))
         '(:and)  
         '(:or)))  
42    ;; ... for restart-frame support (1.0.2)    ;; ... for restart-frame support (1.0.2)
43    (defun sbcl-with-restart-frame ()    (defun sbcl-with-restart-frame ()
44      (if (find-symbol "FRAME-HAS-DEBUG-TAG-P" "SB-DEBUG")      (with-symbol 'frame-has-debug-tag-p 'sb-debug)))
         '(:and)  
         '(:or)))  
   (defun sbcl-with-symbol (name package)  
     (if (find-symbol (string name) (string package))  
         '(:and)  
         '(:or)))  
   )  
45    
46  ;;; swank-mop  ;;; swank-mop
47    
# Line 335  Line 322 
322    
323  ;;; Utilities  ;;; Utilities
324    
325  #+#.(swank-backend::sbcl-with-symbol 'function-lambda-list 'sb-introspect)  #+#.(swank-backend::with-symbol 'function-lambda-list 'sb-introspect)
326  (defimplementation arglist (fname)  (defimplementation arglist (fname)
327    (sb-introspect:function-lambda-list fname))    (sb-introspect:function-lambda-list fname))
328    
329  #-#.(swank-backend::sbcl-with-symbol 'function-lambda-list 'sb-introspect)  #-#.(swank-backend::with-symbol 'function-lambda-list 'sb-introspect)
330  (defimplementation arglist (fname)  (defimplementation arglist (fname)
331    (sb-introspect:function-arglist fname))    (sb-introspect:function-arglist fname))
332    
# Line 359  Line 346 
346                                    flags :key #'ensure-list))                                    flags :key #'ensure-list))
347            (call-next-method)))))            (call-next-method)))))
348    
349  #+#.(swank-backend::sbcl-with-symbol 'deftype-lambda-list 'sb-introspect)  #+#.(swank-backend::with-symbol 'deftype-lambda-list 'sb-introspect)
350  (defmethod type-specifier-arglist :around (typespec-operator)  (defmethod type-specifier-arglist :around (typespec-operator)
351    (multiple-value-bind (arglist foundp)    (multiple-value-bind (arglist foundp)
352        (sb-introspect:deftype-lambda-list typespec-operator)        (sb-introspect:deftype-lambda-list typespec-operator)
# Line 518  compiler state." Line 505  compiler state."
505    
506  (defun get-compiler-policy (default-policy)  (defun get-compiler-policy (default-policy)
507    (declare (ignorable default-policy))    (declare (ignorable default-policy))
508    #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)    #+#.(swank-backend::with-symbol 'restrict-compiler-policy 'sb-ext)
509    (remove-duplicates (append default-policy (sb-ext:restrict-compiler-policy))    (remove-duplicates (append default-policy (sb-ext:restrict-compiler-policy))
510                       :key #'car))                       :key #'car))
511    
512  (defun set-compiler-policy (policy)  (defun set-compiler-policy (policy)
513    (declare (ignorable policy))    (declare (ignorable policy))
514    #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)    #+#.(swank-backend::with-symbol 'restrict-compiler-policy 'sb-ext)
515     (loop for (qual . value) in policy     (loop for (qual . value) in policy
516           do (sb-ext:restrict-compiler-policy qual value)))           do (sb-ext:restrict-compiler-policy qual value)))
517    
# Line 762  Return NIL if the symbol is unbound." Line 749  Return NIL if the symbol is unbound."
749    (defxref who-sets)    (defxref who-sets)
750    (defxref who-references)    (defxref who-references)
751    (defxref who-macroexpands)    (defxref who-macroexpands)
752    #+#.(swank-backend::sbcl-with-symbol 'who-specializes 'sb-introspect)    #+#.(swank-backend::with-symbol 'who-specializes 'sb-introspect)
753    (defxref who-specializes))    (defxref who-specializes))
754    
755  (defun source-location-for-xref-data (xref-data)  (defun source-location-for-xref-data (xref-data)
# Line 933  stack." Line 920  stack."
920           (plist (sb-c::debug-source-plist dsource)))           (plist (sb-c::debug-source-plist dsource)))
921      (if (getf plist :emacs-buffer)      (if (getf plist :emacs-buffer)
922          (emacs-buffer-source-location code-location plist)          (emacs-buffer-source-location code-location plist)
923          #+#.(swank-backend::sbcl-with-symbol 'debug-source-from 'sb-di)          #+#.(swank-backend::with-symbol 'debug-source-from 'sb-di)
924          (ecase (sb-di:debug-source-from dsource)          (ecase (sb-di:debug-source-from dsource)
925            (:file (file-source-location code-location))            (:file (file-source-location code-location))
926            (:lisp (lisp-source-location code-location)))            (:lisp (lisp-source-location code-location)))
927          #-#.(swank-backend::sbcl-with-symbol 'debug-source-from 'sb-di)          #-#.(swank-backend::with-symbol 'debug-source-from 'sb-di)
928          (if (sb-di:debug-source-namestring dsource)          (if (sb-di:debug-source-namestring dsource)
929              (file-source-location code-location)              (file-source-location code-location)
930              (lisp-source-location code-location)))))              (lisp-source-location code-location)))))
# Line 994  stack." Line 981  stack."
981                           `(:snippet ,snippet)))))))                           `(:snippet ,snippet)))))))
982    
983  (defun code-location-debug-source-name (code-location)  (defun code-location-debug-source-name (code-location)
984    (namestring (truename (#+#.(swank-backend::sbcl-with-symbol    (namestring (truename (#+#.(swank-backend::with-symbol
985                                'debug-source-name 'sb-di)                                'debug-source-name 'sb-di)
986                               sb-c::debug-source-name                               sb-c::debug-source-name
987                               #-#.(swank-backend::sbcl-with-symbol                               #-#.(swank-backend::with-symbol
988                                    'debug-source-name 'sb-di)                                    'debug-source-name 'sb-di)
989                               sb-c::debug-source-namestring                               sb-c::debug-source-namestring
990                           (sb-di::code-location-debug-source code-location)))))                           (sb-di::code-location-debug-source code-location)))))

Legend:
Removed from v.1.232  
changed lines
  Added in v.1.233

  ViewVC Help
Powered by ViewVC 1.1.5