(modify-coding-system-alist): Moved to mule-util.el.

1 files changed, 52 insertions, 0 deletions

diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index c28cf485afb..e1381488ef8 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -630,6 +630,58 @@ Return nil if there's no need of setting new buffer-file-coding-system."
                   (aref (coding-system-eol-type new-coding) new-eol)))
         new-coding))))
 
+(defun modify-coding-system-alist (target-type regexp coding-system)
+  "Modify one of look up tables for finding a coding system on I/O operation.
+There are three of such tables, file-coding-system-alist,
+process-coding-system-alist, and network-coding-system-alist.
+
+TARGET-TYPE specifies which of them to modify.
+If it is `file', it affects file-coding-system-alist (which see).
+If it is `process', it affects process-coding-system-alist (which see).
+If it is `network', it affects network-codign-system-alist (which see).
+
+REGEXP is a regular expression matching a target of I/O operation.
+The target is a file name if TARGET-TYPE is `file', a program name if
+TARGET-TYPE is `process', or a network service name or a port number
+to connect to if TARGET-TYPE is `network'.
+
+CODING-SYSTEM is a coding system to perform code conversion on the I/O
+operation, or a cons of coding systems for decoding and encoding
+respectively, or a function symbol which returns the cons."
+  (or (memq target-type '(file process network))
+      (error "Invalid target type: %s" target-type))
+  (or (stringp regexp)
+      (and (eq target-type 'network) (integerp regexp))
+      (error "Invalid regular expression: %s" regexp))
+  (if (symbolp coding-system)
+      (if (not (fboundp coding-system))
+          (progn
+            (check-coding-system coding-system)
+            (setq coding-system (cons coding-system coding-system))))
+    (check-coding-system (car coding-system))
+    (check-coding-system (cdr coding-system)))
+  (cond ((eq target-type 'file)
+         (let ((slot (assoc regexp file-coding-system-alist)))
+           (if slot
+               (setcdr slot coding-system)
+             (setq file-coding-system-alist
+                   (cons (cons regexp coding-system)
+                         file-coding-system-alist)))))
+        ((eq target-type 'process)
+         (let ((slot (assoc regexp process-coding-system-alist)))
+           (if slot
+               (setcdr slot coding-system)
+             (setq process-coding-system-alist
+                   (cons (cons regexp coding-system)
+                         process-coding-system-alist)))))
+        (t
+         (let ((slot (assoc regexp network-coding-system-alist)))
+           (if slot
+               (setcdr slot coding-system)
+             (setq network-coding-system-alist
+                   (cons (cons regexp coding-system)
+                         network-coding-system-alist)))))))
+
 (defun make-unification-table (&rest args)
   "Make a unification table (char table) from arguments.
 Each argument is a list of the form (FROM . TO),