From: morioka Date: Thu, 17 Sep 1998 11:53:09 +0000 (+0000) Subject: - Rename emu-e20_2.el and emu-e20_3.el to poem-e20_2.el and X-Git-Tag: poe-199811302358~45 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=8d8c4be0e7593c7f1b607aa509840d43d1c13fc3;p=elisp%2Fapel.git - Rename emu-e20_2.el and emu-e20_3.el to poem-e20_2.el and poem-e20_3.el. - Split core part about MULE from emu to poem. - Move overlay emulation code of Nemacs from emu-nemacs.el to poe-18.el. --- diff --git a/EMU-ELS b/EMU-ELS index a3050ef..34ba355 100644 --- a/EMU-ELS +++ b/EMU-ELS @@ -4,48 +4,52 @@ ;;; Code: -(setq emu-modules - (append '(poe emu) - (if (or running-emacs-19_29-or-later - running-xemacs-19_14-or-later) - '(richtext) - '(tinyrich) - ))) +(setq emu-modules '(poe poem emu)) (setq emu-modules (nconc - (cond (running-xemacs + (cond ((featurep 'xemacs) ;; for XEmacs (cons 'poe-xemacs (if (featurep 'mule) - '(emu-20 emu-x20) ; for XEmacs with MULE - '(emu-latin1) ; for XEmacs without MULE + ;; for XEmacs with MULE + '(poem-20 poem-xm emu-20 emu-x20) + ;; for XEmacs without MULE + '(poem-ltn1 emu-latin1) )) ) (running-mule-merged-emacs ;; for Emacs 20.1 or later (cons (if (and (fboundp 'set-buffer-multibyte) (subrp (symbol-function 'set-buffer-multibyte))) - 'emu-e20_3 ; for Emacs 20.3 - 'emu-e20_2 ; for Emacs 20.1 and 20.2 + 'poem-e20_3 ; for Emacs 20.3 + 'poem-e20_2 ; for Emacs 20.1 and 20.2 ) - '(emu-20 poe-19 emu-e20)) + '(poe-19 poem-20 poem-e20 emu-20 emu-e20)) ) ((boundp 'MULE) ;; for MULE 1.* and MULE 2.* - (cons 'emu-mule - (if running-emacs-18 - '(poe-18 env) - '(poe-19))) + (append '(poem-om emu-mule) + (if running-emacs-18 + '(poe-18 env) + '(poe-19))) ) ((boundp 'NEMACS) ;; for NEmacs - '(poe-18 emu-nemacs) + '(poe-18 poem-nemacs emu-nemacs) ) (t ;; for Emacs 19.34 - '(poe-19 emu-latin1) + '(poe-19 poem-ltn1 emu-latin1) )) emu-modules)) +(setq emu-modules + (append emu-modules + (if (or running-emacs-19_29-or-later + running-xemacs-19_14-or-later) + '(richtext) + '(tinyrich) + ))) + ;;; EMU-ELS ends here diff --git a/emu-20.el b/emu-20.el index b750e41..ed33ca8 100644 --- a/emu-20.el +++ b/emu-20.el @@ -29,65 +29,11 @@ ;;; Code: +(require 'poem) (require 'custom) (eval-when-compile (require 'wid-edit)) -;;; @ without code-conversion -;;; - -(defmacro as-binary-process (&rest body) - `(let (selective-display ; Disable ^M to nl translation. - (coding-system-for-read 'binary) - (coding-system-for-write 'binary)) - ,@body)) - -(defmacro as-binary-input-file (&rest body) - `(let ((coding-system-for-read 'binary)) - ,@body)) - -(defmacro as-binary-output-file (&rest body) - `(let ((coding-system-for-write 'binary)) - ,@body)) - -(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) - ;; Returns list of absolute file name and length of data inserted. - (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) - ;; Returns list of absolute file name and length of data inserted. - (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. diff --git a/emu-e20.el b/emu-e20.el index 0fe2b47..694a36b 100644 --- a/emu-e20.el +++ b/emu-e20.el @@ -28,43 +28,7 @@ ;;; Code: -(require 'poe) - -(defun fontset-pixel-size (fontset) - (let* ((info (fontset-info fontset)) - (height (aref info 1)) - ) - (cond ((> height 0) height) - ((string-match "-\\([0-9]+\\)-" fontset) - (string-to-number - (substring fontset (match-beginning 1)(match-end 1)))) - (t 0)))) - - -;;; @ character set -;;; - -;; (defalias 'charset-columns 'charset-width) - -(defun find-non-ascii-charset-string (string) - "Return a list of charsets in the STRING except ascii." - (delq 'ascii (find-charset-string string))) - -(defun find-non-ascii-charset-region (start end) - "Return a list of charsets except ascii -in the region between START and END." - (delq 'ascii (find-charset-string (buffer-substring start end)))) - - -;;; @ coding system -;;; - -(defsubst-maybe find-coding-system (obj) - "Return OBJ if it is a coding-system." - (if (coding-system-p obj) - obj)) - -(defalias 'set-process-input-coding-system 'set-process-coding-system) +(require 'poem) ;;; @ MIME charset @@ -272,12 +236,6 @@ If CCL-PROG is symbol, it is dereferenced. (defalias 'insert-binary-file-contents-literally 'insert-file-contents-literally) -(if (and (fboundp 'set-buffer-multibyte) - (subrp (symbol-function 'set-buffer-multibyte))) - (require 'emu-e20_3) ; for Emacs 20.3 - (require 'emu-e20_2) ; for Emacs 20.1 and 20.2 - ) - (provide 'emu-e20) diff --git a/emu-e20_2.el b/emu-e20_2.el deleted file mode 100644 index d13f24c..0000000 --- a/emu-e20_2.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; emu-e20_2.el --- emu API implementation for Emacs 20.1 and 20.2 - -;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: emulation, compatibility, Mule - -;; This file is part of emu. - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This module requires Emacs 20.1 and 20.2. - -;;; Code: - -;;; @ 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 enable-multibyte-characters flag) - ) - - -;;; @ character -;;; - -(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))) - - -;;; @ string -;;; - -(defalias 'sset 'store-substring) - -(defun string-to-char-list (string) - "Return a list of which elements are characters in the STRING." - (let* ((len (length string)) - (i 0) - l chr) - (while (< i len) - (setq chr (sref string i)) - (setq l (cons chr l)) - (setq i (+ i (char-bytes chr))) - ) - (nreverse l))) - -(defalias 'string-to-int-list 'string-to-char-list) - -(defun looking-at-as-unibyte (regexp) - "Like `looking-at', but string is regarded as unibyte sequence." - (let (enable-multibyte-characters) - (looking-at regexp))) - -;;; @@ obsoleted aliases -;;; -;;; You should not use them. - -(defalias 'string-columns 'string-width) -(make-obsolete 'string-columns 'string-width) - - -;;; @ without code-conversion -;;; - -(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 ((flag enable-multibyte-characters) - (coding-system-for-read 'binary) - format-alist) - (prog1 - ;; Returns list absolute file name and length of data inserted. - (insert-file-contents filename visit beg end replace) - ;; This operation does not change the length. - (set-buffer-multibyte flag)))) - -(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 ((flag enable-multibyte-characters) - (coding-system-for-read 'raw-text) - format-alist) - (prog1 - ;; Returns list absolute file name and length of data inserted. - (insert-file-contents filename visit beg end replace) - ;; This operation does not change the length. - (set-buffer-multibyte flag)))) - - -;;; @ end -;;; - -(provide 'emu-e20_2) - -;;; emu-e20_2.el ends here diff --git a/emu-e20_3.el b/emu-e20_3.el deleted file mode 100644 index 15aec7e..0000000 --- a/emu-e20_3.el +++ /dev/null @@ -1,62 +0,0 @@ -;;; emu-e20_3.el --- emu API implementation for Emacs 20.3. - -;; Copyright (C) 1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: emulation, compatibility, Mule - -;; This file is part of emu. - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This module requires Emacs 20.2.91 or later. - -;;; Code: - -;;; @ character -;;; - -(defsubst char-length (char) - "Return indexing length of multi-byte form of CHAR." - 1) - -(defmacro char-next-index (char index) - "Return index of character succeeding CHAR whose index is INDEX." - `(1+ ,index)) - - -;;; @ string -;;; - -(defalias 'sset 'store-substring) - -(defun string-to-char-list (string) - "Return a list of which elements are characters in the STRING." - (mapcar #'identity string)) - -(defalias 'string-to-int-list 'string-to-char-list) - -(defalias 'looking-at-as-unibyte 'looking-at) - - -;;; @ end -;;; - -(provide 'emu-e20_3) - -;;; emu-e20_3.el ends here diff --git a/emu-latin1.el b/emu-latin1.el index 31fa9e2..4dc6acd 100644 --- a/emu-latin1.el +++ b/emu-latin1.el @@ -24,62 +24,7 @@ ;;; Code: -;;; @ buffer representation -;;; - -(defmacro-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 macro]" - ) - - -;;; @ character set -;;; - -(put 'ascii 'charset-description "Character set of ASCII") -(put 'ascii 'charset-registry "ASCII") - -(put 'latin-iso8859-1 'charset-description "Character set of ISO-8859-1") -(put 'latin-iso8859-1 'charset-registry "ISO8859-1") - -(defun charset-description (charset) - "Return description of CHARSET." - (get charset 'charset-description)) - -(defun charset-registry (charset) - "Return registry name of CHARSET." - (get charset 'charset-registry)) - -(defun charset-width (charset) - "Return number of columns a CHARSET occupies when displayed." - 1) - -(defun charset-direction (charset) - "Return the direction of a character of CHARSET by - 0 (left-to-right) or 1 (right-to-left)." - 0) - -(defun find-charset-string (str) - "Return a list of charsets in the string." - (if (string-match "[\200-\377]" str) - '(latin-iso8859-1) - )) - -(defalias 'find-non-ascii-charset-string 'find-charset-string) - -(defun find-charset-region (start end) - "Return a list of charsets in the region between START and END." - (if (save-excursion - (goto-char start) - (re-search-forward "[\200-\377]" end t)) - '(latin-iso8859-1) - )) - -(defalias 'find-non-ascii-charset-region 'find-charset-region) +(require 'poem) ;;; @ coding-system @@ -89,31 +34,6 @@ but the contents viewed as characters do change. (defconst *ctext* nil) (defconst *noconv* nil) -(defun decode-coding-string (string coding-system) - "Decode the STRING which is encoded in CODING-SYSTEM." - string) - -(defun encode-coding-string (string coding-system) - "Encode the STRING as CODING-SYSTEM." - string) - -(defun decode-coding-region (start end coding-system) - "Decode the text between START and END which is encoded in CODING-SYSTEM." - 0) - -(defun encode-coding-region (start end coding-system) - "Encode the text between START and END to CODING-SYSTEM." - 0) - -(defun detect-coding-region (start end) - "Detect coding-system of the text in the region between START and END." - ) - -(defun set-buffer-file-coding-system (coding-system &optional force) - "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM." - ) - - ;;; @@ for old MULE emulation ;;; @@ -133,36 +53,6 @@ else returns nil. [emu-latin1.el; old MULE emulating function]" ;;; @ without code-conversion ;;; -(defmacro as-binary-process (&rest body) - (` (let (selective-display) ; Disable ^M to nl translation. - (,@ body)))) - -(defmacro as-binary-input-file (&rest body) - (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2 - (,@ body)))) - -(defmacro as-binary-output-file (&rest body) - (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2 - (,@ body)))) - -(defun write-region-as-binary (start end filename - &optional append visit lockname) - "Like `write-region', q.v., but don't code conversion." - (let ((emx-binary-mode t)) - (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 ((emx-binary-mode t)) - ;; Returns list of absolute file name and length of data inserted. - (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) @@ -177,19 +67,6 @@ find-file-hooks, etc. ;; Returns list of absolute file name and length of data inserted. (insert-file-contents-literally filename visit beg end replace))) -(defalias 'insert-file-contents-as-raw-text 'insert-file-contents) - -(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 ((the-buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring the-buf start end) - (goto-char (point-min)) - (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) - (replace-match "\\1\r\n")) - (write-region (point-min)(point-max) filename append visit lockname)))) - ;;; @ MIME charset ;;; @@ -247,64 +124,6 @@ find-file-hooks, etc. (defalias 'write-region-as-mime-charset 'write-region) -;;; @ character -;;; - -(defun char-charset (char) - "Return the character set of char CHAR." - (if (< chr 128) - 'ascii - 'latin-iso8859-1)) - -(defun char-bytes (char) - "Return number of bytes a character in CHAR occupies in a buffer." - 1) - -(defun char-width (char) - "Return number of columns a CHAR occupies when displayed." - 1) - -(defun split-char (character) - "Return list of charset and one or two position-codes of CHARACTER." - (cons (char-charset character) character)) - -(defalias 'char-length 'char-bytes) - -(defmacro char-next-index (char index) - "Return index of character succeeding CHAR whose index is INDEX." - (` (1+ (, index)))) - - -;;; @ string -;;; - -(defalias 'string-width 'length) - -(defun string-to-char-list (str) - (mapcar (function identity) str)) - -(defalias 'string-to-int-list 'string-to-char-list) - -(defalias 'sref 'aref) - -(defun truncate-string (str width &optional start-column) - "Truncate STR to fit in WIDTH columns. -Optional non-nil arg START-COLUMN specifies the starting column. -\[emu-latin1.el; MULE 2.3 emulating function]" - (or start-column - (setq start-column 0)) - (substring str start-column width)) - -(defalias 'looking-at-as-unibyte 'looking-at) - -;;; @@ obsoleted aliases -;;; -;;; You should not use them. - -(defalias 'string-columns 'length) -(make-obsolete 'string-columns 'string-width) - - ;;; @ end ;;; diff --git a/emu-mule.el b/emu-mule.el index 59cc665..bb6911b 100644 --- a/emu-mule.el +++ b/emu-mule.el @@ -25,159 +25,15 @@ ;;; Code: -;;; @ version specific features -;;; - -(require 'poe) - -(cond (running-emacs-19 - ;; Suggested by SASAKI Osamu - ;; (cf. [os2-emacs-ja:78]) - (defun fontset-pixel-size (fontset) - (let* ((font (get-font-info - (aref (cdr (get-fontset-info fontset)) 0))) - (open (aref font 4))) - (if (= open 1) - (aref font 5) - (if (= open 0) - (let ((pat (aref font 1))) - (if (string-match "-[0-9]+-" pat) - (string-to-number - (substring - pat (1+ (match-beginning 0)) (1- (match-end 0)))) - 0)) - )))) - ) - (running-emacs-18 - (defun make-overlay (beg end &optional buffer type)) - (defun overlay-put (overlay prop value)) - )) - - -;;; @ character set -;;; - -(defalias 'make-char 'make-character) - -(defalias 'find-non-ascii-charset-string 'find-charset-string) -(defalias 'find-non-ascii-charset-region 'find-charset-region) - -(defalias 'charset-bytes 'char-bytes) -(defalias 'charset-description 'char-description) -(defalias 'charset-registry 'char-registry) -(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 -;;; - -(defun encode-coding-region (start end coding-system) - "Encode the text between START and END to CODING-SYSTEM. -\[EMACS 20 emulating function]" - ;; If `coding-system' is nil, do nothing. - (code-convert-region start end *internal* coding-system)) - -(defun decode-coding-region (start end coding-system) - "Decode the text between START and END which is encoded in CODING-SYSTEM. -\[EMACS 20 emulating function]" - ;; If `coding-system' is nil, do nothing. - (code-convert-region start end coding-system *internal*)) - -;; XXX: Should we support optional NOCOPY argument? (only in Emacs 20.x) -(defun encode-coding-string (str coding-system) - "Encode the STRING to CODING-SYSTEM. -\[EMACS 20 emulating function]" - (if coding-system - (code-convert-string str *internal* coding-system) - ;;(code-convert-string str *internal* nil) returns nil instead of str. - str)) - -;; XXX: Should we support optional NOCOPY argument? (only in Emacs 20.x) -(defun decode-coding-string (str coding-system) - "Decode the string STR which is encoded in CODING-SYSTEM. -\[EMACS 20 emulating function]" - (if coding-system - (let ((len (length str)) - ret) - (while (and (< 0 len) - (null (setq ret - (code-convert-string - (substring str 0 len) - coding-system *internal*)))) - (setq len (1- len))) - (concat ret (substring str len))) - str)) - -(defalias 'detect-coding-region 'code-detect-region) - -(defalias 'set-buffer-file-coding-system 'set-file-coding-system) - -(defmacro as-binary-process (&rest body) - (` (let (selective-display ; Disable ^M to nl translation. - ;; Mule - mc-flag - (default-process-coding-system (cons *noconv* *noconv*)) - program-coding-system-alist) - (,@ body)))) - -(defmacro as-binary-input-file (&rest body) - (` (let (mc-flag - (file-coding-system-for-read *noconv*) - ) - (,@ body)))) - -(defmacro as-binary-output-file (&rest body) - (` (let (mc-flag - (file-coding-system *noconv*) - ) - (,@ body)))) - -(defalias 'set-process-input-coding-system 'set-process-coding-system) +(require 'poem) ;;; @ binary access ;;; -(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." - (as-binary-input-file - ;; Returns list absolute file name and length of data inserted. - (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-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." - (save-excursion - (save-restriction - (narrow-to-region (point)(point)) - (let ((return-val - ;; Returns list absolute file name and length of data inserted. - (insert-file-contents-as-binary filename visit beg end replace))) - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (replace-match "")) - (list (car return-val) (buffer-size)))))) - (defun insert-binary-file-contents-literally (filename &optional visit beg end replace) "Like `insert-file-contents-literally', q.v., but don't code conversion. @@ -189,48 +45,6 @@ find-file-hooks, etc. ;; Returns list absolute file name and length of data inserted. (insert-file-contents-literally filename visit beg end replace))) -(cond - (running-emacs-19_29-or-later - ;; for MULE 2.3 based on Emacs 19.34. - (defun write-region-as-binary (start end filename - &optional append visit lockname) - "Like `write-region', q.v., but don't code conversion." - (as-binary-output-file - (write-region start end filename append visit lockname))) - - (defun write-region-as-raw-text-CRLF (start end filename - &optional append visit lockname) - "Like `write-region', q.v., but don't code conversion." - (let ((the-buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring the-buf start end) - (goto-char (point-min)) - (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) - (replace-match "\\1\r\n")) - (write-region-as-binary (point-min)(point-max) - filename append visit lockname)))) - ) - (t - ;; for MULE 2.3 based on Emacs 19.28. - (defun write-region-as-binary (start end filename - &optional append visit lockname) - "Like `write-region', q.v., but don't code conversion." - (as-binary-output-file - (write-region start end filename append visit))) - - (defun write-region-as-raw-text-CRLF (start end filename - &optional append visit lockname) - "Like `write-region', q.v., but don't code conversion." - (let ((the-buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring the-buf start end) - (goto-char (point-min)) - (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) - (replace-match "\\1\r\n")) - (write-region-as-binary (point-min)(point-max) - filename append visit)))) - )) - ;;; @ MIME charset ;;; @@ -404,90 +218,6 @@ 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) - -(defun split-char (character) - "Return list of charset and one or two position-codes of CHARACTER." - (let ((p (1- (char-bytes character))) - dest) - (while (>= p 1) - (setq dest (cons (- (char-component character p) 128) dest) - p (1- p))) - (cons (char-charset character) dest))) - -(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-length 'char-bytes) -;;(defalias 'char-columns 'char-width) - - -;;; @ string -;;; - -(defalias 'string-columns 'string-width) - -(defalias 'string-to-int-list 'string-to-char-list) - -(or (fboundp 'truncate-string) - ;; Imported from Mule-2.3 - (defun truncate-string (str width &optional start-column) - "\ -Truncate STR to fit in WIDTH columns. -Optional non-nil arg START-COLUMN specifies the starting column. -\[emu-mule.el; Mule 2.3 emulating function]" - (or start-column - (setq start-column 0)) - (let ((max-width (string-width str)) - (len (length str)) - (from 0) - (column 0) - to-prev to ch) - (if (>= width max-width) - (setq width max-width)) - (if (>= start-column width) - "" - (while (< column start-column) - (setq ch (aref str from) - column (+ column (char-width ch)) - from (+ from (char-bytes ch)))) - (if (< width max-width) - (progn - (setq to from) - (while (<= column width) - (setq ch (aref str to) - column (+ column (char-width ch)) - to-prev to - to (+ to (char-bytes ch)))) - (setq to to-prev))) - (substring str from to)))) - ) - -(defalias 'looking-at-as-unibyte 'looking-at) - - ;;; @ regulation ;;; diff --git a/emu-nemacs.el b/emu-nemacs.el index 6cdb4da..f9be5f6 100644 --- a/emu-nemacs.el +++ b/emu-nemacs.el @@ -24,85 +24,15 @@ ;;; Code: -(require 'poe) +(require 'poem) -;;; @ character set +;;; @ coding system ;;; -(put 'ascii - 'charset-description "Character set of ASCII") -(put 'ascii - 'charset-registry "ASCII") - -(put 'japanese-jisx0208 - 'charset-description "Character set of JIS X0208-1983") -(put 'japanese-jisx0208 - 'charset-registry "JISX0208.1983") - -(defun charset-description (charset) - "Return description of CHARSET. [emu-nemacs.el]" - (get charset 'charset-description)) - -(defun charset-registry (charset) - "Return registry name of CHARSET. [emu-nemacs.el]" - (get charset 'charset-registry)) - -(defun charset-width (charset) - "Return number of columns a CHARSET occupies when displayed. -\[emu-nemacs.el]" - (if (eq charset 'ascii) - 1 - 2)) - -(defun charset-direction (charset) - "Return the direction of a character of CHARSET by - 0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]" - 0) - -(defun find-charset-string (str) - "Return a list of charsets in the string. -\[emu-nemacs.el; Mule emulating function]" - (if (string-match "[\200-\377]" str) - '(japanese-jisx0208) - )) - -(defalias 'find-non-ascii-charset-string 'find-charset-string) - -(defun find-charset-region (start end) - "Return a list of charsets in the region between START and END. -\[emu-nemacs.el; Mule emulating function]" - (if (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (re-search-forward "[\200-\377]" nil t))) - '(japanese-jisx0208) - )) - -(defalias 'find-non-ascii-charset-region 'find-charset-region) - -(defun check-ASCII-string (str) - (let ((i 0) - len) - (setq len (length str)) - (catch 'label - (while (< i len) - (if (>= (elt str i) 128) - (throw 'label nil)) - (setq i (+ i 1))) - str))) - ;;; @@ for old MULE emulation ;;; -;;(defconst lc-ascii 0) -;;(defconst lc-jp 146) - - -;;; @ coding system -;;; - (defconst *noconv* 0) (defconst *sjis* 1) (defconst *junet* 2) @@ -110,57 +40,6 @@ (defconst *internal* 3) (defconst *euc-japan* 3) -(defun decode-coding-string (string coding-system) - "Decode the STRING which is encoded in CODING-SYSTEM. -\[emu-nemacs.el; EMACS 20 emulating function]" - (if (eq coding-system 3) - string - (convert-string-kanji-code string coding-system 3))) - -(defun encode-coding-string (string coding-system) - "Encode the STRING to CODING-SYSTEM. -\[emu-nemacs.el; EMACS 20 emulating function]" - (if (eq coding-system 3) - string - (convert-string-kanji-code string 3 coding-system))) - -(defun decode-coding-region (start end coding-system) - "Decode the text between START and END which is encoded in CODING-SYSTEM. -\[emu-nemacs.el; EMACS 20 emulating function]" - (if (/= ic oc) - (save-excursion - (save-restriction - (narrow-to-region start end) - (convert-region-kanji-code start end coding-system 3))) - )) - -(defun encode-coding-region (start end coding-system) - "Encode the text between START and END to CODING-SYSTEM. -\[emu-nemacs.el; EMACS 20 emulating function]" - (if (/= ic oc) - (save-excursion - (save-restriction - (narrow-to-region start end) - (convert-region-kanji-code start end 3 coding-system))) - )) - -(defun detect-coding-region (start end) - "Detect coding-system of the text in the region between START and END. -\[emu-nemacs.el; Emacs 20 emulating function]" - (if (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (re-search-forward "[\200-\377]" nil t))) - *euc-japan* - )) - -(defalias 'set-buffer-file-coding-system 'set-kanji-fileio-code) - - -;;; @@ for old MULE emulation -;;; - (defun code-convert-string (str ic oc) "Convert code in STRING from SOURCE code to TARGET code, On successful converion, returns the result string, @@ -184,36 +63,6 @@ else returns nil. [emu-nemacs.el; Mule emulating function]" ;;; @ without code-conversion ;;; -(defmacro as-binary-process (&rest body) - (` (let (selective-display ; Disable ^M to nl translation. - ;; NEmacs - kanji-flag - (default-kanji-process-code 0) - program-kanji-code-alist) - (,@ body)))) - -(defmacro as-binary-input-file (&rest body) - (` (let (kanji-flag) - (,@ body)))) - -(defmacro as-binary-output-file (&rest body) - (` (let (kanji-flag) - (,@ body)))) - -(defun write-region-as-binary (start end filename - &optional append visit lockname) - "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]" - (as-binary-output-file - (write-region start end filename append visit))) - -(defun insert-file-contents-as-binary (filename - &optional visit beg end replace) - "Like `insert-file-contents', q.v., but don't character code conversion. -\[emu-nemacs.el]" - (as-binary-input-file - ;; Returns list absolute file name and length of data inserted. - (insert-file-contents filename visit beg end replace))) - (fset 'insert-binary-file-contents 'insert-file-contents-as-binary) (defun insert-binary-file-contents-literally (filename @@ -228,26 +77,6 @@ find-file-hooks, etc. ;; Returns list absolute file name and length of data inserted. (insert-file-contents-literally 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 character code conversion. -\[emu-nemacs.el]" - (as-binary-input-file - ;; Returns list absolute file name and length of data inserted. - (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 don't code conversion. [emu-nemacs.el]" - (let ((the-buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring the-buf start end) - (goto-char (point-min)) - (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) - (replace-match "\\1\r\n")) - (write-region-as-binary (point-min)(point-max) - filename append visit)))) - ;;; @ MIME charset ;;; @@ -334,179 +163,6 @@ find-file-hooks, etc. (write-region start end filename))) -;;; @ 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 kanji-flag flag) - ) - - -;;; @ character -;;; - -(defun char-charset (chr) - "Return the character set of char CHR. -\[emu-nemacs.el; MULE emulating function]" - (if (< chr 128) - 'ascii - 'japanese-jisx0208)) - -(defun char-bytes (chr) - "Return number of bytes CHAR will occupy in a buffer. -\[emu-nemacs.el; Mule emulating function]" - (if (< chr 128) - 1 - 2)) - -(defun char-width (char) - "Return number of columns a CHAR occupies when displayed. -\[emu-nemacs.el]" - (if (< char 128) - 1 - 2)) - -(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))))) - - -;;; @ string -;;; - -(defalias 'string-width 'length) - -(defun sref (str idx) - "Return the character in STR at index IDX. -\[emu-nemacs.el; Mule emulating function]" - (let ((chr (aref str idx))) - (if (< chr 128) - chr - (logior (lsh (aref str (1+ idx)) 8) chr)))) - -(defun string-to-char-list (str) - (let ((i 0)(len (length str)) dest chr) - (while (< i len) - (setq chr (aref str i)) - (if (>= chr 128) - (setq i (1+ i) - chr (+ (lsh chr 8) (aref str i))) - ) - (setq dest (cons chr dest)) - (setq i (1+ i))) - (reverse dest))) - -(fset 'string-to-int-list (symbol-function 'string-to-char-list)) - -;;; Imported from Mule-2.3 -(defun truncate-string (str width &optional start-column) - "Truncate STR to fit in WIDTH columns. -Optional non-nil arg START-COLUMN specifies the starting column. -\[emu-mule.el; Mule 2.3 emulating function]" - (or start-column - (setq start-column 0)) - (let ((max-width (string-width str)) - (len (length str)) - (from 0) - (column 0) - to-prev to ch) - (if (>= width max-width) - (setq width max-width)) - (if (>= start-column width) - "" - (while (< column start-column) - (setq ch (aref str from) - column (+ column (char-columns ch)) - from (+ from (char-bytes ch)))) - (if (< width max-width) - (progn - (setq to from) - (while (<= column width) - (setq ch (aref str to) - column (+ column (char-columns ch)) - to-prev to - to (+ to (char-bytes ch)))) - (setq to to-prev))) - (substring str from to)))) - -(defalias 'looking-at-as-unibyte 'looking-at) - -;;; @@ obsoleted aliases -;;; -;;; You should not use them. - -(defalias 'string-columns 'length) - - -;;; @ text property emulation -;;; - -(defvar emu:available-face-attribute-alist - '( - ;;(bold . inversed-region) - (italic . underlined-region) - (underline . underlined-region) - )) - -;; by YAMATE Keiichirou 1994/10/28 -(defun attribute-add-narrow-attribute (attr from to) - (or (consp (symbol-value attr)) - (set attr (list 1))) - (let* ((attr-value (symbol-value attr)) - (len (car attr-value)) - (posfrom 1) - posto) - (while (and (< posfrom len) - (> from (nth posfrom attr-value))) - (setq posfrom (1+ posfrom))) - (setq posto posfrom) - (while (and (< posto len) - (> to (nth posto attr-value))) - (setq posto (1+ posto))) - (if (= posto posfrom) - (if (= (% posto 2) 1) - (if (and (< to len) - (= to (nth posto attr-value))) - (set-marker (nth posto attr-value) from) - (setcdr (nthcdr (1- posfrom) attr-value) - (cons (set-marker-type (set-marker (make-marker) - from) - 'point-type) - (cons (set-marker-type (set-marker (make-marker) - to) - nil) - (nthcdr posto attr-value)))) - (setcar attr-value (+ len 2)))) - (if (= (% posfrom 2) 0) - (setq posfrom (1- posfrom)) - (set-marker (nth posfrom attr-value) from)) - (if (= (% posto 2) 0) - nil - (setq posto (1- posto)) - (set-marker (nth posto attr-value) to)) - (setcdr (nthcdr posfrom attr-value) - (nthcdr posto attr-value))))) - -(defalias 'make-overlay 'cons) - -(defun overlay-put (overlay prop value) - (let ((ret (and (eq prop 'face) - (assq value emu:available-face-attribute-alist) - ))) - (if ret - (attribute-add-narrow-attribute (cdr ret) - (car overlay)(cdr overlay)) - ))) - - ;;; @ end ;;; diff --git a/emu-x20.el b/emu-x20.el index 48154f7..89daac9 100644 --- a/emu-x20.el +++ b/emu-x20.el @@ -28,52 +28,10 @@ ;;; Code: +(require 'poem) (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)) - -;; 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 ;;; @@ -258,46 +216,9 @@ find-file-hooks, etc. )) -;;; @ 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)) - ;;; @@ Mule emulating aliases ;;; ;;; You should not use them. @@ -314,15 +235,6 @@ TABLE defaults to the current buffer's category table." "")) -;;; @ string -;;; - -(defun string-to-int-list (str) - (mapcar #'char-int str)) - -(defalias 'looking-at-as-unibyte 'looking-at) - - ;;; @ end ;;; diff --git a/emu.el b/emu.el index 3684e7c..1ed2540 100644 --- a/emu.el +++ b/emu.el @@ -27,7 +27,7 @@ (require 'poe) (defvar running-emacs-18 (<= emacs-major-version 18)) -(defvar running-xemacs (string-match "XEmacs" emacs-version)) +(defvar running-xemacs (featurep 'xemacs)) (defvar running-mule-merged-emacs (and (not (boundp 'MULE)) (not running-xemacs) (featurep 'mule))) @@ -74,6 +74,8 @@ (defvar mouse-button-3 nil) )) +(require 'poem) + (cond (running-xemacs (if (featurep 'mule) ;; for XEmacs with MULE diff --git a/poe-18.el b/poe-18.el index 0386806..45d6138 100644 --- a/poe-18.el +++ b/poe-18.el @@ -275,6 +275,70 @@ With optional non-nil ALL, force redisplay of all mode-lines. ;;; @ overlay ;;; +(cond ((boundp 'NEMACS) + (defvar emu:available-face-attribute-alist + '( + ;;(bold . inversed-region) + (italic . underlined-region) + (underline . underlined-region) + )) + + ;; by YAMATE Keiichirou 1994/10/28 + (defun attribute-add-narrow-attribute (attr from to) + (or (consp (symbol-value attr)) + (set attr (list 1))) + (let* ((attr-value (symbol-value attr)) + (len (car attr-value)) + (posfrom 1) + posto) + (while (and (< posfrom len) + (> from (nth posfrom attr-value))) + (setq posfrom (1+ posfrom))) + (setq posto posfrom) + (while (and (< posto len) + (> to (nth posto attr-value))) + (setq posto (1+ posto))) + (if (= posto posfrom) + (if (= (% posto 2) 1) + (if (and (< to len) + (= to (nth posto attr-value))) + (set-marker (nth posto attr-value) from) + (setcdr (nthcdr (1- posfrom) attr-value) + (cons (set-marker-type (set-marker (make-marker) + from) + 'point-type) + (cons (set-marker-type + (set-marker (make-marker) + to) + nil) + (nthcdr posto attr-value)))) + (setcar attr-value (+ len 2)))) + (if (= (% posfrom 2) 0) + (setq posfrom (1- posfrom)) + (set-marker (nth posfrom attr-value) from)) + (if (= (% posto 2) 0) + nil + (setq posto (1- posto)) + (set-marker (nth posto attr-value) to)) + (setcdr (nthcdr posfrom attr-value) + (nthcdr posto attr-value))))) + + (defalias 'make-overlay 'cons) + + (defun overlay-put (overlay prop value) + (let ((ret (and (eq prop 'face) + (assq value emu:available-face-attribute-alist) + ))) + (if ret + (attribute-add-narrow-attribute (cdr ret) + (car overlay)(cdr overlay)) + ))) + ) + (t + (defun make-overlay (beg end &optional buffer type)) + (defun overlay-put (overlay prop value)) + )) + (defun overlay-buffer (overlay)) diff --git a/poem-20.el b/poem-20.el new file mode 100644 index 0000000..33acef7 --- /dev/null +++ b/poem-20.el @@ -0,0 +1,92 @@ +;;; poem-20.el --- poem implementation for Emacs 20 and XEmacs-mule + +;; Copyright (C) 1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule) +;; or later. + +;;; Code: + +;;; @ without code-conversion +;;; + +(defmacro as-binary-process (&rest body) + `(let (selective-display ; Disable ^M to nl translation. + (coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + ,@body)) + +(defmacro as-binary-input-file (&rest body) + `(let ((coding-system-for-read 'binary)) + ,@body)) + +(defmacro as-binary-output-file (&rest body) + `(let ((coding-system-for-write 'binary)) + ,@body)) + +(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) + ;; Returns list of absolute file name and length of data inserted. + (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) + ;; Returns list of absolute file name and length of data inserted. + (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))) + + +;;; @ end +;;; + +(provide 'poem-20) + +;;; poem-20.el ends here diff --git a/poem-e20.el b/poem-e20.el new file mode 100644 index 0000000..32aac21 --- /dev/null +++ b/poem-e20.el @@ -0,0 +1,77 @@ +;;; poem-e20.el --- poem implementation for XEmacs-mule + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(defun fontset-pixel-size (fontset) + (let* ((info (fontset-info fontset)) + (height (aref info 1)) + ) + (cond ((> height 0) height) + ((string-match "-\\([0-9]+\\)-" fontset) + (string-to-number + (substring fontset (match-beginning 1)(match-end 1)))) + (t 0)))) + + +;;; @ character set +;;; + +;; (defalias 'charset-columns 'charset-width) + +(defun find-non-ascii-charset-string (string) + "Return a list of charsets in the STRING except ascii." + (delq 'ascii (find-charset-string string))) + +(defun find-non-ascii-charset-region (start end) + "Return a list of charsets except ascii +in the region between START and END." + (delq 'ascii (find-charset-string (buffer-substring start end)))) + + +;;; @ coding system +;;; + +(defsubst-maybe find-coding-system (obj) + "Return OBJ if it is a coding-system." + (if (coding-system-p obj) + obj)) + +(defalias 'set-process-input-coding-system 'set-process-coding-system) + + +;;; @ end +;;; + +(require 'poem-20) + +(if (and (fboundp 'set-buffer-multibyte) + (subrp (symbol-function 'set-buffer-multibyte))) + (require 'poem-e20_3) ; for Emacs 20.3 + (require 'poem-e20_2) ; for Emacs 20.1 and 20.2 + ) + +(provide 'poem-e20) + +;;; poem-e20.el ends here diff --git a/poem-e20_2.el b/poem-e20_2.el new file mode 100644 index 0000000..340115a --- /dev/null +++ b/poem-e20_2.el @@ -0,0 +1,129 @@ +;;; poem-e20_2.el --- poem implementation for Emacs 20.1 and 20.2 + +;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This module requires Emacs 20.1 and 20.2. + +;;; Code: + +;;; @ 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 enable-multibyte-characters flag) + ) + + +;;; @ character +;;; + +(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))) + + +;;; @ string +;;; + +(defalias 'sset 'store-substring) + +(defun string-to-char-list (string) + "Return a list of which elements are characters in the STRING." + (let* ((len (length string)) + (i 0) + l chr) + (while (< i len) + (setq chr (sref string i)) + (setq l (cons chr l)) + (setq i (+ i (char-bytes chr))) + ) + (nreverse l))) + +(defalias 'string-to-int-list 'string-to-char-list) + +(defun looking-at-as-unibyte (regexp) + "Like `looking-at', but string is regarded as unibyte sequence." + (let (enable-multibyte-characters) + (looking-at regexp))) + +;;; @@ obsoleted aliases +;;; +;;; You should not use them. + +(defalias 'string-columns 'string-width) +(make-obsolete 'string-columns 'string-width) + + +;;; @ without code-conversion +;;; + +(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 ((flag enable-multibyte-characters) + (coding-system-for-read 'binary) + format-alist) + (prog1 + ;; Returns list absolute file name and length of data inserted. + (insert-file-contents filename visit beg end replace) + ;; This operation does not change the length. + (set-buffer-multibyte flag)))) + +(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 ((flag enable-multibyte-characters) + (coding-system-for-read 'raw-text) + format-alist) + (prog1 + ;; Returns list absolute file name and length of data inserted. + (insert-file-contents filename visit beg end replace) + ;; This operation does not change the length. + (set-buffer-multibyte flag)))) + + +;;; @ end +;;; + +(provide 'poem-e20_2) + +;;; poem-e20_2.el ends here diff --git a/poem-e20_3.el b/poem-e20_3.el new file mode 100644 index 0000000..4c3b1e2 --- /dev/null +++ b/poem-e20_3.el @@ -0,0 +1,62 @@ +;;; poem-e20_3.el --- poem implementation for Emacs 20.3. + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This module requires Emacs 20.2.91 or later. + +;;; Code: + +;;; @ character +;;; + +(defsubst char-length (char) + "Return indexing length of multi-byte form of CHAR." + 1) + +(defmacro char-next-index (char index) + "Return index of character succeeding CHAR whose index is INDEX." + `(1+ ,index)) + + +;;; @ string +;;; + +(defalias 'sset 'store-substring) + +(defun string-to-char-list (string) + "Return a list of which elements are characters in the STRING." + (mapcar #'identity string)) + +(defalias 'string-to-int-list 'string-to-char-list) + +(defalias 'looking-at-as-unibyte 'looking-at) + + +;;; @ end +;;; + +(provide 'poem-e20_3) + +;;; poem-e20_3.el ends here diff --git a/poem-ltn1.el b/poem-ltn1.el new file mode 100644 index 0000000..d4b8ab9 --- /dev/null +++ b/poem-ltn1.el @@ -0,0 +1,223 @@ +;;; poem-ltn1.el --- poem implementation for Emacs 19 and XEmacs without MULE + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +;;; @ buffer representation +;;; + +(defmacro-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 macro]" + ) + + +;;; @ character set +;;; + +(put 'ascii 'charset-description "Character set of ASCII") +(put 'ascii 'charset-registry "ASCII") + +(put 'latin-iso8859-1 'charset-description "Character set of ISO-8859-1") +(put 'latin-iso8859-1 'charset-registry "ISO8859-1") + +(defun charset-description (charset) + "Return description of CHARSET." + (get charset 'charset-description)) + +(defun charset-registry (charset) + "Return registry name of CHARSET." + (get charset 'charset-registry)) + +(defun charset-width (charset) + "Return number of columns a CHARSET occupies when displayed." + 1) + +(defun charset-direction (charset) + "Return the direction of a character of CHARSET by + 0 (left-to-right) or 1 (right-to-left)." + 0) + +(defun find-charset-string (str) + "Return a list of charsets in the string." + (if (string-match "[\200-\377]" str) + '(latin-iso8859-1) + )) + +(defalias 'find-non-ascii-charset-string 'find-charset-string) + +(defun find-charset-region (start end) + "Return a list of charsets in the region between START and END." + (if (save-excursion + (goto-char start) + (re-search-forward "[\200-\377]" end t)) + '(latin-iso8859-1) + )) + +(defalias 'find-non-ascii-charset-region 'find-charset-region) + + +;;; @ coding-system +;;; + +(defun decode-coding-string (string coding-system) + "Decode the STRING which is encoded in CODING-SYSTEM." + string) + +(defun encode-coding-string (string coding-system) + "Encode the STRING as CODING-SYSTEM." + string) + +(defun decode-coding-region (start end coding-system) + "Decode the text between START and END which is encoded in CODING-SYSTEM." + 0) + +(defun encode-coding-region (start end coding-system) + "Encode the text between START and END to CODING-SYSTEM." + 0) + +(defun detect-coding-region (start end) + "Detect coding-system of the text in the region between START and END." + ) + +(defun set-buffer-file-coding-system (coding-system &optional force) + "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM." + ) + + +;;; @ without code-conversion +;;; + +(defmacro as-binary-process (&rest body) + (` (let (selective-display) ; Disable ^M to nl translation. + (,@ body)))) + +(defmacro as-binary-input-file (&rest body) + (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2 + (,@ body)))) + +(defmacro as-binary-output-file (&rest body) + (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2 + (,@ body)))) + +(defun write-region-as-binary (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't code conversion." + (let ((emx-binary-mode t)) + (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 ((emx-binary-mode t)) + ;; Returns list of absolute file name and length of data inserted. + (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 ((the-buf (current-buffer))) + (with-temp-buffer + (insert-buffer-substring the-buf start end) + (goto-char (point-min)) + (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) + (replace-match "\\1\r\n")) + (write-region (point-min)(point-max) filename append visit lockname)))) + +(defalias 'insert-file-contents-as-raw-text 'insert-file-contents) + + +;;; @ character +;;; + +(defun char-charset (char) + "Return the character set of char CHAR." + (if (< chr 128) + 'ascii + 'latin-iso8859-1)) + +(defun char-bytes (char) + "Return number of bytes a character in CHAR occupies in a buffer." + 1) + +(defun char-width (char) + "Return number of columns a CHAR occupies when displayed." + 1) + +(defun split-char (character) + "Return list of charset and one or two position-codes of CHARACTER." + (cons (char-charset character) character)) + +(defalias 'char-length 'char-bytes) + +(defmacro char-next-index (char index) + "Return index of character succeeding CHAR whose index is INDEX." + (` (1+ (, index)))) + + +;;; @ string +;;; + +(defalias 'string-width 'length) + +(defun string-to-char-list (str) + (mapcar (function identity) str)) + +(defalias 'string-to-int-list 'string-to-char-list) + +(defalias 'sref 'aref) + +(defun truncate-string (str width &optional start-column) + "Truncate STR to fit in WIDTH columns. +Optional non-nil arg START-COLUMN specifies the starting column. +\[emu-latin1.el; MULE 2.3 emulating function]" + (or start-column + (setq start-column 0)) + (substring str start-column width)) + +(defalias 'looking-at-as-unibyte 'looking-at) + +;;; @@ obsoleted aliases +;;; +;;; You should not use them. + +(defalias 'string-columns 'length) +(make-obsolete 'string-columns 'string-width) + + +;;; @ end +;;; + +(provide 'poem-ltn1) + +;;; poem-ltn1.el ends here diff --git a/poem-nemacs.el b/poem-nemacs.el new file mode 100644 index 0000000..e5c6e9d --- /dev/null +++ b/poem-nemacs.el @@ -0,0 +1,335 @@ +;;; poem-nemacs.el --- poem implementation for Nemacs + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +;;; @ character set +;;; + +(put 'ascii + 'charset-description "Character set of ASCII") +(put 'ascii + 'charset-registry "ASCII") + +(put 'japanese-jisx0208 + 'charset-description "Character set of JIS X0208-1983") +(put 'japanese-jisx0208 + 'charset-registry "JISX0208.1983") + +(defun charset-description (charset) + "Return description of CHARSET. [emu-nemacs.el]" + (get charset 'charset-description)) + +(defun charset-registry (charset) + "Return registry name of CHARSET. [emu-nemacs.el]" + (get charset 'charset-registry)) + +(defun charset-width (charset) + "Return number of columns a CHARSET occupies when displayed. +\[emu-nemacs.el]" + (if (eq charset 'ascii) + 1 + 2)) + +(defun charset-direction (charset) + "Return the direction of a character of CHARSET by + 0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]" + 0) + +(defun find-charset-string (str) + "Return a list of charsets in the string. +\[emu-nemacs.el; Mule emulating function]" + (if (string-match "[\200-\377]" str) + '(japanese-jisx0208) + )) + +(defalias 'find-non-ascii-charset-string 'find-charset-string) + +(defun find-charset-region (start end) + "Return a list of charsets in the region between START and END. +\[emu-nemacs.el; Mule emulating function]" + (if (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (re-search-forward "[\200-\377]" nil t))) + '(japanese-jisx0208) + )) + +(defalias 'find-non-ascii-charset-region 'find-charset-region) + +(defun check-ASCII-string (str) + (let ((i 0) + len) + (setq len (length str)) + (catch 'label + (while (< i len) + (if (>= (elt str i) 128) + (throw 'label nil)) + (setq i (+ i 1))) + str))) + +;;; @@ for old MULE emulation +;;; + +;;(defconst lc-ascii 0) +;;(defconst lc-jp 146) + + +;;; @ coding system +;;; + +(defvar coding-system-kanji-code-alist + '((binary . 0) + (raw-text . 0) + (shift_jis . 1) + (iso-2022-jp . 2) + (ctext . 2) + (euc-jp . 3) + )) + +(defun decode-coding-string (string coding-system) + "Decode the STRING which is encoded in CODING-SYSTEM. +\[emu-nemacs.el; EMACS 20 emulating function]" + (let ((code (cdr (assq coding-system coding-system-kanji-code-alist)))) + (if (eq code 3) + string + (convert-string-kanji-code string code 3) + ))) + +(defun encode-coding-string (string coding-system) + "Encode the STRING to CODING-SYSTEM. +\[emu-nemacs.el; EMACS 20 emulating function]" + (let ((code (cdr (assq coding-system coding-system-kanji-code-alist)))) + (if (eq code 3) + string + (convert-string-kanji-code string 3 code) + ))) + +(defun decode-coding-region (start end coding-system) + "Decode the text between START and END which is encoded in CODING-SYSTEM. +\[emu-nemacs.el; EMACS 20 emulating function]" + (let ((code (cdr (assq coding-system coding-system-kanji-code-alist)))) + (save-excursion + (save-restriction + (narrow-to-region start end) + (convert-region-kanji-code start end code 3) + )))) + +(defun encode-coding-region (start end coding-system) + "Encode the text between START and END to CODING-SYSTEM. +\[emu-nemacs.el; EMACS 20 emulating function]" + (let ((code (cdr (assq coding-system coding-system-kanji-code-alist)))) + (save-excursion + (save-restriction + (narrow-to-region start end) + (convert-region-kanji-code start end 3 code) + )))) + +(defun detect-coding-region (start end) + "Detect coding-system of the text in the region between START and END. +\[emu-nemacs.el; Emacs 20 emulating function]" + (if (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (re-search-forward "[\200-\377]" nil t))) + 'euc-jp + )) + +(defalias 'set-buffer-file-coding-system 'set-kanji-fileio-code) + + +;;; @ without code-conversion +;;; + +(defmacro as-binary-process (&rest body) + (` (let (selective-display ; Disable ^M to nl translation. + ;; NEmacs + kanji-flag + (default-kanji-process-code 0) + program-kanji-code-alist) + (,@ body)))) + +(defmacro as-binary-input-file (&rest body) + (` (let (kanji-flag) + (,@ body)))) + +(defmacro as-binary-output-file (&rest body) + (` (let (kanji-flag) + (,@ body)))) + +(defun write-region-as-binary (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]" + (as-binary-output-file + (write-region start end filename append visit))) + +(defun insert-file-contents-as-binary (filename + &optional visit beg end replace) + "Like `insert-file-contents', q.v., but don't character code conversion. +\[emu-nemacs.el]" + (as-binary-input-file + ;; Returns list absolute file name and length of data inserted. + (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 character code conversion. +\[emu-nemacs.el]" + (as-binary-input-file + ;; Returns list absolute file name and length of data inserted. + (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 don't code conversion. [emu-nemacs.el]" + (let ((the-buf (current-buffer))) + (with-temp-buffer + (insert-buffer-substring the-buf start end) + (goto-char (point-min)) + (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) + (replace-match "\\1\r\n")) + (write-region-as-binary (point-min)(point-max) + filename append visit)))) + + +;;; @ 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 kanji-flag flag) + ) + + +;;; @ character +;;; + +(defun char-charset (chr) + "Return the character set of char CHR. +\[emu-nemacs.el; MULE emulating function]" + (if (< chr 128) + 'ascii + 'japanese-jisx0208)) + +(defun char-bytes (chr) + "Return number of bytes CHAR will occupy in a buffer. +\[emu-nemacs.el; Mule emulating function]" + (if (< chr 128) + 1 + 2)) + +(defun char-width (char) + "Return number of columns a CHAR occupies when displayed. +\[emu-nemacs.el]" + (if (< char 128) + 1 + 2)) + +(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))))) + + +;;; @ string +;;; + +(defalias 'string-width 'length) + +(defun sref (str idx) + "Return the character in STR at index IDX. +\[emu-nemacs.el; Mule emulating function]" + (let ((chr (aref str idx))) + (if (< chr 128) + chr + (logior (lsh (aref str (1+ idx)) 8) chr)))) + +(defun string-to-char-list (str) + (let ((i 0)(len (length str)) dest chr) + (while (< i len) + (setq chr (aref str i)) + (if (>= chr 128) + (setq i (1+ i) + chr (+ (lsh chr 8) (aref str i))) + ) + (setq dest (cons chr dest)) + (setq i (1+ i))) + (reverse dest))) + +(fset 'string-to-int-list (symbol-function 'string-to-char-list)) + +;;; Imported from Mule-2.3 +(defun truncate-string (str width &optional start-column) + "Truncate STR to fit in WIDTH columns. +Optional non-nil arg START-COLUMN specifies the starting column. +\[emu-mule.el; Mule 2.3 emulating function]" + (or start-column + (setq start-column 0)) + (let ((max-width (string-width str)) + (len (length str)) + (from 0) + (column 0) + to-prev to ch) + (if (>= width max-width) + (setq width max-width)) + (if (>= start-column width) + "" + (while (< column start-column) + (setq ch (aref str from) + column (+ column (char-columns ch)) + from (+ from (char-bytes ch)))) + (if (< width max-width) + (progn + (setq to from) + (while (<= column width) + (setq ch (aref str to) + column (+ column (char-columns ch)) + to-prev to + to (+ to (char-bytes ch)))) + (setq to to-prev))) + (substring str from to)))) + +(defalias 'looking-at-as-unibyte 'looking-at) + +;;; @@ obsoleted aliases +;;; +;;; You should not use them. + +(defalias 'string-columns 'length) + + +;;; @ end +;;; + +(provide 'poem-nemacs) + +;;; poem-nemacs.el ends here diff --git a/poem-om.el b/poem-om.el new file mode 100644 index 0000000..5579e09 --- /dev/null +++ b/poem-om.el @@ -0,0 +1,317 @@ +;;; poem-om.el --- poem implementation for Mule 1.* and Mule 2.* + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'poe) + + +;;; @ version specific features +;;; + +(cond ((= emacs-major-version 19) + ;; Suggested by SASAKI Osamu + ;; (cf. [os2-emacs-ja:78]) + (defun fontset-pixel-size (fontset) + (let* ((font (get-font-info + (aref (cdr (get-fontset-info fontset)) 0))) + (open (aref font 4))) + (if (= open 1) + (aref font 5) + (if (= open 0) + (let ((pat (aref font 1))) + (if (string-match "-[0-9]+-" pat) + (string-to-number + (substring + pat (1+ (match-beginning 0)) (1- (match-end 0)))) + 0)) + )))) + )) + + +;;; @ character set +;;; + +(defalias 'make-char 'make-character) + +(defalias 'find-non-ascii-charset-string 'find-charset-string) +(defalias 'find-non-ascii-charset-region 'find-charset-region) + +(defalias 'charset-bytes 'char-bytes) +(defalias 'charset-description 'char-description) +(defalias 'charset-registry 'char-registry) +(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 +;;; + +(defun encode-coding-region (start end coding-system) + "Encode the text between START and END to CODING-SYSTEM. +\[EMACS 20 emulating function]" + ;; If `coding-system' is nil, do nothing. + (code-convert-region start end *internal* coding-system)) + +(defun decode-coding-region (start end coding-system) + "Decode the text between START and END which is encoded in CODING-SYSTEM. +\[EMACS 20 emulating function]" + ;; If `coding-system' is nil, do nothing. + (code-convert-region start end coding-system *internal*)) + +;; XXX: Should we support optional NOCOPY argument? (only in Emacs 20.x) +(defun encode-coding-string (str coding-system) + "Encode the STRING to CODING-SYSTEM. +\[EMACS 20 emulating function]" + (if coding-system + (code-convert-string str *internal* coding-system) + ;;(code-convert-string str *internal* nil) returns nil instead of str. + str)) + +;; XXX: Should we support optional NOCOPY argument? (only in Emacs 20.x) +(defun decode-coding-string (str coding-system) + "Decode the string STR which is encoded in CODING-SYSTEM. +\[EMACS 20 emulating function]" + (if coding-system + (let ((len (length str)) + ret) + (while (and (< 0 len) + (null (setq ret + (code-convert-string + (substring str 0 len) + coding-system *internal*)))) + (setq len (1- len))) + (concat ret (substring str len))) + str)) + +(defalias 'detect-coding-region 'code-detect-region) + +(defalias 'set-buffer-file-coding-system 'set-file-coding-system) + + +;;; @ without code-conversion +;;; + +(defmacro as-binary-process (&rest body) + (` (let (selective-display ; Disable ^M to nl translation. + ;; Mule + mc-flag + (default-process-coding-system (cons *noconv* *noconv*)) + program-coding-system-alist) + (,@ body)))) + +(defmacro as-binary-input-file (&rest body) + (` (let (mc-flag + (file-coding-system-for-read *noconv*) + ) + (,@ body)))) + +(defmacro as-binary-output-file (&rest body) + (` (let (mc-flag + (file-coding-system *noconv*) + ) + (,@ body)))) + +(defalias 'set-process-input-coding-system 'set-process-coding-system) + +(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." + (as-binary-input-file + ;; Returns list absolute file name and length of data inserted. + (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." + (save-excursion + (save-restriction + (narrow-to-region (point)(point)) + (let ((return-val + ;; Returns list absolute file name and length of data inserted. + (insert-file-contents-as-binary filename visit beg end replace))) + (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (replace-match "")) + (list (car return-val) (buffer-size)))))) + +(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." + (as-binary-input-file + ;; Returns list absolute file name and length of data inserted. + (insert-file-contents-literally filename visit beg end replace))) + +(cond + (running-emacs-19_29-or-later + ;; for MULE 2.3 based on Emacs 19.34. + (defun write-region-as-binary (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't code conversion." + (as-binary-output-file + (write-region start end filename append visit lockname))) + + (defun write-region-as-raw-text-CRLF (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't code conversion." + (let ((the-buf (current-buffer))) + (with-temp-buffer + (insert-buffer-substring the-buf start end) + (goto-char (point-min)) + (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) + (replace-match "\\1\r\n")) + (write-region-as-binary (point-min)(point-max) + filename append visit lockname)))) + ) + (t + ;; for MULE 2.3 based on Emacs 19.28. + (defun write-region-as-binary (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't code conversion." + (as-binary-output-file + (write-region start end filename append visit))) + + (defun write-region-as-raw-text-CRLF (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't code conversion." + (let ((the-buf (current-buffer))) + (with-temp-buffer + (insert-buffer-substring the-buf start end) + (goto-char (point-min)) + (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) + (replace-match "\\1\r\n")) + (write-region-as-binary (point-min)(point-max) + filename append visit)))) + )) + + +;;; @ 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) + +(defun split-char (character) + "Return list of charset and one or two position-codes of CHARACTER." + (let ((p (1- (char-bytes character))) + dest) + (while (>= p 1) + (setq dest (cons (- (char-component character p) 128) dest) + p (1- p))) + (cons (char-charset character) dest))) + +(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-length 'char-bytes) +;;(defalias 'char-columns 'char-width) + + +;;; @ string +;;; + +(defalias 'string-columns 'string-width) + +(defalias 'string-to-int-list 'string-to-char-list) + +(or (fboundp 'truncate-string) + ;; Imported from Mule-2.3 + (defun truncate-string (str width &optional start-column) + "\ +Truncate STR to fit in WIDTH columns. +Optional non-nil arg START-COLUMN specifies the starting column. +\[emu-mule.el; Mule 2.3 emulating function]" + (or start-column + (setq start-column 0)) + (let ((max-width (string-width str)) + (len (length str)) + (from 0) + (column 0) + to-prev to ch) + (if (>= width max-width) + (setq width max-width)) + (if (>= start-column width) + "" + (while (< column start-column) + (setq ch (aref str from) + column (+ column (char-width ch)) + from (+ from (char-bytes ch)))) + (if (< width max-width) + (progn + (setq to from) + (while (<= column width) + (setq ch (aref str to) + column (+ column (char-width ch)) + to-prev to + to (+ to (char-bytes ch)))) + (setq to to-prev))) + (substring str from to)))) + ) + +(defalias 'looking-at-as-unibyte 'looking-at) + + +;;; @ end +;;; + +(provide 'poem-om) + +;;; poem-om.el ends here diff --git a/poem-xm.el b/poem-xm.el new file mode 100644 index 0000000..1ce5eec --- /dev/null +++ b/poem-xm.el @@ -0,0 +1,128 @@ +;;; poem-xm.el --- poem implementation for XEmacs-mule + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'poem-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)) + +;; 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))) + + +;;; @ 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)) + + +;;; @ string +;;; + +(defun string-to-int-list (str) + (mapcar #'char-int str)) + +(defalias 'looking-at-as-unibyte 'looking-at) + + +;;; @ end +;;; + +(provide 'poem-xm) + +;;; poem-xm.el ends here diff --git a/poem.el b/poem.el new file mode 100644 index 0000000..12a6fdd --- /dev/null +++ b/poem.el @@ -0,0 +1,55 @@ +;;; poem.el --- Portable Outfit for Emacsen: about MULE API + +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, Mule + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'poe) + +(cond ((featurep 'mule) + (cond ((featurep 'xemacs) + (require 'poem-xm) + ) + ((>= emacs-major-version 20) + (require 'poem-e20) + ) + (t + ;; for MULE 1.* and 2.* + (require 'poem-om) + )) + ) + ((boundp 'NEMACS) + ;; for Nemacs and Nepoch + (require 'poem-nemacs) + ) + (t + (require 'poem-latin1) + )) + + +;;; @ end +;;; + +(provide 'poem) + +;;; poem.el ends here