X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu-nemacs.el;h=087bbfa86b9d4c99fed70da83c6ea91add907c35;hb=e78abef24860bee3c828474220e276baabe30313;hp=4097331ebd56076ebf5f9bab871728981c6a37f5;hpb=39fc081ad164df64424432a3e643f92af4924216;p=elisp%2Fapel.git diff --git a/emu-nemacs.el b/emu-nemacs.el index 4097331..087bbfa 100644 --- a/emu-nemacs.el +++ b/emu-nemacs.el @@ -1,53 +1,36 @@ -;;; -;;; emu-nemacs.el --- Mule 2 emulation module for NEmacs -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; modified by KOBAYASHI Shuhei -;;; Version: -;;; $Id: emu-nemacs.el,v 7.9 1996/04/17 15:14:17 morioka Exp $ -;;; Keywords: emulation, compatibility, NEmacs, Mule -;;; -;;; This file is part of tl (Tiny 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; -;;; Code: +;;; emu-nemacs.el --- emu API implementation for NEmacs -(require 'emu-18) +;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko +;; Keywords: emulation, compatibility, NEmacs, mule -;;; @ leading-char -;;; +;; This file is part of emu. -(defconst lc-ascii 0) -(defconst lc-jp 146) +;; 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. -(defun char-leading-char (chr) - "Return leading character of CHAR. -\[emu-nemacs.el; Mule emulating function]" - (if (< chr 128) - lc-ascii - lc-jp)) +;; 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. -(defalias 'get-lc 'char-leading-char) +;; 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: -;;; @ coding-system +(require 'poem) + + +;;; @ coding system +;;; + +;;; @@ for old MULE emulation ;;; (defconst *noconv* 0) @@ -69,182 +52,30 @@ else returns nil. [emu-nemacs.el; Mule emulating function]" "Convert code of the text between BEGIN and END from SOURCE to TARGET. On successful conversion returns t, else returns nil. [emu-nemacs.el; Mule emulating function]" - (if (not (eq ic oc)) - (convert-region-kanji-code beg end ic oc))) - -(defun code-detect-region (start end) - "Detect coding-system of the text in the region between START and END. -\[emu-orig.el; Mule emulating function]" - (if (save-excursion + (if (/= ic oc) + (save-excursion (save-restriction - (narrow-to-region start end) - (goto-char start) - (re-search-forward "[\200-\377]" nil t) - )) - *euc-japan* + (narrow-to-region beg end) + (convert-region-kanji-code beg end ic oc))) )) -(defun set-file-coding-system (coding-system &optional force) - (set-kanji-fileio-code coding-system) - ) - - -;;; @ character and string -;;; - -(defun char-bytes (chr) - "Return number of bytes CHAR will occupy in a buffer. -\[Mule compatible function in tm-nemacs]" - (if (< chr 128) 1 2)) - -(defun char-width (chr) - "Return number of columns CHAR will occupy when displayed. -\[Mule compatible function in tm-nemacs]" - (if (< chr 128) 1 2)) - -(defun string-width (str) - "Return number of columns STRING will occupy. -\[Mule compatible function in tm-nemacs]" - (length str)) - -(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) - )) - -(defun find-charset-string (str) - "Return a list of leading-chars in the string. -\[emu-nemacs.el; Mule emulating function]" - (if (string-match "[\200-\377]" str) - (list lc-jp) - )) - -(defun find-charset-region (start end) - "Return a list of leading-chars 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) - )) - (list lc-jp) - )) -(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))) - -;;; 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)))) - - -;;; @ text property emulation +;;; @ without code-conversion ;;; -(setq tl: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 'tl:make-overlay 'cons) - -(defun tl:overlay-put (overlay prop value) - (let ((ret (and (eq prop 'face) - (assq value tl:available-face-attribute-alist) - ))) - (if ret - (attribute-add-narrow-attribute (cdr ret) - (car overlay)(cdr overlay)) - ))) - -(defun tl:add-text-properties (start end properties &optional object)) +(fset 'insert-binary-file-contents 'insert-file-contents-as-binary) + +(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. +\[emu-nemacs.el]" + (as-binary-input-file + ;; Returns list absolute file name and length of data inserted. + (insert-file-contents-literally filename visit beg end replace))) ;;; @ end