annotate lisp/coding.el @ 4477:e34711681f30

Don't determine whether to call general device-type code at startup, rather decide in the device-specific code itself. lisp/ChangeLog addition: 2008-07-07 Aidan Kehoe <kehoea@parhasard.net> Patch to make it up to the device-specific code whether various Lisp functions should be called during device creation, not relying on the startup code to decide this. Also, rename initial-window-system to initial-device-type (which makes more sense in this scheme), always set it. * startup.el (command-line): Use initial-device-type, not initial-window-system; just call #'make-device, leave the special behaviour to be done the first time a console type is initialised to be decided on by the respective console code. * x-init.el (x-app-defaults-directory): Declare that it should be bound. (x-define-dead-key): Have the macro take a DEVICE argument. (x-initialize-compose): Have the function take a DEVICE argument, and use it when checking if various keysyms are available on the keyboard. (x-initialize-keyboard): Have the function take a DEVICE argument, allowing device-specific keyboard initialisation. (make-device-early-x-entry-point-called-p): New. (make-device-late-x-entry-point-called-p): New. Rename pre-x-win-initted, x-win-initted. (make-device-early-x-entry-point): Rename init-pre-x-win, take the call to make-x-device out (it should be called from the device-creation code, not vice-versa). (make-device-late-x-entry-point): Rename init-post-x-win, have it take a DEVICE argument, use that DEVICE argument when working out what device-specific things need doing. Don't use create-console-hook in core code. * x-win-xfree86.el (x-win-init-xfree86): Take a DEVICE argument; use it. * x-win-sun.el (x-win-init-sun): Take a DEVICE argument; use it. * mule/mule-x-init.el: Remove #'init-mule-x-win, an empty function. * tty-init.el (make-device-early-tty-entry-point-called-p): New. Rename pre-tty-win-initted. (make-device-early-tty-entry-point): New. Rename init-pre-tty-win. (make-frame-after-init-entry-point): New. Rename init-post-tty-win to better reflect when it's called. * gtk-init.el (gtk-early-lisp-options-file): New. Move this path to a documented variable. (gtk-command-switch-alist): Wrap the docstring to fewer than 79 columns. (make-device-early-gtk-entry-point-called-p): New. (make-device-late-gtk-entry-point-called-p): New. Renamed gtk-pre-win-initted, gtk-post-win-initted to these. (make-device-early-gtk-entry-point): New. (make-device-late-gtk-entry-point): New. Renamed init-pre-gtk-win, init-post-gtk-win to these. Have make-device-late-gtk-entry-point take a device argument, and use it; have make-device-early-gtk-entry-point load the GTK-specific startup code, instead of doing that in C. (init-gtk-win): Deleted, functionality moved to the GTK device creation code. (gtk-define-dead-key): Have it take a DEVICE argument; use this argument. (gtk-initialize-compose): Ditto. * coding.el (set-terminal-coding-system): Correct the docstring; the function isn't broken. src/ChangeLog addition: 2008-07-07 Aidan Kehoe <kehoea@parhasard.net> Patch to make it up to the device-specific code whether various Lisp functions should be called during device creation, not relying on the startup code to decide this. Also, rename initial-window-system to initial-device-type (which makes more sense in this scheme), always set it. * redisplay.c (Vinitial_device_type): New. (Vinitial_window_system): Removed. Rename initial-window-system to initial-device type, making it a stream if we're noninteractive. Update its docstring. * device-x.c (Qmake_device_early_x_entry_point, Qmake_device_late_x_entry_point): New. Rename Qinit_pre_x_win, Qinit_post_x_win. (x_init_device): Call #'make-device-early-x-entry-point earlier, now we rely on it to find the application class and the app-defaults directory. (x_finish_init_device): Call #'make-device-late-x-entry-point with the created device. (Vx_app_defaults_directory): Always make this available, to simplify code in x-init.el. * device-tty.c (Qmake_device_early_tty_entry_point): New. Rename Qinit_pre_tty_win, rename Qinit_post_tty_win and move to frame-tty.c as Qmake_frame_after_init_entry_point. (tty_init_device): Call #'make-device-early-tty-entry-point before doing anything. * frame-tty.c (Qmake_frame_after_init_entry_point): New. * frame-tty.c (tty_after_init_frame): Have it call the better-named #'make-frame-after-init-entry-point function instead of #'init-post-tty-win (since it's called after frame, not device, creation). * device-msw.c (Qmake_device_early_mswindows_entry_point, Qmake_device_late_mswindows_entry_point): New. Rename Qinit_pre_mswindows_win, Qinit_post_mswindows_win. (mswindows_init_device): Call #'make-device-early-mswindows-entry-point here, instead of having its predecessor call us. (mswindows_finish_init_device): Call #'make-device-early-mswindows-entry-point, for symmetry with the other device types (though it's an empty function). * device-gtk.c (Qmake_device_early_gtk_entry_point, Qmake_device_late_gtk_entry_point): New. Rename Qinit_pre_gtk_win, Qinit_post_gtk_win. (gtk_init_device): Call #'make-device-early-gtk-entry-point; don't load ~/.xemacs/gtk-options.el ourselves, leave that to lisp. (gtk_finish_init_device): Call #'make-device-late-gtk-entry-point with the created device as an argument.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 09 Jul 2008 20:46:22 +0200
parents dd9c1d5f5319
children 46ddeaa7c738
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; coding.el --- Coding-system functions for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Licensed to the Free Software Foundation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995 Amdahl Corporation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Copyright (C) 1995 Sun Microsystems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Copyright (C) 1997 MORIOKA Tomohiko
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; split off of mule.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
33 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
34 '(coding-system-lock-shift
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
35 coding-system-seven coding-system-charset charset-dimension))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
36
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (defalias 'check-coding-system 'get-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (defun modify-coding-system-alist (target-type regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 "Modify one of look up tables for finding a coding system on I/O operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 There are three of such tables, `file-coding-system-alist',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 `process-coding-system-alist', and `network-coding-system-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 TARGET-TYPE specifies which of them to modify.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 If it is `file', it affects `file-coding-system-alist' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 If it is `process', it affects `process-coding-system-alist' (which see).
599
55614ee2fb8d [xemacs-hg @ 2001-06-01 06:30:08 by martinb]
martinb
parents: 502
diff changeset
47 If it is `network', it affects `network-coding-system-alist' (which see).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 REGEXP is a regular expression matching a target of I/O operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 The target is a file name if TARGET-TYPE is `file', a program name if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 TARGET-TYPE is `process', or a network service name or a port number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 to connect to if TARGET-TYPE is `network'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 CODING-SYSTEM is a coding system to perform code conversion on the I/O
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 for decoding and encoding respectively,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 or a function symbol which, when called, returns such a cons cell."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (or (memq target-type '(file process network))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (error "Invalid target type: %s" target-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 (or (stringp regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (and (eq target-type 'network) (integerp regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (error "Invalid regular expression: %s" regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (if (symbolp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (if (not (fboundp coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (check-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (setq coding-system (cons coding-system coding-system))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (check-coding-system (car coding-system))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (check-coding-system (cdr coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (cond ((eq target-type 'file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (let ((slot (assoc regexp file-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (setq file-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 file-coding-system-alist)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ((eq target-type 'process)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (let ((slot (assoc regexp process-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (setq process-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 process-coding-system-alist)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (let ((slot (assoc regexp network-coding-system-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (if slot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (setcdr slot coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (setq network-coding-system-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (cons (cons regexp coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 network-coding-system-alist)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (defsubst keyboard-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 "Return coding-system of what is sent from terminal keyboard."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 keyboard-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (defun set-keyboard-coding-system (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 "Set the coding system used for TTY keyboard input. Currently broken."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (interactive "zkeyboard-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (setq keyboard-coding-system coding-system)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
101 (if (eq (device-type) 'tty)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
102 (declare-fboundp (set-console-tty-input-coding-system
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
103 (device-console) keyboard-coding-system)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (defsubst terminal-coding-system ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "Return coding-system of your terminal."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 terminal-coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (defun set-terminal-coding-system (coding-system)
4477
e34711681f30 Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents: 4227
diff changeset
111 "Set the coding system used for TTY display output."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (interactive "zterminal-coding-system: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (get-coding-system coding-system) ; correctness check
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (setq terminal-coding-system coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 ; #### should this affect all current tty consoles ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (if (eq (device-type) 'tty)
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
117 (declare-fboundp (set-console-tty-output-coding-system
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
118 (device-console) terminal-coding-system)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (redraw-modeline t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (defun what-coding-system (start end &optional arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 "Show the encoding of text in the region.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 This function is meant to be called interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 from a Lisp program, use `detect-coding-region' instead."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (interactive "r\nP")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (princ (detect-coding-region start end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (defun decode-coding-string (str coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 "Decode the string STR which is encoded in CODING-SYSTEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Does not modify STR. Returns the decoded string on successful conversion."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 (with-string-as-buffer-contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 str (decode-coding-region (point-min) (point-max) coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (defun encode-coding-string (str coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 "Encode the string STR using CODING-SYSTEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Does not modify STR. Returns the encoded string on successful conversion."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (with-string-as-buffer-contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 str (encode-coding-region (point-min) (point-max) coding-system)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 ;;;; Coding system accessors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (defun coding-system-mnemonic (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 "Return the 'mnemonic property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (coding-system-property coding-system 'mnemonic))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
147 (defun coding-system-documentation (coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
148 "Return the 'documentation property of CODING-SYSTEM."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
149 (coding-system-property coding-system 'documentation))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
150
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
151 (define-obsolete-function-alias 'coding-system-doc-string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
152 'coding-system-description)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (defun coding-system-eol-type (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 "Return the 'eol-type property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (coding-system-property coding-system 'eol-type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (defun coding-system-eol-lf (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 "Return the 'eol-lf property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (coding-system-property coding-system 'eol-lf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (defun coding-system-eol-crlf (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 "Return the 'eol-crlf property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (coding-system-property coding-system 'eol-crlf))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (defun coding-system-eol-cr (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 "Return the 'eol-cr property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (coding-system-property coding-system 'eol-cr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (defun coding-system-post-read-conversion (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 "Return the 'post-read-conversion property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (coding-system-property coding-system 'post-read-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (defun coding-system-pre-write-conversion (coding-system)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 "Return the 'pre-write-conversion property of CODING-SYSTEM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (coding-system-property coding-system 'pre-write-conversion))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
178 ;;; #### bleagh!!!!!!!
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
179
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
180 (defun coding-system-get (coding-system prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
181 "Extract a value from CODING-SYSTEM's property list for property PROP."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
182 (or (plist-get
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
183 (get (coding-system-name coding-system) 'coding-system-property)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
184 prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
185 (condition-case nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
186 (coding-system-property coding-system prop)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
187 (error nil))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
188
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
189 (defun coding-system-put (coding-system prop value)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
190 "Change value in CODING-SYSTEM's property list PROP to VALUE."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
191 (put (coding-system-name coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
192 'coding-system-property
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
193 (plist-put (get (coding-system-name coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
194 'coding-system-property)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
195 prop value)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
196
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
197 (defun coding-system-category (coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
198 "Return the coding category of CODING-SYSTEM."
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
199 (or (coding-system-get coding-system 'category)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
200 (case (coding-system-type coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
201 (no-conversion 'no-conversion)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
202 (shift-jis 'shift-jis)
3767
6b2ef948e140 [xemacs-hg @ 2006-12-29 18:09:38 by aidan]
aidan
parents: 985
diff changeset
203 (unicode (case (coding-system-property coding-system 'unicode-type)
985
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs]
youngs
parents: 771
diff changeset
204 (utf-8 (let ((bom (coding-system-property coding-system
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs]
youngs
parents: 771
diff changeset
205 'need-bom)))
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs]
youngs
parents: 771
diff changeset
206 (cond (bom 'utf-8-bom)
7f62a956b825 [xemacs-hg @ 2002-09-01 06:41:40 by youngs]
youngs
parents: 771
diff changeset
207 ((not bom) 'utf-8))))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
208 (ucs-4 'ucs-4)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
209 (utf-16 (let ((bom (coding-system-property coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
210 'need-bom))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
211 (le (coding-system-property coding-system
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
212 'little-endian)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
213 (cond ((and bom le) 'utf-16-little-endian-bom)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
214 ((and bom (not le) 'utf-16-bom))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
215 ((and (not bom) le) 'utf-16-little-endian)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
216 ((and (not bom) (not le) 'utf-16)))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
217 (big5 'big5)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
218 (iso2022 (cond ((coding-system-lock-shift coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
219 'iso-lock-shift)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
220 ((coding-system-seven coding-system)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
221 'iso-7)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
222 (t
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
223 (let ((dim 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
224 ccs
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
225 (i 0))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
226 (while (< i 4)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
227 (setq ccs (declare-fboundp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
228 (coding-system-iso2022-charset
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
229 coding-system i)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
230 (if (and ccs
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
231 (> (charset-dimension ccs) dim))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
232 (setq dim (charset-dimension ccs))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
233 )
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
234 (setq i (1+ i)))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
235 (cond ((= dim 1) 'iso-8-1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
236 ((= dim 2) 'iso-8-2)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
237 (t 'iso-8-designate))))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
238 )))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
239
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
241 ;;; Make certain variables equivalent to coding-system aliases
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
242 (defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
243 (define-coding-system-alias 'file-name (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
244
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
245 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
246 'file-name-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
247 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
248 'dontusethis-set-value-file-name-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
249
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
250 (defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
251 (define-coding-system-alias 'terminal (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
252
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
253 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
254 'terminal-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
255 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
256 'dontusethis-set-value-terminal-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
257
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
258 (defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
259 (define-coding-system-alias 'keyboard (or (car args) 'binary)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
260
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
261 (dontusethis-set-symbol-value-handler
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
262 'keyboard-coding-system
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
263 'set-value
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
264 'dontusethis-set-value-keyboard-coding-system-handler)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
265
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
266 (when (not (featurep 'mule))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 728
diff changeset
267 (define-coding-system-alias 'escape-quoted 'binary)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
268 ;; these are so that gnus and friends work when not mule
4227
dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan]
aidan
parents: 4222
diff changeset
269 (define-coding-system-alias 'iso-8859-1 'raw-text)
4222
38ef5a6da799 [xemacs-hg @ 2007-10-13 14:08:26 by aidan]
aidan
parents: 3767
diff changeset
270 ;; We're misrepresenting ourselves to the gnus code by saying we support
38ef5a6da799 [xemacs-hg @ 2007-10-13 14:08:26 by aidan]
aidan
parents: 3767
diff changeset
271 ;; both.
4227
dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan]
aidan
parents: 4222
diff changeset
272 ; (define-coding-system-alias 'iso-8859-2 'raw-text)
dd9c1d5f5319 [xemacs-hg @ 2007-10-15 10:53:33 by aidan]
aidan
parents: 4222
diff changeset
273 (define-coding-system-alias 'ctext 'raw-text))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
274
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (make-compatible-variable 'enable-multibyte-characters "Unimplemented")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
728
4d00488244c1 [xemacs-hg @ 2002-01-10 09:50:43 by stephent]
stephent
parents: 599
diff changeset
277 ;;; coding.el ends here