/[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.4.1 by rtoy, Mon Feb 8 17:15:47 2010 UTC revision 1.20.4.2 by rtoy, Tue Feb 9 15:18:21 2010 UTC
# Line 46  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 189  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 331  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 357  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*)
# Line 375  Line 375 
375    
376  (defun %compose-external-formats (a b)  (defun %compose-external-formats (a b)
377    (when (ef-composingp a)    (when (ef-composingp a)
378      (error "~S is a Composing-External-Format." (ef-name a)))      (error _"~S is a Composing-External-Format." (ef-name a)))
379    (unless (ef-composingp b)    (unless (ef-composingp b)
380      (error "~S is not a Composing-External-Format." (ef-name b)))      (error _"~S is not a Composing-External-Format." (ef-name b)))
381    (make-external-format    (make-external-format
382     (%composed-ef-name (ef-name a) (ef-name b))     (%composed-ef-name (ef-name a) (ef-name b))
383     (make-efx     (make-efx
# Line 409  Line 409 
409      (return-from find-external-format name))      (return-from find-external-format name))
410    
411    (or (if (consp name) (every #'keywordp name) (keywordp name))    (or (if (consp name) (every #'keywordp name) (keywordp name))
412        (error "~S is not a valid external format name." name))        (error _"~S is not a valid external format name." name))
413    
414    (when (eq name :default)    (when (eq name :default)
415      (setq name *default-external-format*))      (setq name *default-external-format*))
# Line 420  Line 420 
420    (flet ((not-found ()    (flet ((not-found ()
421             (when (equal *default-external-format* name)             (when (equal *default-external-format* name)
422               (setq *default-external-format* :iso8859-1))               (setq *default-external-format* :iso8859-1))
423             (if error-p (error "External format ~S not found." name) nil)))             (if error-p (error _"External format ~S not found." name) nil)))
424      (if (consp name)      (if (consp name)
425          (let ((efs (mapcar #'%find-external-format name)))          (let ((efs (mapcar #'%find-external-format name)))
426            (if (member nil efs)            (if (member nil efs)
# Line 507  Line 507 
507    (:report    (:report
508      (lambda (condition stream)      (lambda (condition stream)
509        (declare (ignore condition))        (declare (ignore condition))
510        (format stream "Attempting I/O through void external-format."))))        (format stream _"Attempting I/O through void external-format."))))
511    
512  (define-external-format :void (:size 0) ()  (define-external-format :void (:size 0) ()
513    (octets-to-code (state input unput)    (octets-to-code (state input unput)
# Line 680  Line 680 
680    
681  (defun string-to-octets (string &key (start 0) end (external-format :default)  (defun string-to-octets (string &key (start 0) end (external-format :default)
682                                       (buffer nil bufferp))                                       (buffer nil bufferp))
683    "Convert String to octets using the specified External-format.  The    _N"Convert String to octets using the specified External-format.  The
684     string is bounded by Start (defaulting to 0) and End (defaulting to     string is bounded by Start (defaulting to 0) and End (defaulting to
685     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
686     there.  If not, a new buffer is created."     there.  If not, a new buffer is created."
# Line 720  Line 720 
720                                       (string nil stringp)                                       (string nil stringp)
721                                       (s-start 0) (s-end nil s-end-p)                                       (s-start 0) (s-end nil s-end-p)
722                                       (state nil))                                       (state nil))
723    "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
724    according to the specified External-format.  The array of octets is    according to the specified External-format.  The array of octets is
725    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
726    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 770  Line 770 
770                               (code-char b)))))))                               (code-char b)))))))
771    
772  (defun string-encode (string external-format &optional (start 0) end)  (defun string-encode (string external-format &optional (start 0) end)
773    "Encode the given String using External-Format and return a new    _N"Encode the given String using External-Format and return a new
774    string.  The characters of the new string are the octets of the    string.  The characters of the new string are the octets of the
775    encoded result, with each octet converted to a character via    encoded result, with each octet converted to a character via
776    code-char.  This is the inverse to String-Decode"    code-char.  This is the inverse to String-Decode"
# Line 803  Line 803 
803          finally (return (values result (1+ pos))))))          finally (return (values result (1+ pos))))))
804    
805  (defun string-decode (string external-format &optional (start 0) end)  (defun string-decode (string external-format &optional (start 0) end)
806    "Decode String using the given External-Format and return the new    _N"Decode String using the given External-Format and return the new
807    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
808    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
809    the inverse of String-Encode."    the inverse of String-Encode."
# Line 817  Line 817 
817    
818    
819  (defun set-system-external-format (terminal &optional filenames)  (defun set-system-external-format (terminal &optional filenames)
820    "Change the external format of the standard streams to Terminal.    _N"Change the external format of the standard streams to Terminal.
821    The standard streams are sys::*stdin*, sys::*stdout*, and    The standard streams are sys::*stdin*, sys::*stdout*, and
822    sys::*stderr*, which are normally the input and/or output streams    sys::*stderr*, which are normally the input and/or output streams
823    for *standard-input* and *standard-output*.  Also sets sys::*tty*    for *standard-input* and *standard-output*.  Also sets sys::*tty*
# Line 825  Line 825 
825    optional argument Filenames is gvien, then the filename encoding is    optional argument Filenames is gvien, then the filename encoding is
826    set to the specified format."    set to the specified format."
827    (unless (find-external-format terminal)    (unless (find-external-format terminal)
828      (error "Can't find external-format ~S." terminal))      (error _"Can't find external-format ~S." terminal))
829    (setf (stream-external-format sys:*stdin*) terminal    (setf (stream-external-format sys:*stdin*) terminal
830          (stream-external-format sys:*stdout*) terminal          (stream-external-format sys:*stdout*) terminal
831          (stream-external-format sys:*stderr*) terminal)          (stream-external-format sys:*stderr*) terminal)
# Line 833  Line 833 
833      (setf (stream-external-format sys:*tty*) terminal))      (setf (stream-external-format sys:*tty*) terminal))
834    (when filenames    (when filenames
835      (unless (find-external-format filenames)      (unless (find-external-format filenames)
836        (error "Can't find external-format ~S." filenames))        (error _"Can't find external-format ~S." filenames))
837      (when (and unix::*filename-encoding*      (when (and unix::*filename-encoding*
838                 (not (eq unix::*filename-encoding* filenames)))                 (not (eq unix::*filename-encoding* filenames)))
839        (cerror "Change it anyway."        (cerror _"Change it anyway."
840                "The external-format for encoding filenames is already set.")                _"The external-format for encoding filenames is already set.")
841        (setq unix::*filename-encoding* filenames)))        (setq unix::*filename-encoding* filenames)))
842    t)    t)
843    

Legend:
Removed from v.1.20.4.1  
changed lines
  Added in v.1.20.4.2

  ViewVC Help
Powered by ViewVC 1.1.5