poem-nemacs.el

   1 ;;; poem-nemacs.el --- poem implementation for Nemacs
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: emulation, compatibility, Mule
   7
   8 ;; This file is part of APEL (A Portable Emacs Library).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Code:
  26
  27 ;;; @ character set
  28 ;;;
  29
  30 (put 'ascii
  31      'charset-description "Character set of ASCII")
  32 (put 'ascii
  33      'charset-registry "ASCII")
  34
  35 (put 'japanese-jisx0208
  36      'charset-description "Character set of JIS X0208-1983")
  37 (put 'japanese-jisx0208
  38      'charset-registry "JISX0208.1983")
  39
  40 (defun charset-description (charset)
  41   "Return description of CHARSET. [emu-nemacs.el]"
  42   (get charset 'charset-description))
  43
  44 (defun charset-registry (charset)
  45   "Return registry name of CHARSET. [emu-nemacs.el]"
  46   (get charset 'charset-registry))
  47
  48 (defun charset-width (charset)
  49   "Return number of columns a CHARSET occupies when displayed.
  50 \[emu-nemacs.el]"
  51   (if (eq charset 'ascii)
  52       1
  53     2))
  54
  55 (defun charset-direction (charset)
  56   "Return the direction of a character of CHARSET by
  57   0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]"
  58   0)
  59
  60 (defun find-charset-string (str)
  61   "Return a list of charsets in the string.
  62 \[emu-nemacs.el; Mule emulating function]"
  63   (if (string-match "[\200-\377]" str)
  64       '(japanese-jisx0208)
  65     ))
  66
  67 (defalias 'find-non-ascii-charset-string 'find-charset-string)
  68
  69 (defun find-charset-region (start end)
  70   "Return a list of charsets in the region between START and END.
  71 \[emu-nemacs.el; Mule emulating function]"
  72   (if (save-excursion
  73         (save-restriction
  74           (narrow-to-region start end)
  75           (goto-char start)
  76           (re-search-forward "[\200-\377]" nil t)))
  77       '(japanese-jisx0208)
  78     ))
  79
  80 (defalias 'find-non-ascii-charset-region 'find-charset-region)
  81
  82 (defun check-ASCII-string (str)
  83   (let ((i 0)
  84         len)
  85     (setq len (length str))
  86     (catch 'label
  87       (while (< i len)
  88         (if (>= (elt str i) 128)
  89             (throw 'label nil))
  90         (setq i (+ i 1)))
  91       str)))
  92
  93 ;;; @@ for old MULE emulation
  94 ;;;
  95
  96 ;;(defconst lc-ascii 0)
  97 ;;(defconst lc-jp  146)
  98
  99
 100 ;;; @ buffer representation
 101 ;;;
 102
 103 (defsubst-maybe set-buffer-multibyte (flag)
 104   "Set the multibyte flag of the current buffer to FLAG.
 105 If FLAG is t, this makes the buffer a multibyte buffer.
 106 If FLAG is nil, this makes the buffer a single-byte buffer.
 107 The buffer contents remain unchanged as a sequence of bytes
 108 but the contents viewed as characters do change.
 109 \[Emacs 20.3 emulating function]"
 110   (setq kanji-flag flag)
 111   )
 112
 113
 114 ;;; @ character
 115 ;;;
 116
 117 (defun char-charset (chr)
 118   "Return the character set of char CHR.
 119 \[emu-nemacs.el; MULE emulating function]"
 120   (if (< chr 128)
 121       'ascii
 122     'japanese-jisx0208))
 123
 124 (defun char-bytes (chr)
 125   "Return number of bytes CHAR will occupy in a buffer.
 126 \[emu-nemacs.el; Mule emulating function]"
 127   (if (< chr 128)
 128       1
 129     2))
 130
 131 (defun char-width (char)
 132   "Return number of columns a CHAR occupies when displayed.
 133 \[emu-nemacs.el]"
 134   (if (< char 128)
 135       1
 136     2))
 137
 138 (defalias 'char-length 'char-bytes)
 139
 140 (defmacro char-next-index (char index)
 141   "Return index of character succeeding CHAR whose index is INDEX.
 142 \[emu-nemacs.el]"
 143   (` (+ (, index) (char-bytes (, char)))))
 144
 145
 146 ;;; @ string
 147 ;;;
 148
 149 (defalias 'string-width 'length)
 150
 151 (defun sref (str idx)
 152   "Return the character in STR at index IDX.
 153 \[emu-nemacs.el; Mule emulating function]"
 154   (let ((chr (aref str idx)))
 155     (if (< chr 128)
 156         chr
 157       (logior (lsh (aref str (1+ idx)) 8) chr))))
 158
 159 (defun string-to-char-list (str)
 160   (let ((i 0)(len (length str)) dest chr)
 161     (while (< i len)
 162       (setq chr (aref str i))
 163       (if (>= chr 128)
 164           (setq i (1+ i)
 165                 chr (+ (lsh chr 8) (aref str i)))
 166         )
 167       (setq dest (cons chr dest))
 168       (setq i (1+ i)))
 169     (reverse dest)))
 170
 171 (fset 'string-to-int-list (symbol-function 'string-to-char-list))
 172
 173 ;;; Imported from Mule-2.3
 174 (defun truncate-string (str width &optional start-column)
 175   "Truncate STR to fit in WIDTH columns.
 176 Optional non-nil arg START-COLUMN specifies the starting column.
 177 \[emu-mule.el; Mule 2.3 emulating function]"
 178   (or start-column
 179       (setq start-column 0))
 180   (let ((max-width (string-width str))
 181         (len (length str))
 182         (from 0)
 183         (column 0)
 184         to-prev to ch)
 185     (if (>= width max-width)
 186         (setq width max-width))
 187     (if (>= start-column width)
 188         ""
 189       (while (< column start-column)
 190         (setq ch (aref str from)
 191               column (+ column (char-width ch))
 192               from (+ from (char-bytes ch))))
 193       (if (< width max-width)
 194           (progn
 195             (setq to from)
 196             (while (<= column width)
 197               (setq ch (aref str to)
 198                     column (+ column (char-width ch))
 199                     to-prev to
 200                     to (+ to (char-bytes ch))))
 201             (setq to to-prev)))
 202       (substring str from to))))
 203
 204 (defalias 'looking-at-as-unibyte 'looking-at)
 205
 206 ;;; @@ obsoleted aliases
 207 ;;;
 208 ;;; You should not use them.
 209
 210 (defalias 'string-columns 'length)
 211
 212
 213 ;;; @ end
 214 ;;;
 215
 216 (require 'product)
 217 (product-provide (provide 'poem-nemacs) (require 'apel-ver))
 218
 219 ;;; poem-nemacs.el ends here