/[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.117 by heller, Wed Sep 17 06:19:49 2008 UTC revision 1.118 by heller, Sat Oct 4 08:04:42 2008 UTC
# Line 73  Line 73 
73    
74  (defimplementation accept-connection (socket  (defimplementation accept-connection (socket
75                                        &key external-format buffering timeout)                                        &key external-format buffering timeout)
76    (declare (ignore buffering timeout external-format))    (declare (ignore buffering))
77    (let* ((fd (comm::get-fd-from-socket socket)))    (let* ((fd (comm::get-fd-from-socket socket)))
78      (assert (/= fd -1))      (assert (/= fd -1))
79      (make-instance 'comm:socket-stream :socket fd :direction :io      (assert (valid-external-format-p external-format))
80                     :element-type 'base-char)))      (cond ((member (first external-format) '(:latin-1 :ascii))
81               (make-instance 'comm:socket-stream
82                              :socket fd
83                              :direction :io
84                              :read-timeout timeout
85                              :element-type 'base-char))
86              (t
87               (make-flexi-stream
88                (make-instance 'comm:socket-stream
89                               :socket fd
90                               :direction :io
91                               :read-timeout timeout
92                               :element-type '(unsigned-byte 8))
93                external-format)))))
94    
95    (defun make-flexi-stream (stream external-format)
96      (unless (member :flexi-streams *features*)
97        (error "Cannot use external format ~A without having installed flexi-streams in the inferior-lisp."
98               external-format))
99      (funcall (read-from-string "FLEXI-STREAMS:MAKE-FLEXI-STREAM")
100               stream
101               :external-format
102               (apply (read-from-string "FLEXI-STREAMS:MAKE-EXTERNAL-FORMAT")
103                      external-format)))
104    
105  (defun set-sigint-handler ()  (defun set-sigint-handler ()
106    ;; Set SIGINT handler on Swank request handler thread.    ;; Set SIGINT handler on Swank request handler thread.
# Line 87  Line 110 
110    
111  ;;; Coding Systems  ;;; Coding Systems
112    
113    (defun valid-external-format-p (external-format)
114      (member external-format *external-format-to-coding-system*
115              :test #'equal :key #'car))
116    
117  (defvar *external-format-to-coding-system*  (defvar *external-format-to-coding-system*
118    '(((:latin-1 :eol-style :lf)    '(((:latin-1 :eol-style :lf)
119       "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")       "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
# Line 448  Return NIL if the symbol is unbound." Line 475  Return NIL if the symbol is unbound."
475                    :location location                    :location location
476                    :original-condition condition)))                    :original-condition condition)))
477    
478    (defvar *temp-file-format* '(:utf-8 :eol-style :lf))
479    
480  (defun compile-from-temp-file (string filename)  (defun compile-from-temp-file (string filename)
481    (unwind-protect    (unwind-protect
482         (progn         (progn
483           (with-open-file (s filename :direction :output :if-exists :supersede)           (with-open-file (s filename :direction :output
484                                         :if-exists :supersede
485                                         :external-format *temp-file-format*)
486    
487             (write-string string s)             (write-string string s)
488             (finish-output s))             (finish-output s))
489           (let ((binary-filename (compile-file filename :load t)))           (let ((binary-filename
490                    (compile-file filename :load t
491                                  :external-format *temp-file-format*)))
492             (when binary-filename             (when binary-filename
493               (delete-file binary-filename))))               (delete-file binary-filename))))
494      (delete-file filename)))      (delete-file filename)))

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

  ViewVC Help
Powered by ViewVC 1.1.5