Mercurial > hg > xemacs-beta
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 |
rev | line source |
---|---|
428 | 1 ;;; coding.el --- Coding-system functions for XEmacs. |
2 | |
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
4 ;; Licensed to the Free Software Foundation. | |
5 ;; Copyright (C) 1995 Amdahl Corporation. | |
6 ;; Copyright (C) 1995 Sun Microsystems. | |
7 ;; Copyright (C) 1997 MORIOKA Tomohiko | |
771 | 8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing. |
428 | 9 |
10 ;; This file is part of XEmacs. | |
11 | |
12 ;; XEmacs is free software; you can redistribute it and/or modify it | |
13 ;; under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; XEmacs is distributed in the hope that it will be useful, but | |
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
20 ;; General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
440 | 23 ;; along with XEmacs; see the file COPYING. If not, write to the |
428 | 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;;; split off of mule.el. | |
30 | |
31 ;;; Code: | |
32 | |
502 | 33 (globally-declare-fboundp |
34 '(coding-system-lock-shift | |
35 coding-system-seven coding-system-charset charset-dimension)) | |
36 | |
428 | 37 (defalias 'check-coding-system 'get-coding-system) |
38 | |
39 (defun modify-coding-system-alist (target-type regexp coding-system) | |
40 "Modify one of look up tables for finding a coding system on I/O operation. | |
41 There are three of such tables, `file-coding-system-alist', | |
42 `process-coding-system-alist', and `network-coding-system-alist'. | |
43 | |
44 TARGET-TYPE specifies which of them to modify. | |
45 If it is `file', it affects `file-coding-system-alist' (which see). | |
46 If it is `process', it affects `process-coding-system-alist' (which see). | |
599 | 47 If it is `network', it affects `network-coding-system-alist' (which see). |
428 | 48 |
49 REGEXP is a regular expression matching a target of I/O operation. | |
50 The target is a file name if TARGET-TYPE is `file', a program name if | |
51 TARGET-TYPE is `process', or a network service name or a port number | |
52 to connect to if TARGET-TYPE is `network'. | |
53 | |
54 CODING-SYSTEM is a coding system to perform code conversion on the I/O | |
55 operation, or a cons cell (DECODING . ENCODING) specifying the coding systems | |
56 for decoding and encoding respectively, | |
57 or a function symbol which, when called, returns such a cons cell." | |
58 (or (memq target-type '(file process network)) | |
59 (error "Invalid target type: %s" target-type)) | |
60 (or (stringp regexp) | |
61 (and (eq target-type 'network) (integerp regexp)) | |
62 (error "Invalid regular expression: %s" regexp)) | |
63 (if (symbolp coding-system) | |
64 (if (not (fboundp coding-system)) | |
65 (progn | |
66 (check-coding-system coding-system) | |
67 (setq coding-system (cons coding-system coding-system)))) | |
68 (check-coding-system (car coding-system)) | |
69 (check-coding-system (cdr coding-system))) | |
70 (cond ((eq target-type 'file) | |
71 (let ((slot (assoc regexp file-coding-system-alist))) | |
72 (if slot | |
73 (setcdr slot coding-system) | |
74 (setq file-coding-system-alist | |
75 (cons (cons regexp coding-system) | |
76 file-coding-system-alist))))) | |
77 ((eq target-type 'process) | |
78 (let ((slot (assoc regexp process-coding-system-alist))) | |
79 (if slot | |
80 (setcdr slot coding-system) | |
81 (setq process-coding-system-alist | |
82 (cons (cons regexp coding-system) | |
83 process-coding-system-alist))))) | |
84 (t | |
85 (let ((slot (assoc regexp network-coding-system-alist))) | |
86 (if slot | |
87 (setcdr slot coding-system) | |
88 (setq network-coding-system-alist | |
89 (cons (cons regexp coding-system) | |
90 network-coding-system-alist))))))) | |
91 | |
92 (defsubst keyboard-coding-system () | |
93 "Return coding-system of what is sent from terminal keyboard." | |
94 keyboard-coding-system) | |
95 | |
96 (defun set-keyboard-coding-system (coding-system) | |
97 "Set the coding system used for TTY keyboard input. Currently broken." | |
98 (interactive "zkeyboard-coding-system: ") | |
99 (get-coding-system coding-system) ; correctness check | |
100 (setq keyboard-coding-system coding-system) | |
442 | 101 (if (eq (device-type) 'tty) |
502 | 102 (declare-fboundp (set-console-tty-input-coding-system |
103 (device-console) keyboard-coding-system))) | |
428 | 104 (redraw-modeline t)) |
105 | |
106 (defsubst terminal-coding-system () | |
107 "Return coding-system of your terminal." | |
108 terminal-coding-system) | |
109 | |
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 | 112 (interactive "zterminal-coding-system: ") |
113 (get-coding-system coding-system) ; correctness check | |
114 (setq terminal-coding-system coding-system) | |
115 ; #### should this affect all current tty consoles ? | |
116 (if (eq (device-type) 'tty) | |
502 | 117 (declare-fboundp (set-console-tty-output-coding-system |
118 (device-console) terminal-coding-system))) | |
428 | 119 (redraw-modeline t)) |
120 | |
121 (defun what-coding-system (start end &optional arg) | |
122 "Show the encoding of text in the region. | |
123 This function is meant to be called interactively; | |
124 from a Lisp program, use `detect-coding-region' instead." | |
125 (interactive "r\nP") | |
126 (princ (detect-coding-region start end))) | |
127 | |
128 (defun decode-coding-string (str coding-system) | |
129 "Decode the string STR which is encoded in CODING-SYSTEM. | |
130 Does not modify STR. Returns the decoded string on successful conversion." | |
131 (with-string-as-buffer-contents | |
132 str (decode-coding-region (point-min) (point-max) coding-system))) | |
133 | |
134 (defun encode-coding-string (str coding-system) | |
135 "Encode the string STR using CODING-SYSTEM. | |
136 Does not modify STR. Returns the encoded string on successful conversion." | |
137 (with-string-as-buffer-contents | |
138 str (encode-coding-region (point-min) (point-max) coding-system))) | |
139 | |
140 | |
141 ;;;; Coding system accessors | |
142 | |
143 (defun coding-system-mnemonic (coding-system) | |
144 "Return the 'mnemonic property of CODING-SYSTEM." | |
145 (coding-system-property coding-system 'mnemonic)) | |
146 | |
771 | 147 (defun coding-system-documentation (coding-system) |
148 "Return the 'documentation property of CODING-SYSTEM." | |
149 (coding-system-property coding-system 'documentation)) | |
150 | |
151 (define-obsolete-function-alias 'coding-system-doc-string | |
152 'coding-system-description) | |
428 | 153 |
154 (defun coding-system-eol-type (coding-system) | |
155 "Return the 'eol-type property of CODING-SYSTEM." | |
156 (coding-system-property coding-system 'eol-type)) | |
157 | |
158 (defun coding-system-eol-lf (coding-system) | |
159 "Return the 'eol-lf property of CODING-SYSTEM." | |
160 (coding-system-property coding-system 'eol-lf)) | |
161 | |
162 (defun coding-system-eol-crlf (coding-system) | |
163 "Return the 'eol-crlf property of CODING-SYSTEM." | |
164 (coding-system-property coding-system 'eol-crlf)) | |
165 | |
166 (defun coding-system-eol-cr (coding-system) | |
167 "Return the 'eol-cr property of CODING-SYSTEM." | |
168 (coding-system-property coding-system 'eol-cr)) | |
169 | |
170 (defun coding-system-post-read-conversion (coding-system) | |
171 "Return the 'post-read-conversion property of CODING-SYSTEM." | |
172 (coding-system-property coding-system 'post-read-conversion)) | |
173 | |
174 (defun coding-system-pre-write-conversion (coding-system) | |
175 "Return the 'pre-write-conversion property of CODING-SYSTEM." | |
176 (coding-system-property coding-system 'pre-write-conversion)) | |
177 | |
502 | 178 ;;; #### bleagh!!!!!!! |
179 | |
180 (defun coding-system-get (coding-system prop) | |
181 "Extract a value from CODING-SYSTEM's property list for property PROP." | |
182 (or (plist-get | |
183 (get (coding-system-name coding-system) 'coding-system-property) | |
184 prop) | |
185 (condition-case nil | |
186 (coding-system-property coding-system prop) | |
187 (error nil)))) | |
188 | |
189 (defun coding-system-put (coding-system prop value) | |
190 "Change value in CODING-SYSTEM's property list PROP to VALUE." | |
191 (put (coding-system-name coding-system) | |
192 'coding-system-property | |
193 (plist-put (get (coding-system-name coding-system) | |
194 'coding-system-property) | |
195 prop value))) | |
196 | |
197 (defun coding-system-category (coding-system) | |
198 "Return the coding category of CODING-SYSTEM." | |
199 (or (coding-system-get coding-system 'category) | |
771 | 200 (case (coding-system-type coding-system) |
201 (no-conversion 'no-conversion) | |
202 (shift-jis 'shift-jis) | |
3767 | 203 (unicode (case (coding-system-property coding-system 'unicode-type) |
985 | 204 (utf-8 (let ((bom (coding-system-property coding-system |
205 'need-bom))) | |
206 (cond (bom 'utf-8-bom) | |
207 ((not bom) 'utf-8)))) | |
771 | 208 (ucs-4 'ucs-4) |
209 (utf-16 (let ((bom (coding-system-property coding-system | |
210 'need-bom)) | |
211 (le (coding-system-property coding-system | |
212 'little-endian))) | |
213 (cond ((and bom le) 'utf-16-little-endian-bom) | |
214 ((and bom (not le) 'utf-16-bom)) | |
215 ((and (not bom) le) 'utf-16-little-endian) | |
216 ((and (not bom) (not le) 'utf-16))))))) | |
217 (big5 'big5) | |
218 (iso2022 (cond ((coding-system-lock-shift coding-system) | |
219 'iso-lock-shift) | |
220 ((coding-system-seven coding-system) | |
221 'iso-7) | |
222 (t | |
223 (let ((dim 0) | |
224 ccs | |
225 (i 0)) | |
226 (while (< i 4) | |
227 (setq ccs (declare-fboundp | |
228 (coding-system-iso2022-charset | |
229 coding-system i))) | |
230 (if (and ccs | |
231 (> (charset-dimension ccs) dim)) | |
232 (setq dim (charset-dimension ccs)) | |
233 ) | |
234 (setq i (1+ i))) | |
235 (cond ((= dim 1) 'iso-8-1) | |
236 ((= dim 2) 'iso-8-2) | |
237 (t 'iso-8-designate)))))) | |
238 ))) | |
502 | 239 |
428 | 240 |
440 | 241 ;;; Make certain variables equivalent to coding-system aliases |
242 (defun dontusethis-set-value-file-name-coding-system-handler (sym args fun harg handlers) | |
243 (define-coding-system-alias 'file-name (or (car args) 'binary))) | |
244 | |
245 (dontusethis-set-symbol-value-handler | |
246 'file-name-coding-system | |
247 'set-value | |
248 'dontusethis-set-value-file-name-coding-system-handler) | |
249 | |
250 (defun dontusethis-set-value-terminal-coding-system-handler (sym args fun harg handlers) | |
251 (define-coding-system-alias 'terminal (or (car args) 'binary))) | |
252 | |
253 (dontusethis-set-symbol-value-handler | |
254 'terminal-coding-system | |
255 'set-value | |
256 'dontusethis-set-value-terminal-coding-system-handler) | |
257 | |
258 (defun dontusethis-set-value-keyboard-coding-system-handler (sym args fun harg handlers) | |
259 (define-coding-system-alias 'keyboard (or (car args) 'binary))) | |
260 | |
261 (dontusethis-set-symbol-value-handler | |
262 'keyboard-coding-system | |
263 'set-value | |
264 'dontusethis-set-value-keyboard-coding-system-handler) | |
265 | |
266 (when (not (featurep 'mule)) | |
771 | 267 (define-coding-system-alias 'escape-quoted 'binary) |
440 | 268 ;; these are so that gnus and friends work when not mule |
4227 | 269 (define-coding-system-alias 'iso-8859-1 'raw-text) |
4222 | 270 ;; We're misrepresenting ourselves to the gnus code by saying we support |
271 ;; both. | |
4227 | 272 ; (define-coding-system-alias 'iso-8859-2 'raw-text) |
273 (define-coding-system-alias 'ctext 'raw-text)) | |
440 | 274 |
428 | 275 (make-compatible-variable 'enable-multibyte-characters "Unimplemented") |
276 | |
728 | 277 ;;; coding.el ends here |