[Git][cmucl/cmucl][master] 2 commits: Address #139: Set terminal format to :locale

Raymond Toy (@rtoy) gitlab at common-lisp.net
Thu Dec 8 14:58:00 UTC 2022



Raymond Toy pushed to branch master at cmucl / cmucl


Commits:
1af83384 by Raymond Toy at 2022-12-08T14:57:43+00:00
Address #139: Set terminal format to :locale

- - - - -
6fc2e38e by Raymond Toy at 2022-12-08T14:57:45+00:00
Merge branch 'issue-139-set-terminal-to-utf8' into 'master'

Address #139: Set terminal format to :locale

See merge request cmucl/cmucl!108
- - - - -


3 changed files:

- src/code/fd-stream.lisp
- src/code/save.lisp
- tests/issues.lisp


Changes:

=====================================
src/code/fd-stream.lisp
=====================================
@@ -2397,10 +2397,10 @@
   (setf *available-buffers* nil)
   (setf *stdin*
 	(make-fd-stream 0 :name "Standard Input" :input t :buffering :line
-			:external-format :iso8859-1))
+			:external-format :utf-8))
   (setf *stdout*
 	(make-fd-stream 1 :name "Standard Output" :output t :buffering :line
-			:external-format :iso8859-1))
+			:external-format :utf-8))
   (setf *stderr*
 	(make-fd-stream 2 :name "Standard Error" :output t :buffering :line
 			:external-format :iso8859-1))
@@ -2410,7 +2410,7 @@
 	  (if tty
 	      (make-fd-stream tty :name "the Terminal" :input t :output t
 			      :buffering :line :auto-close t
-			      :external-format :iso8859-1)
+			      :external-format :utf-8)
 	      (make-two-way-stream *stdin* *stdout*))))
   nil)
 


=====================================
src/code/save.lisp
=====================================
@@ -145,24 +145,23 @@
 (defun set-up-locale-external-format ()
   "Add external format alias for :locale to the format specified by
   the locale as set by setlocale(3C)."
-  (let ((codeset (unix::unix-get-locale-codeset)))
+  (let ((codeset (unix::unix-get-locale-codeset))
+	(external-format nil))
     (cond ((zerop (length codeset))
-	   ;; Codeset was the empty string, so just set :locale to
-	   ;; alias to the default external format.  
+	   (setq external-format *default-external-format*))
+	  (t
+	   (let ((name (intern codeset "KEYWORD")))
+             (setq external-format
+		   (stream::ef-name (stream::find-external-format name nil))))))
+    (cond (external-format
 	   (setf (gethash :locale stream::*external-format-aliases*)
-		 *default-external-format*))
+		 external-format))
 	  (t
-	   (let ((codeset-format (intern codeset "KEYWORD")))
-	     ;; If we know the format, we can set the alias.
-	     ;; Otherwise, print a warning and use :iso8859-1 as the
-	     ;; alias.
-	     (setf (gethash :locale stream::*external-format-aliases*)
-		   (if (stream::find-external-format codeset-format nil)
-		       codeset-format
-		       (progn
-			 (warn "Unsupported external format; using :iso8859-1 instead: ~S"
-			       codeset-format)
-			 :iso8859-1)))))))
+	   (warn "No external format found for codeset \"~S\"; using ~S instead"
+		 codeset
+		 *default-external-format*)
+	   (setf (gethash :locale stream::*external-format-aliases*)
+		 *default-external-format*))))
   (values))
 
  
@@ -283,6 +282,8 @@
 	     (intl::setlocale)
 	     ;; Set up :locale format
 	     (set-up-locale-external-format)
+	     ;; Set terminal encodings to :locale
+	     (set-system-external-format :locale)
 	     (ext::process-command-strings process-command-line)
 	     (setf *editor-lisp-p* nil)
 	     (macrolet ((find-switch (name)


=====================================
tests/issues.lisp
=====================================
@@ -700,7 +700,23 @@
 
 (define-test issue.139-default-external-format
     (:tag :issues)
-  (assert-eq :utf-8 stream:*default-external-format*))
+  (assert-eq :utf-8 stream:*default-external-format*)
+  ;; Find the alias for :locale, and verify it exists and verify that
+  ;; the system streams have that format.
+  (let ((locale-format (gethash :locale stream::*external-format-aliases*)))
+    (assert locale-format)
+    (assert-eq locale-format (stream-external-format sys:*stdin*))
+    (assert-eq locale-format (stream-external-format sys:*stdout*))
+    (assert-eq locale-format (stream-external-format sys:*stderr*))
+    ;; sys:*tty* can either be an fd-stream or a two-way-stream.
+    (etypecase sys:*tty*
+      (system:fd-stream
+       (assert-eq locale-format (stream-external-format sys:*tty*)))
+      (two-way-stream
+       (assert-eq locale-format
+		  (stream-external-format (two-way-stream-input-stream sys:*tty*)))
+       (assert-eq locale-format
+		  (stream-external-format (two-way-stream-output-stream sys:*tty*)))))))
 
 (define-test issue.139-default-external-format-read-file
     (:tag :issues)



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bea349948b06626fd33026500bb2ec70a8e8f56c...6fc2e38e925ab9f3fcfb7e54ca059d26ae85af02

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bea349948b06626fd33026500bb2ec70a8e8f56c...6fc2e38e925ab9f3fcfb7e54ca059d26ae85af02
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20221208/a416cec2/attachment-0001.html>


More information about the cmucl-cvs mailing list