emu-nemacs.el

   1 ;;;
   2 ;;; emu-nemacs: Mule 2 emulation module for NEmacs
   3 ;;;
   4 ;;; $Id: emu-nemacs.el,v 5.0 1995/08/26 17:56:33 morioka Exp $
   5 ;;;
   6
   7 (require 'emu-18)
   8
   9
  10 ;;; @ constants
  11 ;;;
  12
  13 (defconst emacs-major-version (string-to-int emacs-version))
  14
  15 (defconst *junet* 2)
  16 (defconst *internal* 3)
  17 (defconst *euc-japan* 3)
  18
  19 (defconst lc-ascii 0)
  20 (defconst lc-jp  146)
  21
  22 ;; by mol. 1993/9/26
  23 (defun string-width (str)
  24   "Return number of columns STRING will occupy.
  25  [Mule compatible function in tm-nemacs]"
  26   (length str))
  27
  28 (defun char-bytes (chr)
  29   "Return number of bytes CHAR will occupy in a buffer.
  30  [Mule compatible function in tm-nemacs]"
  31   (if (< chr 128) 1 2))
  32
  33 (defun char-width (chr)
  34   "Return number of columns CHAR will occupy when displayed.
  35  [Mule compatible function in tm-nemacs]"
  36   (if (< chr 128) 1 2))
  37
  38 (defun code-convert-string (str ic oc)
  39   "Convert code in STRING from SOURCE code to TARGET code,
  40 On successful converion, returns the result string,
  41 else returns nil. [Mule compatible function in tm-nemacs]"
  42   (if (not (eq ic oc))
  43       (convert-string-kanji-code str ic oc)
  44     str))
  45
  46 (defun check-ASCII-string (str)
  47   (let ((i 0)
  48         len)
  49     (setq len (length str))
  50     (catch 'label
  51       (while (< i len)
  52         (if (>= (elt str i) 128)
  53             (throw 'label nil))
  54         (setq i (+ i 1))
  55         )
  56       str)))
  57
  58 (defun get-lc (chr)
  59   "Return leading character of CHAR or LEADING-CHARACTER."
  60   (if (< chr 128)
  61       lc-ascii
  62     lc-jp))
  63
  64
  65 ;; by YAMATE Keiichirou 1994/10/28
  66 (defun attribute-add-narrow-attribute (attr from to)
  67   (or (consp (symbol-value attr))
  68       (set attr (list 1)))
  69   (let* ((attr-value (symbol-value attr))
  70          (len (car attr-value))
  71          (posfrom 1)
  72          posto)
  73     (while (and (< posfrom len)
  74                 (> from (nth posfrom attr-value)))
  75       (setq posfrom (1+ posfrom)))
  76     (setq posto posfrom)
  77     (while (and (< posto len)
  78                 (> to (nth posto attr-value)))
  79       (setq posto (1+ posto)))
  80     (if  (= posto posfrom)
  81         (if (= (% posto 2) 1)
  82             (if (and (< to len)
  83                      (= to (nth posto attr-value)))
  84                 (set-marker (nth posto attr-value) from)
  85               (setcdr (nthcdr (1- posfrom) attr-value)
  86                       (cons (set-marker-type (set-marker (make-marker)
  87                                                          from)
  88                                              'point-type)
  89                             (cons (set-marker-type (set-marker (make-marker)
  90                                                                to)
  91                                                    nil)
  92                                   (nthcdr posto attr-value))))
  93               (setcar attr-value (+ len 2))))
  94       (if (= (% posfrom 2) 0)
  95           (setq posfrom (1- posfrom))
  96         (set-marker (nth posfrom attr-value) from))
  97       (if (= (% posto 2) 0)
  98           nil
  99         (setq posto (1- posto))
 100         (set-marker (nth posto attr-value) to))
 101       (setcdr (nthcdr posfrom attr-value)
 102               (nthcdr posto attr-value)))))
 103
 104
 105 (provide 'emu-nemacs)