502
+ − 1 ;;; mule-charset.el --- Charset functions for Mule. -*- coding: iso-2022-7bit; -*-
428
+ − 2
+ − 3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
+ − 4 ;; Copyright (C) 1995 Amdahl Corporation.
+ − 5 ;; Copyright (C) 1996 Sun Microsystems.
777
+ − 6 ;; Copyright (C) 2002 Ben Wing.
428
+ − 7
+ − 8 ;; Author: Unknown
+ − 9 ;; Keywords: i18n, mule, internal
+ − 10
+ − 11 ;; This file is part of XEmacs.
+ − 12
+ − 13 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 14 ;; under the terms of the GNU General Public License as published by
+ − 15 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 16 ;; any later version.
+ − 17
+ − 18 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 21 ;; General Public License for more details.
+ − 22
+ − 23 ;; You should have received a copy of the GNU General Public License
+ − 24 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 26 ;; Boston, MA 02111-1307, USA.
+ − 27
+ − 28 ;;; Synched up with: Not synched. API at source level synched with FSF 20.3.9.
+ − 29
+ − 30 ;;; Commentary:
+ − 31
+ − 32 ;; These functions are not compatible at the bytecode level with Emacs/Mule,
+ − 33 ;; and they never will be. -sb [1999-05-26]
+ − 34
+ − 35 ;;; Code:
+ − 36
+ − 37 ;;;; Classifying text according to charsets
+ − 38
+ − 39 (defun charsets-in-region (start end &optional buffer)
+ − 40 "Return a list of the charsets in the region between START and END.
+ − 41 BUFFER defaults to the current buffer if omitted."
+ − 42 (let (list)
+ − 43 (save-excursion
+ − 44 (if buffer
+ − 45 (set-buffer buffer))
+ − 46 (save-restriction
+ − 47 (narrow-to-region start end)
+ − 48 (goto-char (point-min))
+ − 49 (while (not (eobp))
+ − 50 (let* (prev-charset
+ − 51 (ch (char-after (point)))
+ − 52 (charset (char-charset ch)))
+ − 53 (if (not (eq prev-charset charset))
+ − 54 (progn
+ − 55 (setq prev-charset charset)
+ − 56 (or (memq charset list)
+ − 57 (setq list (cons charset list))))))
+ − 58 (forward-char))))
+ − 59 list))
+ − 60
+ − 61 (defun charsets-in-string (string)
+ − 62 "Return a list of the charsets in STRING."
+ − 63 (let ((i 0)
+ − 64 (len (length string))
+ − 65 prev-charset charset list)
+ − 66 (while (< i len)
+ − 67 (setq charset (char-charset (aref string i)))
+ − 68 (if (not (eq prev-charset charset))
+ − 69 (progn
+ − 70 (setq prev-charset charset)
+ − 71 (or (memq charset list)
+ − 72 (setq list (cons charset list)))))
+ − 73 (setq i (1+ i)))
+ − 74 list))
+ − 75
771
+ − 76 (defalias 'find-charset-string 'charsets-in-string)
+ − 77 (defalias 'find-charset-region 'charsets-in-region)
428
+ − 78
+ − 79 ;;;; Charset accessors
+ − 80
+ − 81 (defun charset-iso-graphic-plane (charset)
+ − 82 "Return the `graphic' property of CHARSET.
+ − 83 See `make-charset'."
+ − 84 (charset-property charset 'graphic))
+ − 85
+ − 86 (defun charset-iso-final-char (charset)
+ − 87 "Return the final byte of the ISO 2022 escape sequence designating CHARSET."
+ − 88 (charset-property charset 'final))
+ − 89
+ − 90 (defun charset-chars (charset)
+ − 91 "Return the number of characters per dimension of CHARSET."
+ − 92 (charset-property charset 'chars))
+ − 93
+ − 94 (defun charset-width (charset)
+ − 95 "Return the number of display columns per character of CHARSET.
+ − 96 This only applies to TTY mode (under X, the actual display width can
+ − 97 be automatically determined)."
+ − 98 (charset-property charset 'columns))
+ − 99
+ − 100 ;; #### FSFmacs returns 0
+ − 101 (defun charset-direction (charset)
+ − 102 "Return the display direction (0 for `l2r' or 1 for `r2l') of CHARSET.
+ − 103 Only left-to-right is currently implemented."
+ − 104 (if (eq (charset-property charset 'direction) 'l2r)
+ − 105 0
+ − 106 1))
+ − 107
+ − 108 ;; Not in Emacs/Mule
+ − 109 (defun charset-registry (charset)
+ − 110 "Return the registry of CHARSET.
+ − 111 This is a regular expression matching the registry field of fonts
+ − 112 that can display the characters in CHARSET."
+ − 113 (charset-property charset 'registry))
+ − 114
+ − 115 (defun charset-ccl-program (charset)
+ − 116 "Return the CCL program of CHARSET.
+ − 117 See `make-charset'."
+ − 118 (charset-property charset 'ccl-program))
+ − 119
+ − 120 (defun charset-bytes (charset)
+ − 121 "Useless in XEmacs, returns 1."
+ − 122 1)
+ − 123
+ − 124 (define-obsolete-function-alias 'charset-columns 'charset-width) ;; 19990409
+ − 125 (define-obsolete-function-alias 'charset-final 'charset-iso-final-char) ;; 19990409
+ − 126 (define-obsolete-function-alias 'charset-graphic 'charset-iso-graphic-plane) ;; 19990409
+ − 127 (define-obsolete-function-alias 'charset-doc-string 'charset-description) ;; 19990409
+ − 128
+ − 129 ;;;; Define setf methods for all settable Charset properties
+ − 130
+ − 131 (defsetf charset-registry set-charset-registry)
+ − 132 (defsetf charset-ccl-program set-charset-ccl-program)
+ − 133
+ − 134 ;;; FSF compatibility functions
+ − 135 (defun charset-after (&optional pos)
+ − 136 "Return charset of a character in current buffer at position POS.
+ − 137 If POS is nil, it defauls to the current point.
+ − 138 If POS is out of range, the value is nil."
+ − 139 (when (null pos)
+ − 140 (setq pos (point)))
+ − 141 (check-argument-type 'integerp pos)
+ − 142 (unless (or (< pos (point-min))
+ − 143 (> pos (point-max)))
+ − 144 (char-charset (char-after pos))))
+ − 145
+ − 146 ;; Yuck!
771
+ − 147 ;; We're not going to support these.
+ − 148 ;(defun charset-info (charset) [incredibly broken function with random vectors]
+ − 149 ;(defun define-charset (...) [incredibly broken function with random vectors]
428
+ − 150
+ − 151 ;;; Charset property
+ − 152
+ − 153 (defalias 'get-charset-property 'get)
+ − 154 (defalias 'put-charset-property 'put)
+ − 155 (defalias 'charset-plist 'object-plist)
+ − 156 (defalias 'set-charset-plist 'setplist)
+ − 157
771
+ − 158
442
+ − 159 ;; Setup auto-fill-chars for charsets that should invoke auto-filling.
777
+ − 160 ;; SPACE and NEWLINE are already set.
442
+ − 161 (let ((l '(katakana-jisx0201
+ − 162 japanese-jisx0208 japanese-jisx0212
+ − 163 chinese-gb2312 chinese-big5-1 chinese-big5-2)))
+ − 164 (while l
+ − 165 (put-char-table (car l) t auto-fill-chars)
+ − 166 (setq l (cdr l))))
+ − 167
428
+ − 168 ;;; mule-charset.el ends here
