X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu-nemacs.el;h=087bbfa86b9d4c99fed70da83c6ea91add907c35;hb=e78abef24860bee3c828474220e276baabe30313;hp=7f0b15b80b88b457829b5a3f375ca65f98969bc1;hpb=2c7760f3ad3f7a61057a152d81c4d0ad9f6456ba;p=elisp%2Fapel.git

diff --git a/emu-nemacs.el b/emu-nemacs.el
index 7f0b15b..087bbfa 100644
--- a/emu-nemacs.el
+++ b/emu-nemacs.el
@@ -24,89 +24,15 @@
 
 ;;; Code:
 
-(require 'emu-18)
+(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)
@@ -114,60 +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,47 +56,13 @@ else returns nil. [emu-nemacs.el; Mule emulating function]"
       (save-excursion
 	(save-restriction
 	  (narrow-to-region beg end)
-	  (convert-region-kanji-code beg end ic oc)
-	  ))))
+	  (convert-region-kanji-code beg end ic oc)))
+    ))
 
 
 ;;; @ 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]"
-  (let (kanji-flag)
-    (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]"
-  (let (kanji-flag)
-    (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
@@ -235,294 +73,9 @@ 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.
 \[emu-nemacs.el]"
-  (let (kanji-flag)
-    (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]"
-  (let (kanji-flag)
-    (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")
-	)
-      (let (kanji-flag)
-	(write-region (point-min)(point-max) filename append visit)
-	))))
-
-
-;;; @ MIME charset
-;;;
-
-(defvar charsets-mime-charset-alist
-  '(((ascii) . us-ascii)))
-
-(defvar default-mime-charset 'iso-2022-jp)
-
-(defvar mime-charset-coding-system-alist
-  '((iso-2022-jp     . 2)
-    (shift_jis       . 1)
-    ))
-
-(defun mime-charset-to-coding-system (charset)
-  (if (stringp charset)
-      (setq charset (intern (downcase charset)))
-    )
-  (cdr (assq charset mime-charset-coding-system-alist))
-  )
-
-(defun detect-mime-charset-region (start end)
-  "Return MIME charset for region between START and END.
-\[emu-nemacs.el]"
-  (if (save-excursion
-	(save-restriction
-	  (narrow-to-region start end)
-	  (goto-char start)
-	  (re-search-forward "[\200-\377]" nil t)
-	  ))
-      default-mime-charset
-    'us-ascii))
-
-(defun encode-mime-charset-region (start end charset)
-  "Encode the text between START and END as MIME CHARSET.
-\[emu-nemacs.el]"
-  (let ((cs (mime-charset-to-coding-system charset)))
-    (and (numberp cs)
-	 (or (= cs 3)
-	     (save-excursion
-	       (save-restriction
-		 (narrow-to-region start end)
-		 (convert-region-kanji-code start end 3 cs)
-		 ))
-	     ))))
-
-(defun decode-mime-charset-region (start end charset &optional lbt)
-  "Decode the text between START and END as MIME CHARSET.
-\[emu-nemacs.el]"
-  (let ((cs (mime-charset-to-coding-system charset))
-	(nl (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")
-			     (dos . "\r\n") (mac . "\r"))))))
-    (and (numberp cs)
-	 (or (= cs 3)
-	     (save-excursion
-	       (save-restriction
-		 (narrow-to-region start end)
-		 (convert-region-kanji-code start end cs 3)
-		 (if nl
-		     (progn
-		       (goto-char (point-min))
-		       (while (search-forward nl nil t)
-			 (replace-match "\n"))))
-		 ))
-	     ))))
-
-(defun encode-mime-charset-string (string charset)
-  "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
-  (let ((cs (mime-charset-to-coding-system charset)))
-    (if cs
-	(convert-string-kanji-code string 3 cs)
-      string)))
-
-(defun decode-mime-charset-string (string charset &optional lbt)
-  "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
-  (with-temp-buffer
-    (insert string)
-    (decode-mime-charset-region (point-min)(point-max) charset lbt)
-    (buffer-string)))
-
-(defun write-region-as-mime-charset (charset start end filename)
-  "Like `write-region', q.v., but code-convert by MIME CHARSET.
-\[emu-nemacs.el]"
-  (let ((kanji-fileio-code
-	 (or (mime-charset-to-coding-system charset)
-	     *noconv*)))
-    (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))
-      )))
+  (as-binary-input-file
+   ;; Returns list absolute file name and length of data inserted.
+   (insert-file-contents-literally filename visit beg end replace)))
 
 
 ;;; @ end