X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=poem-nemacs.el;h=5bd891550fb62190c9e4bf1e4be49e61e4a49b73;hb=519b2fe2cba7f7802851bad94e6fa85cee378cfb;hp=2741b9f06d9c39b773ebaeff31b1ec25b454129e;hpb=2dd581858aa9b2b61fdb3fea0e89dcb20fc92772;p=elisp%2Fapel.git diff --git a/poem-nemacs.el b/poem-nemacs.el index 2741b9f..5bd8915 100644 --- a/poem-nemacs.el +++ b/poem-nemacs.el @@ -1,8 +1,8 @@ ;;; poem-nemacs.el --- poem implementation for Nemacs -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -97,175 +97,6 @@ ;;(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 (if (integerp coding-system) - coding-system - (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 (if (integerp coding-system) - coding-system - (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 (if (integerp coding-system) - coding-system - (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 (if (integerp coding-system) - coding-system - (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))) - -(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))) - -(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)))) - -(defun find-file-noselect-as-binary (filename &optional nowarn rawfile) - "Like `find-file-noselect', q.v., but don't code conversion." - (as-binary-input-file (find-file-noselect filename nowarn rawfile))) - -(defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile) - "Like `find-file-noselect', q.v., but it does not code conversion -except for line-break code." - (as-binary-input-file (find-file-noselect filename nowarn rawfile))) - -(defun open-network-stream-as-binary (name buffer host service) - "Like `open-network-stream', q.v., but don't code conversion." - (let ((process (open-network-stream name buffer host service))) - (set-process-kanji-code process 0) - process)) - - -;;; @ with code-conversion -;;; - -(defun insert-file-contents-as-coding-system - (coding-system filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will -be applied to `kanji-fileio-code'." - (let ((kanji-fileio-code coding-system) - kanji-expected-code) - (insert-file-contents filename visit))) - -(defun write-region-as-coding-system - (coding-system start end filename &optional append visit lockname) - "Like `write-region', q.v., but CODING-SYSTEM the first arg will be -applied to `kanji-fileio-code'." - (let ((kanji-fileio-code coding-system) - jka-compr-compression-info-list jam-zcat-filename-list) - (write-region start end filename append visit))) - -(defun find-file-noselect-as-coding-system - (coding-system filename &optional nowarn rawfile) - "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will -be applied to `kanji-fileio-code'." - (let ((kanji-fileio-code coding-system) - kanji-expected-code) - (find-file-noselect filename nowarn))) - - ;;; @ buffer representation ;;; @@ -307,7 +138,8 @@ but the contents viewed as characters do change. (defalias 'char-length 'char-bytes) (defmacro char-next-index (char index) - "Return index of character succeeding CHAR whose index is INDEX." + "Return index of character succeeding CHAR whose index is INDEX. +\[emu-nemacs.el]" (` (+ (, index) (char-bytes (, char))))) @@ -356,14 +188,14 @@ Optional non-nil arg START-COLUMN specifies the starting column. "" (while (< column start-column) (setq ch (aref str from) - column (+ column (char-columns ch)) + 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-columns ch)) + column (+ column (char-width ch)) to-prev to to (+ to (char-bytes ch)))) (setq to to-prev)))