* emu-e20.el (ccl-use-symbol-as-program): Use
[elisp/apel.git] / emu-20.el
index fdda4ee..7003d62 100644 (file)
--- a/emu-20.el
+++ b/emu-20.el
@@ -1,9 +1,8 @@
 ;;; emu-20.el --- emu API implementation for Emacs 20 and XEmacs/mule
 
-;; Copyright (C) 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-20.el,v 7.15 1997/09/07 02:57:51 morioka Exp $
 ;; Keywords: emulation, compatibility, Mule
 
 ;; This file is part of emu.
 
 ;;; Code:
 
-;;; @ binary access
+(require 'custom)
+(eval-when-compile (require 'wid-edit))
+
+
+;;; @ without code-conversion
 ;;;
 
 (defmacro as-binary-process (&rest body)
   `(let ((coding-system-for-write 'binary))
      ,@body))
 
-(defun insert-binary-file-contents-literally
-  (filename &optional visit beg end replace)
-  "Like `insert-file-contents-literally', q.v., but don't code conversion.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
-  This function ensures that none of these modifications will take place."
-  (let ((coding-system-for-read 'binary))
-    (insert-file-contents-literally filename visit beg end replace)
+(defun write-region-as-binary (start end filename
+                                    &optional append visit lockname)
+  "Like `write-region', q.v., but don't encode."
+  (let ((coding-system-for-write 'binary))
+    (write-region start end filename append visit lockname)
+    ))
+
+(defun insert-file-contents-as-binary (filename
+                                      &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+
+Namely this function ensures that only format decoding and character
+code conversion will not take place."
+  (let ((coding-system-for-read 'binary)
+       format-alist)
+    (insert-file-contents filename visit beg end replace)
+    ))
+
+(defun insert-file-contents-as-raw-text (filename
+                                        &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+Like `insert-file-contents-as-binary', but it converts line-break
+code."
+  (let ((coding-system-for-read 'raw-text)
+       format-alist)
+    (insert-file-contents filename visit beg end replace)
     ))
 
+(defun write-region-as-raw-text-CRLF (start end filename
+                                           &optional append visit lockname)
+  "Like `write-region', q.v., but write as network representation."
+  (let ((coding-system-for-write 'raw-text-dos))
+    (write-region start end filename append visit lockname)
+    ))
+
+
 ;;; @@ Mule emulating aliases
 ;;;
 ;;; You should not use it.
@@ -71,12 +103,14 @@ This constant is defined to emulate old MULE anything older than MULE
 ;;; @ MIME charset
 ;;;
 
-(defvar mime-charset-coding-system-alist
+(defcustom mime-charset-coding-system-alist
   `,(let ((rest
-          '((us-ascii      . iso-8859-1)
+          '((us-ascii      . raw-text)
             (gb2312        . cn-gb-2312)
             (iso-2022-jp-2 . iso-2022-7bit-ss2)
             (x-ctext       . ctext)
+            (unknown       . undecided)
+            (x-unknown     . undecided)
             ))
          dest)
       (while rest
@@ -88,13 +122,15 @@ This constant is defined to emulate old MULE anything older than MULE
        )
       dest)
   "Alist MIME CHARSET vs CODING-SYSTEM.
-MIME CHARSET and CODING-SYSTEM must be symbol.")
+MIME CHARSET and CODING-SYSTEM must be symbol."
+  :group 'i18n
+  :type '(repeat (cons symbol coding-system)))
 
 (defsubst mime-charset-to-coding-system (charset &optional lbt)
   "Return coding-system corresponding with CHARSET.
 CHARSET is a symbol whose name is MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as line break code type of coding-system."
+If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
+is specified, it is used as line break code type of coding-system."
   (if (stringp charset)
       (setq charset (intern (downcase charset)))
     )
@@ -103,48 +139,74 @@ used as line break code type of coding-system."
        (setq charset (cdr ret))
       ))
   (if lbt
-      (setq charset (intern (format "%s-%s" charset lbt)))
+      (setq charset (intern (format "%s-%s" charset
+                                   (cond ((eq lbt 'CRLF) 'dos)
+                                         ((eq lbt 'LF) 'unix)
+                                         ((eq lbt 'CR) 'mac)
+                                         (t lbt)))))
     )
   (if (find-coding-system charset)
       charset))
 
-(defsubst encode-mime-charset-region (start end charset)
-  "Encode the text between START and END as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
-    (if cs
-       (encode-coding-region start end cs)
-      )))
-
-(defsubst decode-mime-charset-region (start end charset)
-  "Decode the text between START and END as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
-    (if cs
-       (decode-coding-region start end cs)
-      )))
-
-(defsubst encode-mime-charset-string (string charset)
-  "Encode the STRING as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
-    (if cs
-       (encode-coding-string string cs)
-      string)))
-
-(defsubst decode-mime-charset-string (string charset)
-  "Decode the STRING as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
-    (if cs
-       (decode-coding-string string cs)
-      string)))
-
-
-(defvar default-mime-charset 'x-ctext
-  "Default value of MIME charset used when MIME charset is not specified.
-It must be symbol.")
+(defsubst mime-charset-list ()
+  "Return a list of all existing MIME-charset."
+  (nconc (mapcar (function car) mime-charset-coding-system-alist)
+        (coding-system-list)))
+
+
+(defvar widget-mime-charset-prompt-value-history nil
+  "History of input to `widget-mime-charset-prompt-value'.")
+
+(define-widget 'mime-charset 'coding-system
+  "A mime-charset."
+  :format "%{%t%}: %v"
+  :tag "MIME-charset"
+  :prompt-history 'widget-mime-charset-prompt-value-history
+  :prompt-value 'widget-mime-charset-prompt-value
+  :action 'widget-mime-charset-action)
+
+(defun widget-mime-charset-prompt-value (widget prompt value unbound)
+  ;; Read mime-charset from minibuffer.
+  (intern
+   (completing-read (format "%s (default %s) " prompt value)
+                   (mapcar (function
+                            (lambda (sym)
+                              (list (symbol-name sym))
+                              ))
+                           (mime-charset-list)))))
+
+(defun widget-mime-charset-action (widget &optional event)
+  ;; Read a mime-charset from the minibuffer.
+  (let ((answer
+        (widget-mime-charset-prompt-value
+         widget
+         (widget-apply widget :menu-tag-get)
+         (widget-value widget)
+         t)))
+    (widget-value-set widget answer)
+    (widget-apply widget :notify widget event)
+    (widget-setup)))
+
+(defcustom default-mime-charset 'x-ctext
+  "Default value of MIME-charset.
+It is used when MIME-charset is not specified.
+It must be symbol."
+  :group 'i18n
+  :type 'mime-charset)
 
 (defsubst detect-mime-charset-region (start end)
   "Return MIME charset for region between START and END."
   (charsets-to-mime-charset (find-charset-region start end)))
 
+(defun write-region-as-mime-charset (charset start end filename
+                                            &optional append visit lockname)
+  "Like `write-region', q.v., but encode by MIME CHARSET."
+  (let ((coding-system-for-write
+        (or (mime-charset-to-coding-system charset)
+            'binary)))
+    (write-region start end filename append visit lockname)
+    ))
+
 
 ;;; @ end
 ;;;