X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=emu-mule.el;h=4a691722bbd8a787410f65b86039ee73f44039e1;hb=4fb468dedfa66eec17eb9ddb48ebe44dfa7913ac;hp=a568eceeb2e37289bc5310044a8382aa334ae9d6;hpb=1630261f038aa79c1024db1fc55d4b318da70790;p=elisp%2Fapel.git diff --git a/emu-mule.el b/emu-mule.el index a568ece..4a69172 100644 --- a/emu-mule.el +++ b/emu-mule.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko +;; Katsumi Yamaoka ;; Keywords: emulation, compatibility, Mule ;; This file is part of emu. @@ -28,7 +29,7 @@ ;;; (cond (running-emacs-19 - (require 'emu-19) + (require 'emu-e19) ;; Suggested by SASAKI Osamu ;; (cf. [os2-emacs-ja:78]) @@ -68,6 +69,12 @@ (defalias 'charset-columns 'char-width) (defalias 'charset-direction 'char-direction) +(defun charset-chars (charset) + "Return the number of characters per dimension of CHARSET." + (if (= (logand (nth 2 (character-set charset)) 1) 1) + 96 + 94)) + ;;; @ coding system ;;; @@ -140,8 +147,24 @@ ;;; @ binary access ;;; -(defun insert-binary-file-contents-literally - (filename &optional visit beg end replace) +(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 (mc-flag + (file-coding-system *noconv*)) + (insert-file-contents filename visit beg end replace) + )) + +(defalias 'insert-binary-file-contents 'insert-file-contents-as-binary) +(make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary) + +(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, @@ -152,14 +175,6 @@ find-file-hooks, etc. (insert-file-contents-literally filename visit beg end replace) )) -(defun insert-binary-file-contents - (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but don't code and format conversion." - (let (mc-flag - (file-coding-system *noconv*)) - (insert-file-contents filename visit beg end replace) - )) - (if running-emacs-19_29-or-later ;; for MULE 2.3 based on Emacs 19.34. (defun write-region-as-binary (start end filename @@ -211,6 +226,14 @@ find-file-hooks, etc. (decode-coding-string string cs) string))) +(defun write-region-as-mime-charset (charset start end filename) + "Like `write-region', q.v., but code-convert by MIME CHARSET." + (let ((file-coding-system + (or (mime-charset-to-coding-system charset) + *noconv*))) + (write-region start end filename append visit) + )) + ;;; @@ to coding-system ;;; @@ -247,48 +270,50 @@ find-file-hooks, etc. (defvar charsets-mime-charset-alist (let ((alist - '(((lc-ascii) . 'us-ascii) - ((lc-ascii lc-ltn1) . 'iso-8859-1) - ((lc-ascii lc-ltn2) . 'iso-8859-2) - ((lc-ascii lc-ltn3) . 'iso-8859-3) - ((lc-ascii lc-ltn4) . 'iso-8859-4) -;;; ((lc-ascii lc-crl) . 'iso-8859-5) - ((lc-ascii lc-crl) . 'koi8-r) - ((lc-ascii lc-arb) . 'iso-8859-6) - ((lc-ascii lc-grk) . 'iso-8859-7) - ((lc-ascii lc-hbw) . 'iso-8859-8) - ((lc-ascii lc-ltn5) . 'iso-8859-9) - ((lc-ascii lc-roman lc-jpold lc-jp) . 'iso-2022-jp) - ((lc-ascii lc-kr) . 'euc-kr) - ((lc-ascii lc-cn) . 'gb2312) - ((lc-ascii lc-big5-1 lc-big5-2) . 'big5) + '(((lc-ascii) . us-ascii) + ((lc-ascii lc-ltn1) . iso-8859-1) + ((lc-ascii lc-ltn2) . iso-8859-2) + ((lc-ascii lc-ltn3) . iso-8859-3) + ((lc-ascii lc-ltn4) . iso-8859-4) +;;; ((lc-ascii lc-crl) . iso-8859-5) + ((lc-ascii lc-crl) . koi8-r) + ((lc-ascii lc-arb) . iso-8859-6) + ((lc-ascii lc-grk) . iso-8859-7) + ((lc-ascii lc-hbw) . iso-8859-8) + ((lc-ascii lc-ltn5) . iso-8859-9) + ((lc-ascii lc-roman lc-jpold lc-jp) . iso-2022-jp) + ((lc-ascii lc-kr) . euc-kr) + ((lc-ascii lc-cn) . gb2312) + ((lc-ascii lc-big5-1 lc-big5-2) . big5) ((lc-ascii lc-roman lc-ltn1 lc-grk lc-jpold lc-cn lc-jp lc-kr - lc-jp2) . 'iso-2022-jp-2) + lc-jp2) . iso-2022-jp-2) ((lc-ascii lc-roman lc-ltn1 lc-grk lc-jpold lc-cn lc-jp lc-kr lc-jp2 - lc-cns1 lc-cns2) . 'iso-2022-int-1) + lc-cns1 lc-cns2) . iso-2022-int-1) ((lc-ascii lc-roman lc-ltn1 lc-ltn2 lc-crl lc-grk lc-jpold lc-cn lc-jp lc-kr lc-jp2 lc-cns1 lc-cns2 lc-cns3 lc-cns4 - lc-cns5 lc-cns6 lc-cns7) . 'iso-2022-int-1) + lc-cns5 lc-cns6 lc-cns7) . iso-2022-int-1) )) dest) (while alist (catch 'not-found (let ((pair (car alist))) (setq dest - (cons (mapcar (function - (lambda (cs) - (if (boundp cs) - (symbol-value cs) - (throw 'not-found nil) - ))) - (car pair)) - (cdr pair))))) - (setq alist (cdr alist)))) - ) + (append dest + (list + (cons (mapcar (function + (lambda (cs) + (if (boundp cs) + (symbol-value cs) + (throw 'not-found nil) + ))) + (car pair)) + (cdr pair))))))) + (setq alist (cdr alist))) + dest)) (defvar default-mime-charset 'x-ctext "Default value of MIME-charset. @@ -301,14 +326,35 @@ It must be symbol.") (cons lc-ascii (find-charset-region start end)))) +;;; @ buffer representation +;;; + +(defsubst-maybe set-buffer-multibyte (flag) + "Set the multibyte flag of the current buffer to FLAG. +If FLAG is t, this makes the buffer a multibyte buffer. +If FLAG is nil, this makes the buffer a single-byte buffer. +The buffer contents remain unchanged as a sequence of bytes +but the contents viewed as characters do change. +\[Emacs 20.3 emulating function]" + (setq mc-flag flag) + ) + + ;;; @ character ;;; (defalias 'char-charset 'char-leading-char) -(defalias 'char-length 'char-bytes) +(defmacro char-next-index (char index) + "Return index of character succeeding CHAR whose index is INDEX." + (` (+ (, index) (char-bytes (, char))))) + +;;; @@ obsoleted aliases +;;; +;;; You should not use them. -(defalias 'char-columns 'char-width) +(defalias 'char-length 'char-bytes) +;;(defalias 'char-columns 'char-width) ;;; @ string @@ -352,6 +398,8 @@ Optional non-nil arg START-COLUMN specifies the starting column. ;;; ) +(defalias 'looking-at-as-unibyte 'looking-at) + ;;; @ regulation ;;;