Mercurial > emacs
annotate src/dosfns.c @ 11204:de3d87b4c418
Declare Ffetch_bytecode.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 05 Apr 1995 03:04:48 +0000 |
parents | 8a1bd0598b49 |
children | 93cc41315528 |
rev | line source |
---|---|
5503 | 1 /* MS-DOS specific Lisp utilities. Coded by Manabu Higashida, 1991. |
2 Major changes May-July 1993 Morten Welinder (only 10% original code left) | |
3 Copyright (C) 1991, 1993 Free Software Foundation, Inc. | |
4 | |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
10504 | 9 the Free Software Foundation; either version 2, or (at your option) |
5503 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with GNU Emacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
20 | |
21 | |
5980 | 22 #include <config.h> |
5503 | 23 |
24 #ifdef MSDOS | |
25 /* The entire file is within this conditional */ | |
26 | |
27 #include <stdio.h> | |
28 #include <dos.h> | |
29 #include "lisp.h" | |
30 #include "buffer.h" | |
31 #include "termchar.h" | |
32 #include "termhooks.h" | |
33 #include "frame.h" | |
34 #include "dosfns.h" | |
35 #include "msdos.h" | |
36 | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
37 DEFUN ("mode25", Fmode25, Smode25, 0, 0, "", "\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
38 Changes the number of rows to 25.") |
5503 | 39 () |
40 { | |
41 union REGS regs; | |
42 | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
43 #ifdef HAVE_X_WINDOWS |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
44 if (!inhibit_window_system) |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
45 return Qnil; |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
46 #endif |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
47 if (have_mouse) mouse_off (); |
5503 | 48 regs.x.ax = 3; |
49 int86 (0x10, ®s, ®s); | |
50 regs.x.ax = 0x1101; | |
51 regs.h.bl = 0; | |
52 int86 (0x10, ®s, ®s); | |
53 regs.x.ax = 0x1200; | |
54 regs.h.bl = 32; | |
55 int86 (0x10, ®s, ®s); | |
56 regs.x.ax = 3; | |
57 int86 (0x10, ®s, ®s); | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
58 Fset_frame_size (Fselected_frame (), ScreenCols (), ScreenRows ()); |
5503 | 59 Frecenter (Qnil); |
60 Fredraw_display (); | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
61 if (have_mouse) mouse_init (); |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
62 return Qnil; |
5503 | 63 } |
64 | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
65 DEFUN ("mode4350", Fmode4350, Smode4350, 0, 0, "", "\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
66 Changes the number of rows to 43 (EGA) or 50 (VGA).") |
5503 | 67 () |
68 { | |
69 union REGS regs; | |
70 | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
71 #ifdef HAVE_X_WINDOWS |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
72 if (!inhibit_window_system) |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
73 return Qnil; |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
74 #endif |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
75 if (have_mouse) mouse_off (); |
5503 | 76 regs.x.ax = 3; |
77 int86 (0x10, ®s, ®s); | |
78 regs.x.ax = 0x1112; | |
79 regs.h.bl = 0; | |
80 int86 (0x10, ®s, ®s); | |
81 regs.x.ax = 0x1200; | |
82 regs.h.bl = 32; | |
83 int86 (0x10, ®s, ®s); | |
84 regs.x.ax = 0x0100; | |
85 regs.x.cx = 7; | |
86 int86 (0x10, ®s, ®s); | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
87 Fset_frame_size (Fselected_frame (), ScreenCols (), ScreenRows ()); |
5503 | 88 Frecenter (Qnil); |
89 Fredraw_display (); | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
90 if (have_mouse) mouse_init (); |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
91 return Qnil; |
5503 | 92 } |
93 | |
94 DEFUN ("int86", Fint86, Sint86, 2, 2, 0, | |
95 "Call specific MSDOS interrupt number INTERRUPT with REGISTERS.\n\ | |
96 Return the updated REGISTER vector.\n\ | |
97 \n\ | |
98 INTERRUPT should be an integer in the range 0 to 255.\n\ | |
99 REGISTERS should be a vector produced by `make-register' and\n\ | |
100 `set-register-value'.") | |
101 (intno, regs) | |
102 Lisp_Object intno, regs; | |
103 { | |
104 register int i; | |
105 int no; | |
106 union REGS inregs, outregs; | |
107 Lisp_Object val; | |
108 | |
109 CHECK_NUMBER (intno, 0); | |
110 no = (unsigned long) XINT (intno); | |
111 CHECK_VECTOR (regs, 1); | |
112 if (no < 0 || no > 0xff || XVECTOR (regs)-> size != 8) | |
113 return Qnil; | |
114 for (i = 0; i < 8; i++) | |
115 CHECK_NUMBER (XVECTOR (regs)->contents[i], 1); | |
116 | |
117 inregs.x.ax = (unsigned long) XFASTINT (XVECTOR (regs)->contents[0]); | |
118 inregs.x.bx = (unsigned long) XFASTINT (XVECTOR (regs)->contents[1]); | |
119 inregs.x.cx = (unsigned long) XFASTINT (XVECTOR (regs)->contents[2]); | |
120 inregs.x.dx = (unsigned long) XFASTINT (XVECTOR (regs)->contents[3]); | |
121 inregs.x.si = (unsigned long) XFASTINT (XVECTOR (regs)->contents[4]); | |
122 inregs.x.di = (unsigned long) XFASTINT (XVECTOR (regs)->contents[5]); | |
123 inregs.x.cflag = (unsigned long) XFASTINT (XVECTOR (regs)->contents[6]); | |
124 inregs.x.flags = (unsigned long) XFASTINT (XVECTOR (regs)->contents[7]); | |
125 | |
126 int86 (no, &inregs, &outregs); | |
127 | |
128 XVECTOR (regs)->contents[0] = make_number (outregs.x.ax); | |
129 XVECTOR (regs)->contents[1] = make_number (outregs.x.bx); | |
130 XVECTOR (regs)->contents[2] = make_number (outregs.x.cx); | |
131 XVECTOR (regs)->contents[3] = make_number (outregs.x.dx); | |
132 XVECTOR (regs)->contents[4] = make_number (outregs.x.si); | |
133 XVECTOR (regs)->contents[5] = make_number (outregs.x.di); | |
134 XVECTOR (regs)->contents[6] = make_number (outregs.x.cflag); | |
135 XVECTOR (regs)->contents[7] = make_number (outregs.x.flags); | |
136 | |
137 return regs; | |
138 } | |
139 | |
9572 | 140 #ifndef HAVE_X_WINDOWS |
141 /* Later we might want to control the mouse interface with this function, | |
142 e.g., with respect to non-80 column screen modes. */ | |
143 | |
144 DEFUN ("msdos-mouse-p", Fmsdos_mouse_p, Smsdos_mouse_p, 0, 0, 0, "\ | |
145 Report whether a mouse is present.") | |
146 () | |
147 { | |
148 if (have_mouse) | |
149 return Qt; | |
150 else | |
151 return Qnil; | |
152 } | |
153 | |
154 DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0, | |
155 "Move the mouse pointer to the center of character cell (X,Y) in FRAME.\n\ | |
156 WARNING: If you use this under X windows,\n\ | |
157 you should call `unfocus-frame' afterwards.") | |
158 (frame, x, y) | |
159 Lisp_Object frame, x, y; | |
160 { | |
161 mouse_moveto (XINT (x), XINT (y)); | |
162 } | |
163 | |
164 /* Function to translate colour names to integers. See lisp/term/pc-win.el | |
165 for its definition. */ | |
166 | |
167 Lisp_Object Qmsdos_color_translate; | |
168 #endif | |
169 | |
170 | |
5503 | 171 int dos_country_code; |
172 int dos_codepage; | |
173 Lisp_Object Vdos_version; | |
174 | |
175 void | |
176 init_dosfns () | |
177 { | |
178 union REGS regs; | |
179 _go32_dpmi_seginfo info; | |
180 _go32_dpmi_registers dpmiregs; | |
181 | |
9572 | 182 #ifndef SYSTEM_MALLOC |
5503 | 183 get_lim_data (); /* why the hell isn't this called elsewhere? */ |
9572 | 184 #endif |
5503 | 185 |
186 regs.x.ax = 0x3000; | |
187 intdos (®s, ®s); | |
188 Vdos_version = Fcons (make_number (regs.h.al), make_number (regs.h.ah)); | |
189 | |
190 /* Obtain the country code by calling Dos via Dpmi. Don't rely on GO32. */ | |
191 info.size = (34 + 15) / 16; | |
192 if (_go32_dpmi_allocate_dos_memory (&info)) | |
193 dos_country_code = 1; | |
194 else | |
195 { | |
196 dpmiregs.x.ax = 0x3800; | |
197 dpmiregs.x.ds = info.rm_segment; | |
198 dpmiregs.x.dx = 0; | |
199 dpmiregs.x.ss = dpmiregs.x.sp = 0; | |
200 _go32_dpmi_simulate_int (0x21, &dpmiregs); | |
201 dos_country_code = dpmiregs.x.bx; | |
202 _go32_dpmi_free_dos_memory (&info); | |
203 } | |
204 | |
205 regs.x.ax = 0x6601; | |
206 intdos (®s, ®s); | |
207 if (regs.x.cflag) | |
208 /* Estimate code page from country code */ | |
209 switch (dos_country_code) | |
210 { | |
211 case 45: /* Denmark */ | |
212 case 47: /* Norway */ | |
213 dos_codepage = 865; | |
214 break; | |
215 default: | |
216 /* US */ | |
217 dos_codepage = 437; | |
218 } | |
219 else | |
220 dos_codepage = regs.x.bx & 0xffff; | |
221 } | |
222 | |
223 /* | |
224 * Define everything | |
225 */ | |
226 syms_of_dosfns () | |
227 { | |
228 defsubr (&Smode25); | |
229 defsubr (&Smode4350); | |
230 defsubr (&Sint86); | |
9572 | 231 #ifndef HAVE_X_WINDOWS |
232 defsubr (&Smsdos_mouse_p); | |
233 defsubr (&Sset_mouse_position); | |
234 | |
235 Qmsdos_color_translate = intern ("msdos-color-translate"); | |
236 staticpro (&Qmsdos_color_translate); | |
237 #endif | |
5503 | 238 |
239 DEFVAR_INT ("dos-country-code", &dos_country_code, | |
240 "The country code returned by Dos when Emacs was started.\n\ | |
241 Usually this is the international telephone prefix."); | |
242 | |
243 DEFVAR_INT ("dos-codepage", &dos_codepage, | |
244 "The codepage active when Emacs was started.\n\ | |
7272
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
245 The following are known:\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
246 437 United States\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
247 850 Multilingual (Latin I)\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
248 852 Slavic (Latin II)\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
249 857 Turkish\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
250 860 Portugal\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
251 861 Iceland\n\ |
b5f74966c9da
Finish downcasing mouse_init1, mouse_off,
Richard M. Stallman <rms@gnu.org>
parents:
5980
diff
changeset
|
252 863 Canada (French)\n\ |
5503 | 253 865 Norway/Denmark"); |
254 | |
255 DEFVAR_LISP ("dos-version", &Vdos_version, | |
256 "The (MAJOR . MINOR) Dos version (subject to modification with setver)."); | |
257 } | |
258 #endif /* MSDOS */ |