X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu-20.el;h=7003d62e1949141524ed54fa1afc7887b9016495;hb=87bc8282a36a59e7486cc6f6a97f419f67849220;hp=fdda4ee3665807f9120737e44dde3c850c69056f;hpb=c3077e7262e7a93b60dc43fbf2644bc7502abd3c;p=elisp%2Fapel.git diff --git a/emu-20.el b/emu-20.el index fdda4ee..7003d62 100644 --- 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 -;; 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. @@ -30,7 +29,11 @@ ;;; Code: -;;; @ binary access +(require 'custom) +(eval-when-compile (require 'wid-edit)) + + +;;; @ without code-conversion ;;; (defmacro as-binary-process (&rest body) @@ -47,17 +50,46 @@ `(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 ;;;