;;; Code:
-;; (require 'emu-xemacs)
-;; (require 'emu-20)
+(require 'emu-20)
+;;; @ fix coding-system definition
+;;;
+
+;; It seems not bug, but I can not permit it...
(and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
(copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
-
-;;; @ binary access
+;; Redefine if -{dos|mac|unix} is not found.
+(or (find-coding-system 'raw-text-dos)
+ (copy-coding-system 'no-conversion-dos 'raw-text-dos))
+(or (find-coding-system 'raw-text-mac)
+ (copy-coding-system 'no-conversion-mac 'raw-text-mac))
+(or (find-coding-system 'raw-text-unix)
+ (copy-coding-system 'no-conversion-unix 'raw-text-unix))
+
+(or (find-coding-system 'ctext-dos)
+ (make-coding-system
+ 'ctext 'iso2022
+ "Coding-system used in X as Compound Text Encoding."
+ '(charset-g0 ascii charset-g1 latin-iso8859-1
+ eol-type nil
+ mnemonic "CText")))
+
+(or (find-coding-system 'iso-2022-jp-2-dos)
+ (make-coding-system
+ 'iso-2022-jp-2 'iso2022
+ "ISO-2022 coding system using SS2 for 96-charset in 7-bit code."
+ '(charset-g0 ascii
+ charset-g2 t ;; unspecified but can be used later.
+ seven t
+ short t
+ mnemonic "ISO7/SS2"
+ eol-type nil)))
+
+(or (find-coding-system 'euc-kr-dos)
+ (make-coding-system
+ 'euc-kr 'iso2022
+ "Coding-system of Korean EUC (Extended Unix Code)."
+ '(charset-g0 ascii charset-g1 korean-ksc5601
+ mnemonic "ko/EUC"
+ eol-type nil)))
+
+
+;;; @ CCL
;;;
-(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 make-ccl-coding-system (name mnemonic doc-string decoder encoder)
+ (make-coding-system
+ name 'ccl doc-string
+ (list 'mnemonic (char-to-string mnemonic)
+ 'decode (symbol-value decoder)
+ 'encode (symbol-value encoder))))
+
+
+;;; @ without code-conversion
+;;;
(define-obsolete-function-alias 'insert-binary-file-contents
'insert-file-contents-as-binary)
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)
- ))
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents-literally filename visit beg end replace)))
;;; @ MIME charset
:group 'i18n
:type '(repeat (cons mime-charset function)))
-(defsubst decode-mime-charset-region-default (start end charset)
- (let ((cs (mime-charset-to-coding-system charset)))
+(defsubst decode-mime-charset-region-default (start end charset lbt)
+ (let ((cs (mime-charset-to-coding-system charset lbt)))
(if cs
(decode-coding-region start end cs)
)))
:group 'i18n
:type 'face)
-(defun decode-mime-charset-region-with-iso646-unification (start end charset)
- (decode-mime-charset-region-default start end charset)
- (save-excursion
- (let ((rest mime-iso646-character-unification-alist))
- (while rest
- (let ((pair (car rest)))
- (goto-char (point-min))
- (while (search-forward (car pair) nil t)
- (let ((str (cdr pair)))
- (put-text-property 0 (length str)
- 'face mime-unified-character-face str)
- (replace-match str 'fixed-case 'literal)
- )
- ))
- (setq rest (cdr rest))))))
-
-(defun decode-mime-charset-region-for-hz (start end charset)
- (decode-hz-region start end))
-
-(defun decode-mime-charset-region (start end charset)
+(defcustom mime-character-unification-limit-size 2048
+ "*Limit size to unify characters."
+ :group 'i18n
+ :type 'integer)
+
+(defun decode-mime-charset-region-with-iso646-unification (start end charset
+ lbt)
+ (decode-mime-charset-region-default start end charset lbt)
+ (if (<= (- end start) mime-character-unification-limit-size)
+ (save-excursion
+ (let ((rest mime-iso646-character-unification-alist))
+ (while rest
+ (let ((pair (car rest)))
+ (goto-char (point-min))
+ (while (search-forward (car pair) nil t)
+ (let ((str (cdr pair)))
+ (put-text-property 0 (length str)
+ 'face mime-unified-character-face str)
+ (replace-match str 'fixed-case 'literal)
+ )
+ ))
+ (setq rest (cdr rest)))))
+ ))
+
+(defun decode-mime-charset-region-for-hz (start end charset lbt)
+ (if lbt
+ (save-restriction
+ (narrow-to-region start end)
+ (decode-coding-region (point-min)(point-max)
+ (mime-charset-to-coding-system 'raw-text lbt))
+ (decode-hz-region (point-min)(point-max)))
+ (decode-hz-region start end)))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
"Decode the text between START and END as MIME CHARSET."
(if (stringp charset)
(setq charset (intern (downcase charset)))
)
(let ((func (cdr (or (assq charset mime-charset-decoder-alist)
(assq t mime-charset-decoder-alist)))))
- (funcall func start end charset)
- ))
+ (funcall func start end charset lbt)))
(defsubst encode-mime-charset-string (string charset)
"Encode the STRING as MIME CHARSET."
;; (if cs
;; (decode-coding-string string cs)
;; string)))
-(defun decode-mime-charset-string (string charset)
+(defun decode-mime-charset-string (string charset &optional lbt)
"Decode the STRING as MIME CHARSET."
(with-temp-buffer
(insert string)
- (decode-mime-charset-region (point-min)(point-max) charset)
- (buffer-string)
- ))
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string)))
(defvar charsets-mime-charset-alist
chinese-cns11643-7) . iso-2022-int-1)
))
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (charsets-to-mime-charset (charsets-in-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]"
+ flag)
;;; @ character
;;;
+;; avoid bug of XEmacs
+(or (integerp (cdr (split-char ?a)))
+ (defun split-char (char)
+ "Return list of charset and one or two position-codes of CHAR."
+ (let ((charset (char-charset char)))
+ (if (eq charset 'ascii)
+ (list charset (char-int char))
+ (let ((i 0)
+ (len (charset-dimension charset))
+ (code (if (integerp char)
+ char
+ (char-int char)))
+ dest)
+ (while (< i len)
+ (setq dest (cons (logand code 127) dest)
+ code (lsh code -7)
+ i (1+ i)))
+ (cons charset dest)))))
+ )
+
(defmacro char-next-index (char index)
"Return index of character succeeding CHAR whose index is INDEX."
`(1+ ,index))
CHAR can be any multilingual character
TABLE defaults to the current buffer's category table."
(mapconcat (lambda (chr)
- (char-to-string (int-char chr))
- )
+ (char-to-string (int-char chr)))
(char-category-list character)
""))
;;;
(defun string-to-int-list (str)
- (mapcar #'char-int str)
- )
+ (mapcar #'char-int str))
+
+(defalias 'looking-at-as-unibyte 'looking-at)
;;; @ end
projects / elisp / apel.git / blobdiff