/[cmucl]/src/code/extfmts.lisp
ViewVC logotype

Diff of /src/code/extfmts.lisp

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

revision 1.20 by rtoy, Sun Oct 18 14:21:23 2009 UTC revision 1.20.4.3 by rtoy, Thu Mar 18 22:17:15 2010 UTC
# Line 13  Line 13 
13    
14  (in-package "STREAM")  (in-package "STREAM")
15    
16    (intl:textdomain "cmucl")
17    
18  (export '(string-to-octets octets-to-string *default-external-format*  (export '(string-to-octets octets-to-string *default-external-format*
19            string-encode string-decode set-system-external-format            string-encode string-decode set-system-external-format
20            +replacement-character-code+))            +replacement-character-code+))
# Line 44  Line 46 
46    (:report    (:report
47      (lambda (condition stream)      (lambda (condition stream)
48        (declare (ignore condition))        (declare (ignore condition))
49        (format stream "Attempting unimplemented external-format I/O."))))        (format stream _"Attempting unimplemented external-format I/O."))))
50    
51  (defun %efni (a b c d)  (defun %efni (a b c d)
52    (declare (ignore a b c d))    (declare (ignore a b c d))
# Line 187  Line 189 
189                                         &optional octets-to-code code-to-octets                                         &optional octets-to-code code-to-octets
190                                         flush-state copy-state)                                         flush-state copy-state)
191    (when (and (oddp (length args)) (not (= (length args) 1)))    (when (and (oddp (length args)) (not (= (length args) 1)))
192      (warn "Nonsensical argument (~S) to DEFINE-EXTERNAL-FORMAT." args))      (warn _"Nonsensical argument (~S) to DEFINE-EXTERNAL-FORMAT." args))
193    (let* ((tmp (gensym))    (let* ((tmp (gensym))
194           (min (if (evenp (length args))           (min (if (evenp (length args))
195                    (or (getf args :min) (getf args :size) 1)                    (or (getf args :min) (getf args :size) 1)
# Line 329  Line 331 
331               (value (read stm nil stm) (read stm nil stm)))               (value (read stm nil stm) (read stm nil stm)))
332              ((or (eq alias stm) (eq value stm))              ((or (eq alias stm) (eq value stm))
333               (unless (eq alias stm)               (unless (eq alias stm)
334                 (warn "External-format aliases file ends early.")))                 (warn _"External-format aliases file ends early.")))
335            (if (and (keywordp alias) (or (keywordp value)            (if (and (keywordp alias) (or (keywordp value)
336                                          (and (consp value)                                          (and (consp value)
337                                               (every #'keywordp value))))                                               (every #'keywordp value))))
338                (setf (gethash alias *external-format-aliases*) value)                (setf (gethash alias *external-format-aliases*) value)
339                (warn "Bad entry in external-format aliases file: ~S => ~S."                (warn _"Bad entry in external-format aliases file: ~S => ~S."
340                      alias value)))))))                      alias value)))))))
341    
342  (defun %find-external-format (name)  (defun %find-external-format (name)
# Line 355  Line 357 
357         (cnt 0 (1+ cnt)))         (cnt 0 (1+ cnt)))
358        ((or (null tmp) (= cnt 50))        ((or (null tmp) (= cnt 50))
359         (unless (null tmp)         (unless (null tmp)
360           (error "External-format aliasing depth exceeded.")))           (error _"External-format aliasing depth exceeded.")))
361      (setq name tmp))      (setq name tmp))
362    
363    (or (gethash name *external-formats*)    (or (gethash name *external-formats*)
364        (and (consp name) (find-external-format name))        (and (consp name) (find-external-format name))
365        (and (let ((*package* (find-package "STREAM"))        (and (with-standard-io-syntax
366                   (lisp::*enable-package-locked-errors* nil)               ;; Use standard IO syntax so that changes by the user
367                   (s (open (format nil "ext-formats:~(~A~).lisp" name)               ;; don't mess up compiling the external format.
368                            :if-does-not-exist nil :external-format :iso8859-1)))               (let ((*package* (find-package "STREAM"))
369               (when s                     (lisp::*enable-package-locked-errors* nil)
370                 (null (nth-value 1 (ext:compile-from-stream s)))))                     (s (open (format nil "ext-formats:~(~A~).lisp" name)
371                                :if-does-not-exist nil :external-format :iso8859-1)))
372                   (when s
373                     (null (nth-value 1 (ext:compile-from-stream s))))))
374             (gethash name *external-formats*))))             (gethash name *external-formats*))))
375    
376  (defun %composed-ef-name (a b)  (defun %composed-ef-name (a b)
# Line 373  Line 378 
378    
379  (defun %compose-external-formats (a b)  (defun %compose-external-formats (a b)
380    (when (ef-composingp a)    (when (ef-composingp a)
381      (error "~S is a Composing-External-Format." (ef-name a)))      (error _"~S is a Composing-External-Format." (ef-name a)))
382    (unless (ef-composingp b)    (unless (ef-composingp b)
383      (error "~S is not a Composing-External-Format." (ef-name b)))      (error _"~S is not a Composing-External-Format." (ef-name b)))
384    (make-external-format    (make-external-format
385     (%composed-ef-name (ef-name a) (ef-name b))     (%composed-ef-name (ef-name a) (ef-name b))
386     (make-efx     (make-efx
# Line 407  Line 412 
412      (return-from find-external-format name))      (return-from find-external-format name))
413    
414    (or (if (consp name) (every #'keywordp name) (keywordp name))    (or (if (consp name) (every #'keywordp name) (keywordp name))
415        (error "~S is not a valid external format name." name))        (error _"~S is not a valid external format name." name))
416    
417    (when (eq name :default)    (when (eq name :default)
418      (setq name *default-external-format*))      (setq name *default-external-format*))
# Line 418  Line 423 
423    (flet ((not-found ()    (flet ((not-found ()
424             (when (equal *default-external-format* name)             (when (equal *default-external-format* name)
425               (setq *default-external-format* :iso8859-1))               (setq *default-external-format* :iso8859-1))
426             (if error-p (error "External format ~S not found." name) nil)))             (if error-p (error _"External format ~S not found." name) nil)))
427      (if (consp name)      (if (consp name)
428          (let ((efs (mapcar #'%find-external-format name)))          (let ((efs (mapcar #'%find-external-format name)))
429            (if (member nil efs)            (if (member nil efs)
# Line 505  Line 510 
510    (:report    (:report
511      (lambda (condition stream)      (lambda (condition stream)
512        (declare (ignore condition))        (declare (ignore condition))
513        (format stream "Attempting I/O through void external-format."))))        (format stream _"Attempting I/O through void external-format."))))
514    
515  (define-external-format :void (:size 0) ()  (define-external-format :void (:size 0) ()
516    (octets-to-code (state input unput)    (octets-to-code (state input unput)
# Line 678  Line 683 
683    
684  (defun string-to-octets (string &key (start 0) end (external-format :default)  (defun string-to-octets (string &key (start 0) end (external-format :default)
685                                       (buffer nil bufferp))                                       (buffer nil bufferp))
686    "Convert String to octets using the specified External-format.  The    _N"Convert String to octets using the specified External-format.  The
687     string is bounded by Start (defaulting to 0) and End (defaulting to     string is bounded by Start (defaulting to 0) and End (defaulting to
688     the end of the string.  If Buffer is given, the octets are stored     the end of the string.  If Buffer is given, the octets are stored
689     there.  If not, a new buffer is created."     there.  If not, a new buffer is created."
# Line 718  Line 723 
723                                       (string nil stringp)                                       (string nil stringp)
724                                       (s-start 0) (s-end nil s-end-p)                                       (s-start 0) (s-end nil s-end-p)
725                                       (state nil))                                       (state nil))
726    "Octets-to-string converts an array of octets in Octets to a string    _N"Octets-to-string converts an array of octets in Octets to a string
727    according to the specified External-format.  The array of octets is    according to the specified External-format.  The array of octets is
728    bounded by Start (defaulting ot 0) and End (defaulting to the end of    bounded by Start (defaulting ot 0) and End (defaulting to the end of
729    the array.  If String is not given, a new string is created.  If    the array.  If String is not given, a new string is created.  If
# Line 768  Line 773 
773                               (code-char b)))))))                               (code-char b)))))))
774    
775  (defun string-encode (string external-format &optional (start 0) end)  (defun string-encode (string external-format &optional (start 0) end)
776    "Encode the given String using External-Format and return a new    _N"Encode the given String using External-Format and return a new
777    string.  The characters of the new string are the octets of the    string.  The characters of the new string are the octets of the
778    encoded result, with each octet converted to a character via    encoded result, with each octet converted to a character via
779    code-char.  This is the inverse to String-Decode"    code-char.  This is the inverse to String-Decode"
# Line 801  Line 806 
806          finally (return (values result (1+ pos))))))          finally (return (values result (1+ pos))))))
807    
808  (defun string-decode (string external-format &optional (start 0) end)  (defun string-decode (string external-format &optional (start 0) end)
809    "Decode String using the given External-Format and return the new    _N"Decode String using the given External-Format and return the new
810    string.  The input string is treated as if it were an array of    string.  The input string is treated as if it were an array of
811    octets, where the char-code of each character is the octet.  This is    octets, where the char-code of each character is the octet.  This is
812    the inverse of String-Encode."    the inverse of String-Encode."
# Line 815  Line 820 
820    
821    
822  (defun set-system-external-format (terminal &optional filenames)  (defun set-system-external-format (terminal &optional filenames)
823    "Change the external format of the standard streams to Terminal.    _N"Change the external format of the standard streams to Terminal.
824    The standard streams are sys::*stdin*, sys::*stdout*, and    The standard streams are sys::*stdin*, sys::*stdout*, and
825    sys::*stderr*, which are normally the input and/or output streams    sys::*stderr*, which are normally the input and/or output streams
826    for *standard-input* and *standard-output*.  Also sets sys::*tty*    for *standard-input* and *standard-output*.  Also sets sys::*tty*
# Line 823  Line 828 
828    optional argument Filenames is gvien, then the filename encoding is    optional argument Filenames is gvien, then the filename encoding is
829    set to the specified format."    set to the specified format."
830    (unless (find-external-format terminal)    (unless (find-external-format terminal)
831      (error "Can't find external-format ~S." terminal))      (error _"Can't find external-format ~S." terminal))
832    (setf (stream-external-format sys:*stdin*) terminal    (setf (stream-external-format sys:*stdin*) terminal
833          (stream-external-format sys:*stdout*) terminal          (stream-external-format sys:*stdout*) terminal
834          (stream-external-format sys:*stderr*) terminal)          (stream-external-format sys:*stderr*) terminal)
# Line 831  Line 836 
836      (setf (stream-external-format sys:*tty*) terminal))      (setf (stream-external-format sys:*tty*) terminal))
837    (when filenames    (when filenames
838      (unless (find-external-format filenames)      (unless (find-external-format filenames)
839        (error "Can't find external-format ~S." filenames))        (error _"Can't find external-format ~S." filenames))
840      (when (and unix::*filename-encoding*      (when (and unix::*filename-encoding*
841                 (not (eq unix::*filename-encoding* filenames)))                 (not (eq unix::*filename-encoding* filenames)))
842        (cerror "Change it anyway."        (cerror _"Change it anyway."
843                "The external-format for encoding filenames is already set.")                _"The external-format for encoding filenames is already set.")
844        (setq unix::*filename-encoding* filenames)))        (setq unix::*filename-encoding* filenames)))
845    t)    t)
846    

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.20.4.3

  ViewVC Help
Powered by ViewVC 1.1.5