Permalink
Browse files

(find-external-format, guess-external-format): New.

(swank-compile-file): The external-format argument is now a
backend specific value returned by find-external-format.

Update implementations accordingly.
  • Loading branch information...
1 parent 3556025 commit 5fb5464a416e2419c1ed23f0a0121b6d734b6aef Helmut Eller committed Nov 19, 2006
Showing with 191 additions and 145 deletions.
  1. +3 −5 swank-abcl.lisp
  2. +21 −27 swank-allegro.lisp
  3. +46 −2 swank-backend.lisp
  4. +30 −20 swank-clisp.lisp
  5. +3 −9 swank-cmucl.lisp
  6. +3 −5 swank-corman.lisp
  7. +9 −6 swank-ecl.lisp
  8. +21 −14 swank-lispworks.lisp
  9. +2 −5 swank-openmcl.lisp
  10. +30 −28 swank-sbcl.lisp
  11. +23 −24 swank-scl.lisp
View
@@ -1,4 +1,4 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
;;;
;;; swank-abcl.lisp --- Armedbear CL specific code for SLIME.
;;;
@@ -135,8 +135,7 @@
(defimplementation accept-connection (socket
&key external-format buffering timeout)
- (declare (ignore buffering timeout))
- (assert (member external-format '(nil :iso-latin-1-unix)))
+ (declare (ignore buffering timeout external-format))
(ext:get-socket-stream (ext:socket-accept socket)))
;;;; Unix signals
@@ -303,8 +302,7 @@
(defvar *abcl-signaled-conditions*)
-(defimplementation swank-compile-file (filename load-p
- &optional external-format)
+(defimplementation swank-compile-file (filename load-p external-format)
(declare (ignore external-format))
(let ((jvm::*resignal-compiler-warnings* t)
(*abcl-signaled-conditions* nil))
View
@@ -18,8 +18,6 @@
;;; swank-mop
-;; maybe better change MOP to ACLMOP ?
-;; CLOS also works in ACL5. --he
(import-swank-mop-symbols :clos '(:slot-definition-documentation))
(defun swank-mop:slot-definition-documentation (slot)
@@ -44,25 +42,26 @@
(defimplementation accept-connection (socket &key external-format buffering
timeout)
(declare (ignore buffering timeout))
- (let ((ef (or external-format :iso-latin-1-unix))
- (s (socket:accept-connection socket :wait t)))
- (set-external-format s ef)
+ (let ((s (socket:accept-connection socket :wait t)))
+ (when external-format
+ (setf (stream-external-format s) external-format))
s))
-(defun find-external-format (coding-system)
- #+(version>= 6)
- (let* ((name (ecase coding-system
- (:iso-latin-1-unix :latin1)
- (:utf-8-unix :utf8)
- (:emacs-mule-unix :emacs-mule))))
- (excl:crlf-base-ef (excl:find-external-format name :try-variant t)))
- #-(version>= 6)
- (ecase coding-system
- (:iso-latin-1-unix :default)))
-
-(defun set-external-format (stream external-format)
- (setf (stream-external-format stream)
- (find-external-format external-format)))
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")
+ (:us-ascii "us-ascii" "us-ascii-unix")
+ (:emacs-mule "emacs-mule" "emacs-mule-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (let ((e (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+ (and e (excl:crlf-base-ef
+ (excl:find-external-format (car e)
+ :try-variant t)))))
(defimplementation format-sldb-condition (c)
(princ-to-string c))
@@ -237,7 +236,6 @@
(member (type-of object) '(excl::compiler-note compiler::compiler-note)))
(defun compiler-undefined-functions-called-warning-p (object)
- #+(version>= 6)
(typep object 'excl:compiler-undefined-functions-called-warning))
(deftype compiler-note ()
@@ -292,16 +290,12 @@
)
(funcall function)))
-(defimplementation swank-compile-file (filename load-p
- &optional external-format)
+(defimplementation swank-compile-file (filename load-p external-format)
(with-compilation-hooks ()
(let ((*buffer-name* nil)
- (*compile-filename* filename)
- (ef (if external-format
- (find-external-format external-format)
- :default)))
+ (*compile-filename* filename))
(compile-file *compile-filename* :load-after-compile load-p
- :external-format ef))))
+ :external-format external-format))))
(defun call-with-temp-file (fn)
(let ((tmpname (system:make-temp-file-name)))
View
@@ -370,9 +370,11 @@ Example:
(abort-request "Couldn't find ASDF operation ~S" operation-name))
(apply operate operation system-name keyword-args))))
-(definterface swank-compile-file (filename load-p &optional external-format)
+(definterface swank-compile-file (filename load-p external-format)
"Compile FILENAME signalling COMPILE-CONDITIONs.
-If LOAD-P is true, load the file after compilation.")
+If LOAD-P is true, load the file after compilation.
+EXTERNAL-FORMAT is a value returned by find-external-format or
+:default.")
(deftype severity ()
'(member :error :read-error :warning :style-warning :note))
@@ -404,6 +406,48 @@ If LOAD-P is true, load the file after compilation.")
(location :initarg :location
:accessor location)))
+(definterface find-external-format (coding-system)
+ "Return a \"external file format designator\" for CODING-SYSTEM.
+CODING-SYSTEM is Emacs-style coding system name (a string),
+e.g. \"latin-1-unix\"."
+ (if (equal coding-system "iso-latin-1-unix")
+ :default
+ nil))
+
+(definterface guess-external-format (filename)
+ "Detect the external format for the file with name FILENAME.
+Return nil if the file contains no special markers."
+ ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
+ (with-open-file (s filename :if-does-not-exist nil
+ :external-format (or (find-external-format "latin-1-unix")
+ :default))
+ (or (let* ((line (read-line s nil))
+ (p (search "-*-" line)))
+ (when p
+ (let* ((start (+ p (length "-*-")))
+ (end (search "-*-" line :start2 start)))
+ (when end
+ (%search-coding line start end)))))
+ (let* ((len (file-length s))
+ (buf (make-string (min len 3000))))
+ (file-position s (- len (length buf)))
+ (read-sequence buf s)
+ (let ((start (search "Local Variables:" buf :from-end t))
+ (end (search "End:" buf :from-end t)))
+ (and start end (< start end)
+ (%search-coding buf start end)))))))
+
+(defun %search-coding (str start end)
+ (let ((p (search "coding:" str :start2 start :end2 end)))
+ (when p
+ (incf p (length "coding:"))
+ (loop while (and (< p end)
+ (member (aref str p) '(#\space #\tab)))
+ do (incf p))
+ (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
+ str :start p)))
+ (find-external-format (subseq str p end))))))
+
;;;; Streams
View
@@ -116,22 +116,35 @@
(defimplementation close-socket (socket)
(socket:socket-server-close socket))
-
-(defun find-encoding (external-format)
- (let ((charset (ecase external-format
- (:iso-latin-1-unix "iso-8859-1")
- (:utf-8-unix "utf-8")
- (:euc-jp-unix "euc-jp"))))
- (ext:make-encoding :charset charset :line-terminator :unix)))
(defimplementation accept-connection (socket
&key external-format buffering timeout)
(declare (ignore buffering timeout))
- (setq external-format (or external-format :iso-latin-1-unix))
(socket:socket-accept socket
:buffered nil ;; XXX should be t
:element-type 'character
- :external-format (find-encoding external-format)))
+ :external-format external-format))
+
+;;; Coding systems
+
+(defvar *external-format-to-coding-system*
+ '(((:charset "iso-8859-1" :line-terminator :unix)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ ((:charset "iso-8859-1":latin-1)
+ "latin-1" "iso-latin-1" "iso-8859-1")
+ ((:charset "utf-8") "utf-8")
+ ((:charset "utf-8" :line-terminator :unix) "utf-8-unix")
+ ((:charset "euc-jp") "euc-jp")
+ ((:charset "euc-jp" :line-terminator :unix) "euc-jp-unix")
+ ((:charset "us-ascii") "us-ascii")
+ ((:charset "us-ascii" :line-terminator :unix) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (let ((args (car (rassoc-if (lambda (x)
+ (member coding-system x :test #'equal))
+ *external-format-to-coding-system*))))
+ (and args (apply #'ext:make-encoding args))))
+
;;; Swank functions
@@ -467,17 +480,14 @@ Execute BODY with NAME's function slot set to FUNCTION."
:message (princ-to-string condition)
:location (compiler-note-location))))
-(defimplementation swank-compile-file (filename load-p
- &optional external-format)
- (let ((ef (if external-format
- (find-encoding external-format)
- :default)))
- (with-compilation-hooks ()
- (with-compilation-unit ()
- (let ((fasl-file (compile-file filename :external-format ef)))
- (when (and load-p fasl-file)
- (load fasl-file))
- nil)))))
+(defimplementation swank-compile-file (filename load-p external-format)
+ (with-compilation-hooks ()
+ (with-compilation-unit ()
+ (let ((fasl-file (compile-file filename
+ :external-format external-format)))
+ (when (and load-p fasl-file)
+ (load fasl-file))
+ nil))))
(defimplementation swank-compile-string (string &key buffer position directory)
(declare (ignore directory))
View
@@ -100,13 +100,8 @@
(defimplementation accept-connection (socket &key
external-format buffering timeout)
- (declare (ignore timeout))
- (let ((ef (or external-format :iso-latin-1-unix))
- (buffering (or buffering :full)))
- (unless (eq ef ':iso-latin-1-unix)
- (remove-fd-handlers socket)
- (remove-sigio-handlers socket)
- (error "External format ~S not supported" ef))
+ (declare (ignore timeout external-format))
+ (let ((buffering (or buffering :full)))
(make-socket-io-stream (ext:accept-tcp-connection socket) buffering)))
;;;;; Sockets
@@ -338,8 +333,7 @@ NIL if we aren't compiling from a buffer.")
(c::warning #'handle-notification-condition))
(funcall function))))
-(defimplementation swank-compile-file (filename load-p
- &optional external-format)
+(defimplementation swank-compile-file (filename load-p external-format)
(declare (ignore external-format))
(clear-xref-info filename)
(with-compilation-hooks ()
View
@@ -239,10 +239,8 @@
(defimplementation accept-connection (socket
&key external-format buffering timeout)
- (declare (ignore buffering timeout))
- (ecase (or external-format :iso-latin-1-unix)
- (:iso-latin-1-unix
- (sockets:make-socket-stream (sockets:accept-socket socket)))))
+ (declare (ignore buffering timeout external-format))
+ (sockets:make-socket-stream (sockets:accept-socket socket)))
;;; Misc
@@ -367,7 +365,7 @@
(funcall fn)))
(defimplementation swank-compile-file (*compile-filename* load-p
- &optional external-format)
+ external-format)
(declare (ignore external-format))
(with-compilation-hooks ()
(let ((*buffer-name* nil))
View
@@ -1,6 +1,10 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;; -*- indent-tabs-mode: nil -*-
;;;
;;; swank-ecl.lisp --- SLIME backend for ECL.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
;;; Administrivia
@@ -42,11 +46,10 @@
(defimplementation accept-connection (socket
&key external-format
buffering timeout)
- (declare (ignore buffering timeout))
- (assert (eq external-format :iso-latin-1-unix))
- (make-socket-io-stream (accept socket) external-format))
+ (declare (ignore buffering timeout external-format))
+ (make-socket-io-stream (accept socket)))
-(defun make-socket-io-stream (socket external-format)
+(defun make-socket-io-stream (socket)
(sb-bsd-sockets:socket-make-stream socket
:output t
:input t
@@ -118,7 +121,7 @@
(funcall function)))
(defimplementation swank-compile-file (*compile-filename* load-p
- &optional external-format)
+ external-format)
(declare (ignore external-format))
(with-compilation-hooks ()
(let ((*buffer-name* nil))
View
@@ -67,25 +67,36 @@
(defimplementation accept-connection (socket
&key external-format buffering timeout)
- (declare (ignore buffering timeout))
- (assert (member external-format '(nil :iso-latin-1-unix)))
+ (declare (ignore buffering timeout external-format))
(let* ((fd (comm::get-fd-from-socket socket)))
(assert (/= fd -1))
(make-instance 'comm:socket-stream :socket fd :direction :io
:element-type 'base-char)))
-(defun find-external-format (coding-system &optional default)
- (case coding-system
- (:iso-latin-1-unix '(:latin-1 :eol-style :lf))
- (:utf-8-unix '(:utf-8 :eol-style :lf))
- (t default)))
-
(defun set-sigint-handler ()
;; Set SIGINT handler on Swank request handler thread.
#-win32
(sys::set-signal-handler +sigint+
(make-sigint-handler mp:*current-process*)))
+;;; Coding Systems
+
+(defvar *external-format-to-coding-system*
+ '(((:latin-1 :eol-style :lf)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ ((:latin-1)
+ "latin-1" "iso-latin-1" "iso-8859-1")
+ ((:utf-8) "utf-8")
+ ((:utf-8 :eol-style :lf) "utf-8-unix")
+ ((:euc-jp) "euc-jp")
+ ((:euc-jp :eol-style :lf) "euc-jp-unix")
+ ((:ascii) "us-ascii")
+ ((:ascii :eol-style :lf) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
;;; Unix signals
(defun sigint-handler ()
@@ -362,13 +373,9 @@ Return NIL if the symbol is unbound."
(signal-error-data-base compiler::*error-database* ,location)
(signal-undefined-functions compiler::*unknown-functions* ,location)))))
-(defimplementation swank-compile-file (filename load-p
- &optional external-format)
+(defimplementation swank-compile-file (filename load-p external-format)
(with-swank-compilation-unit (filename)
- (let ((ef (if external-format
- (find-external-format external-format)
- :default)))
- (compile-file filename :load load-p :external-format ef))))
+ (compile-file filename :load load-p :external-format external-format)))
(defvar *within-call-with-compilation-hooks* nil
"Whether COMPILE-FILE was called from within CALL-WITH-COMPILATION-HOOKS.")
Oops, something went wrong.

0 comments on commit 5fb5464

Please sign in to comment.