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.
;;; 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
;;; 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.
;;; 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
(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)
+++ /dev/null
-;;; 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 <morioka@jaist.ac.jp>
-;; 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
+++ /dev/null
-;;; emu-e20_3.el --- emu API implementation for Emacs 20.3.
-
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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
;;; 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
(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
;;;
;;; @ 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)
;; 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
;;;
(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
;;;
;;; Code:
-;;; @ version specific features
-;;;
-
-(require 'poe)
-
-(cond (running-emacs-19
- ;; Suggested by SASAKI Osamu <osamu@shuugr.bekkoame.or.jp>
- ;; (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.
;; 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
;;;
(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
;;;
;;; 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)
(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,
;;; @ 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
;; 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
;;;
(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
;;;
;;; 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
;;;
))
-;;; @ 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.
""))
-;;; @ string
-;;;
-
-(defun string-to-int-list (str)
- (mapcar #'char-int str))
-
-(defalias 'looking-at-as-unibyte 'looking-at)
-
-
;;; @ end
;;;
(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)))
(defvar mouse-button-3 nil)
))
+(require 'poem)
+
(cond (running-xemacs
(if (featurep 'mule)
;; for XEmacs with MULE
;;; @ 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))
--- /dev/null
+;;; poem-20.el --- poem implementation for Emacs 20 and XEmacs-mule
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; poem-e20.el --- poem implementation for XEmacs-mule
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; 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 <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; poem-e20_3.el --- poem implementation for Emacs 20.3.
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; 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 <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; poem-nemacs.el --- poem implementation for Nemacs
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; poem-om.el --- poem implementation for Mule 1.* and Mule 2.*
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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 <osamu@shuugr.bekkoame.or.jp>
+ ;; (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
--- /dev/null
+;;; poem-xm.el --- poem implementation for XEmacs-mule
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
--- /dev/null
+;;; poem.el --- Portable Outfit for Emacsen: about MULE API
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; 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
projects / elisp / apel.git / commitdiff