;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Copyright (C) 2003
(or (local-variable-p 'buffer-file-coding-system buffer)
(ucs-set-table-for-input buffer))))
- (if default-enable-multibyte-characters
+ (if (and default-enable-multibyte-characters (not (eq system-type 'darwin)))
+ ;; The file-name coding system on Darwin systems is always utf-8.
(setq default-file-name-coding-system coding-system))
;; If coding-system is nil, honor that on MS-DOS as well, so
;; that they could reset the terminal coding system.
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
+ ;; On Darwin systems, this should be utf-8, but when this file is loaded
+ ;; utf-8 is not yet defined, so we set it in set-locale-environment instead.
(setq default-file-name-coding-system 'iso-latin-1)
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
(if (eq window-system 'pc)
(setq nonascii (intern "cp%d" dos-codepage)))
(or (and (charsetp nonascii)
- (= (charset-dimension nonascii) 1))
+ (get-charset-property nonascii :ascii-compatible-p))
(setq nonascii 'iso-8859-1))
(set-unibyte-charset nonascii))
Setting this variable directly does not take effect. See
`set-language-info-alist' for use in programs."
:group 'mule
- :version "22.1"
+ :version "23.1"
:set (lambda (s v)
(custom-set-default s v)
;; Can't do this before language environments are set up.
;; different there.
(or (and (eq window-system 'pc) (not default-enable-multibyte-characters))
(progn
- ;; Make non-line-break space display as a plain space.
- ;; Most X fonts do the wrong thing for code 160.
- (aset standard-display-table 160 [32])
- ;; With luck, non-Latin-1 fonts are more recent and so don't
- ;; have this bug.
- (aset standard-display-table (make-char 'latin-iso8859-1 160) [32])
+ ;; Most X fonts used to do the wrong thing for latin-1 code 160.
+ (unless (and (eq window-system 'x)
+ ;; XFree86 4 has fixed the fonts.
+ (string= "The XFree86 Project, Inc" (x-server-vendor))
+ (> (aref (number-to-string (nth 2 (x-server-version))) 0)
+ ?3))
+ ;; Make non-line-break space display as a plain space.
+ (aset standard-display-table 160 [32]))
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
- (aset standard-display-table 146 [39])
- ;; XFree86 4 has changed most of the fonts from their designed
- ;; versions such that `' no longer appears as balanced quotes.
- ;; Assume it has iso10646 fonts installed, so we can display
- ;; balanced quotes.
- (when (and (eq window-system 'x)
- (string= "The XFree86 Project, Inc" (x-server-vendor))
- (> (aref (number-to-string (nth 2 (x-server-version))) 0)
- ?3))
- ;; We suppress these setting for the moment because the
- ;; above assumption is wrong.
- ;; (aset standard-display-table ?' [?\e,F"\e(B])
- ;; (aset standard-display-table ?` [?\e,F!\e(B])
- ;; The fonts don't have the relevant bug.
- (aset standard-display-table 160 nil)
- (aset standard-display-table (make-char 'latin-iso8859-1 160)
- nil)))))
+ (aset standard-display-table 146 [39]))))
(defun set-language-environment-coding-systems (language-name
&optional eol-type)
(setq language-name (symbol-name language-name)))
(dolist (feature (get-language-info language-name 'features))
(require feature))
- (let ((doc (get-language-info language-name 'documentation))
- pos)
+ (let ((doc (get-language-info language-name 'documentation)))
(help-setup-xref (list #'describe-language-environment language-name)
(interactive-p))
(with-output-to-temp-buffer (help-buffer)
(message "Warning: Default coding system `%s' disagrees with
system codeset `%s' for this locale." coding-system codeset))))))))
- ;; On Windows, override locale-coding-system, keyboard-coding-system,
- ;; selection-coding-system with system codepage.
+ ;; On Windows, override locale-coding-system,
+ ;; keyboard-coding-system with system codepage. Note:
+ ;; selection-coding-system is already set in w32select.c.
(when (boundp 'w32-ansi-code-page)
(let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
(when (coding-system-p code-page-coding)
(setq locale-coding-system code-page-coding)
- (set-selection-coding-system code-page-coding)
(set-keyboard-coding-system code-page-coding)
(set-terminal-coding-system code-page-coding))))
+ ;; On Darwin, file names are always encoded in utf-8, no matter the locale.
+ (when (eq system-type 'darwin)
+ (setq default-file-name-coding-system 'utf-8))
+
;; Default to A4 paper if we're not in a C, POSIX or US locale.
;; (See comments in Flocale_info.)
(let ((locale locale)
'a4))))))
nil)
\f
-;;; Character code property
-(put 'char-code-property-table 'char-table-extra-slots 0)
+;;; Character property
+
+;; Each element has the form (PROP . TABLE).
+;; PROP is a symbol representing a character property.
+;; TABLE is a char-table containing the property value for each character.
+;; TABLE may be a name of file to load to build a char-table.
+;; Don't modify this variable directly but use `define-char-code-property'.
+
+(defvar char-code-property-alist nil
+ "Alist of character property name vs char-table containing property values.
+Internal use only.")
+
+(put 'char-code-property-table 'char-table-extra-slots 5)
+
+(defun define-char-code-property (name table &optional docstring)
+ "Define NAME as a character code property given by TABLE.
+TABLE is a char-table of purpose `char-code-property-table' with
+these extra slots:
+ 1st: NAME.
+ 2nd: Function to call to get a property value of a character.
+ It is called with three arugments CHAR, VAL, and TABLE, where
+ CHAR is a character, VAL is the value of (aref TABLE CHAR).
+ 3rd: Function to call to put a property value of a character.
+ It is called with the same arguments as above.
+ 4th: Function to call to get a description string of a property value.
+ It is called with one argument VALUE, a property value.
+ 5th: Data used by the above functions.
+
+TABLE may be a name of file to load to build a char-table. The
+file should contain a call of `define-char-code-property' with a
+char-table of the above format as the argument TABLE.
+
+TABLE may also be nil, in which case no property value is pre-assigned.
+
+Optional 3rd argment DOCSTRING is a documentation string of the property.
+
+See also the documentation of `get-char-code-property' and
+`put-char-code-property'."
+ (or (symbolp name)
+ (error "Not a symbol: %s" name))
+ (if (char-table-p table)
+ (or (and (eq (char-table-subtype table) 'char-code-property-table)
+ (eq (char-table-extra-slot table 0) name))
+ (error "Invalid char-table: %s" table))
+ (or (stringp table)
+ (error "Not a char-table nor a file name: %s" table)))
+ (let ((slot (assq name char-code-property-alist)))
+ (if slot
+ (setcdr slot table)
+ (setq char-code-property-alist
+ (cons (cons name table) char-code-property-alist))))
+ (put name 'char-code-property-documentation docstring))
(defvar char-code-property-table
(make-char-table 'char-code-property-table)
"Char-table containing a property list of each character code.
-
+This table is used for properties not listed in `char-code-property-alist'.
See also the documentation of `get-char-code-property' and
`put-char-code-property'.")
(defun get-char-code-property (char propname)
- "Return the value of CHAR's PROPNAME property in `char-code-property-table'."
- (let ((plist (aref char-code-property-table char)))
- (if (listp plist)
- (car (cdr (memq propname plist))))))
+ "Return the value of CHAR's PROPNAME property."
+ (let ((slot (assq propname char-code-property-alist)))
+ (if slot
+ (let (table value func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ value (aref table char)
+ func (char-table-extra-slot table 1))
+ (if (functionp func)
+ (setq value (funcall func char value table)))
+ value)
+ (plist-get (aref char-code-property-table char) propname))))
(defun put-char-code-property (char propname value)
- "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'.
+ "Store CHAR's PROPNAME property with VALUE.
It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
- (let ((plist (aref char-code-property-table char)))
- (if plist
- (let ((slot (memq propname plist)))
- (if slot
- (setcar (cdr slot) value)
- (nconc plist (list propname value))))
- (aset char-code-property-table char (list propname value)))))
+ (let ((slot (assq propname char-code-property-alist)))
+ (if slot
+ (let (table func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ func (char-table-extra-slot table 2))
+ (if (functionp func)
+ (funcall func char value table)
+ (aset table char value)))
+ (let* ((plist (aref char-code-property-table char))
+ (x (plist-put plist propname value)))
+ (or (eq x plist)
+ (aset char-code-property-table char x))))
+ value))
+
+(defun char-code-property-description (prop value)
+ "Return a description string of character property PROP's value VALUE.
+If there's no description string for VALUE, return nil."
+ (let ((slot (assq prop char-code-property-alist)))
+ (if slot
+ (let (table func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ func (char-table-extra-slot table 3))
+ (if (functionp func)
+ (funcall func value))))))
\f
;; Pretty description of encoded string