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

Diff of /slime/swank.lisp

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

revision 1.30 by dbarlow, Thu Oct 16 02:05:56 2003 UTC revision 1.31 by heller, Thu Oct 16 11:08:40 2003 UTC
# Line 14  Line 14 
14      (:export #:start-server)))      (:export #:start-server)))
15    
16  (eval-when (:compile-toplevel :load-toplevel :execute)  (eval-when (:compile-toplevel :load-toplevel :execute)
17    (defvar swank::*sysdep-pathname*    (defparameter swank::*sysdep-pathname*
18      (merge-pathnames (or #+cmu "swank-cmucl"      (merge-pathnames (or #+cmu "swank-cmucl"
19                           #+(and sbcl sb-thread) "swank-sbcl"                           #+(and sbcl sb-thread) "swank-sbcl"
20                           #+openmcl "swank-openmcl")                           #+openmcl "swank-openmcl")
# Line 22  Line 22 
22                           *default-pathname-defaults*))))                           *default-pathname-defaults*))))
23    
24  (in-package :swank)  (in-package :swank)
25    
26  (defvar *swank-io-package*  (defvar *swank-io-package*
27    (let ((package (make-package "SWANK-IO-PACKAGE")))    (let ((package (make-package "SWANK-IO-PACKAGE")))
28      (import '(nil t quote) package)      (import '(nil t quote) package)
# Line 97  back to the main request handling loop." Line 98  back to the main request handling loop."
98      (force-output *emacs-io*)))      (force-output *emacs-io*)))
99    
100  (defun prin1-to-string-for-emacs (object)  (defun prin1-to-string-for-emacs (object)
101    (let ((*print-case* :downcase)    (with-standard-io-syntax
102          (*print-readably* nil)      (let ((*print-case* :downcase)
103          (*print-pretty* nil)            (*print-readably* nil)
104          (*package* *swank-io-package*))            (*print-pretty* nil)
105      (prin1-to-string object)))            (*package* *swank-io-package*))
106          (prin1-to-string object))))
107    
108  ;;; The Reader  ;;; The Reader
109    
# Line 112  back to the main request handling loop." Line 114  back to the main request handling loop."
114  EVAL-STRING binds *buffer-package*.  Strings originating from a slime  EVAL-STRING binds *buffer-package*.  Strings originating from a slime
115  buffer are best read in this package.  See also FROM-STRING and TO-STRING.")  buffer are best read in this package.  See also FROM-STRING and TO-STRING.")
116    
   
117  (defun from-string (string)  (defun from-string (string)
118    "Read string in the *BUFFER-PACKAGE*"    "Read string in the *BUFFER-PACKAGE*"
119    (let ((*package* *buffer-package*))    (let ((*package* *buffer-package*))
# Line 129  buffer are best read in this package.  S Line 130  buffer are best read in this package.  S
130                 (find-package (string-upcase name))))                 (find-package (string-upcase name))))
131        *package*))        *package*))
132    
   
133  ;;; public interface.  slimefuns are the things that emacs is allowed  ;;; public interface.  slimefuns are the things that emacs is allowed
134  ;;; to call  ;;; to call
135    
# Line 169  buffer are best read in this package.  S Line 169  buffer are best read in this package.  S
169        (let ((*print-pretty* t)        (let ((*print-pretty* t)
170              (*print-circle* t)              (*print-circle* t)
171              (*print-level* nil)              (*print-level* nil)
             #+cmu (ext:*gc-verbose* nil)  
172              (*print-length* nil))              (*print-length* nil))
173          (with-output-to-string (stream)          (with-output-to-string (stream)
174            (pprint value stream))))))            (pprint value stream))))))
# Line 178  buffer are best read in this package.  S Line 177  buffer are best read in this package.  S
177    (setq *package* (guess-package-from-string package))    (setq *package* (guess-package-from-string package))
178    (package-name *package*))    (package-name *package*))
179    
   
180  ;;;; Compilation Commands.  ;;;; Compilation Commands.
181    
182  (defvar *compiler-notes* '()  (defvar *compiler-notes* '()
# Line 211  Each value is a list of (LOCATION SEVERI Line 209  Each value is a list of (LOCATION SEVERI
209  \(See *NOTES-DATABASE* for a description of the return type.)"  \(See *NOTES-DATABASE* for a description of the return type.)"
210    (gethash (canonicalize-filename filename) *notes-database*))    (gethash (canonicalize-filename filename) *notes-database*))
211    
212    (defslimefun compiler-notes-for-emacs ()
213      "Return the list of compiler notes for the last compilation unit."
214      (reverse *compiler-notes*))
215    
216  (defun measure-time-interval (fn)  (defun measure-time-interval (fn)
217    "Call FN and return the first return value and the elapsed time.    "Call FN and return the first return value and the elapsed time.
218  The time is measured in microseconds."  The time is measured in microseconds."
# Line 236  The time is measured in microseconds." Line 238  The time is measured in microseconds."
238    ;; CMUCL used ext:map-apropos here, not sure why    ;; CMUCL used ext:map-apropos here, not sure why
239    (remove-if #'keywordp (apropos-list string package external-only)))    (remove-if #'keywordp (apropos-list string package external-only)))
240    
   
241  (defun print-output-to-string (fn)  (defun print-output-to-string (fn)
242    (with-output-to-string (*standard-output*)    (with-output-to-string (*standard-output*)
243      (let ((*debug-io* *standard-output*))      (let ((*debug-io* *standard-output*))
# Line 276  The time is measured in microseconds." Line 277  The time is measured in microseconds."
277    
278  ;;; Local Variables:  ;;; Local Variables:
279  ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))  ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
280  ;;; End:  ;;; End

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.31

  ViewVC Help
Powered by ViewVC 1.1.5