(U-00024532): Use `->denotational' and `->subsumptive'.
[chise/xemacs-chise.git-] / src / console-msw.c
1 /* Console functions for mswindows.
2    Copyright (C) 1996, 2000 Ben Wing.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING.  If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA.  */
20
21 /* Synched up with: Not in FSF. */
22
23 /* Authorship:
24
25    Ben Wing: January 1996, for 19.14.
26    Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0
27  */
28
29 #include <config.h>
30 #include "lisp.h"
31
32 #include "buffer.h"
33 #include "console-msw.h"
34 #include "events.h"
35 #include "opaque.h"
36
37 DEFINE_CONSOLE_TYPE (mswindows);
38 DEFINE_CONSOLE_TYPE (msprinter);
39
40 Lisp_Object Qabortretryignore;
41 Lisp_Object Qapplmodal;
42 Lisp_Object Qdefault_desktop_only;
43 Lisp_Object Qdefbutton1;
44 Lisp_Object Qdefbutton2;
45 Lisp_Object Qdefbutton3;
46 Lisp_Object Qdefbutton4;
47 /* Lisp_Object Qhelp; */
48 Lisp_Object Qiconasterisk;
49 Lisp_Object Qiconexclamation;
50 Lisp_Object Qiconhand;
51 Lisp_Object Qiconinformation;
52 Lisp_Object Qiconquestion;
53 Lisp_Object Qiconstop;
54 /* Lisp_Object Qok; */
55 Lisp_Object Qokcancel;
56 Lisp_Object Qretrycancel;
57 /* Lisp_Object Qright; */
58 Lisp_Object Qrtlreading;
59 Lisp_Object Qservice_notification;
60 Lisp_Object Qsetforeground;
61 Lisp_Object Qsystemmodal;
62 Lisp_Object Qtaskmodal;
63 Lisp_Object Qtopmost;
64 Lisp_Object Qyesno;
65 Lisp_Object Qyesnocancel;
66
67 /* Lisp_Object Qabort; */
68 /* Lisp_Object Qcancel; */
69 /* Lisp_Object Qignore; */
70 /* Lisp_Object Qno; */
71 /* Lisp_Object Qok; */
72 /* Lisp_Object Qretry; */
73 /* Lisp_Object Qyes; */
74
75
76 /************************************************************************/
77 /*                       mswindows console methods                      */
78 /************************************************************************/
79
80 static int
81 mswindows_initially_selected_for_input (struct console *con)
82 {
83   return 1;
84 }
85
86 static HWND mswindows_console_hwnd = 0;
87
88 #define KLUDGE_BUFSIZE 1024 /* buffer size for console window titles */
89
90 /* Direct from the horse's mouth: Microsoft KB article Q124103 */
91 static HWND
92 GetConsoleHwnd (void)
93
94   HWND hwndFound;         /* this is what is returned to the caller */
95   char pszNewWindowTitle[KLUDGE_BUFSIZE]; /* contains fabricated WindowTitle */
96   char pszOldWindowTitle[KLUDGE_BUFSIZE]; /* contains original WindowTitle */
97
98   /* fetch current window title */
99
100   GetConsoleTitle(pszOldWindowTitle, KLUDGE_BUFSIZE);
101
102   /* format a "unique" NewWindowTitle */
103
104   wsprintf(pszNewWindowTitle,"%d/%d",
105            GetTickCount(),
106            GetCurrentProcessId());
107
108   /* change current window title */
109
110   SetConsoleTitle(pszNewWindowTitle);
111
112   /* ensure window title has been updated */
113
114   Sleep(40);
115
116   /* look for NewWindowTitle */
117
118   hwndFound=FindWindow(NULL, pszNewWindowTitle);
119
120   /* restore original window title */
121
122   SetConsoleTitle(pszOldWindowTitle);
123
124   return(hwndFound);
125
126
127 HWND
128 mswindows_get_console_hwnd (void)
129 {
130   if (!mswindows_console_hwnd)
131     mswindows_console_hwnd = GetConsoleHwnd ();
132   return mswindows_console_hwnd;
133 }
134
135 static int
136 mswindows_ensure_console_allocated (void)
137 {
138   HWND fgwin = GetForegroundWindow ();
139   /* stupid mswin api won't let you create the console window
140      hidden!  creating it changes the focus!  fuck me! */
141   if (AllocConsole ())
142     {
143       SetForegroundWindow (fgwin);
144       return 1;
145     }
146   return 0;
147 }
148
149 static Lisp_Object
150 mswindows_canonicalize_console_connection (Lisp_Object connection,
151                                            Error_behavior errb)
152 {
153   /* Do not allow more than one mswindows device, by explicitly
154      requiring that CONNECTION is nil, the only allowed connection in
155      Windows. */
156   if (!NILP (connection))
157     {
158       if (ERRB_EQ (errb, ERROR_ME))
159         signal_simple_error
160           ("Invalid (non-nil) connection for mswindows device/console",
161            connection);
162       else
163         return Qunbound;
164     }
165
166   return Qnil;
167 }
168
169 static Lisp_Object
170 mswindows_canonicalize_device_connection (Lisp_Object connection,
171                                           Error_behavior errb)
172 {
173   return mswindows_canonicalize_console_connection (connection, errb);
174 }
175
176 void
177 mswindows_hide_console (void)
178 {
179   ShowWindow (mswindows_get_console_hwnd (), SW_HIDE);
180 }
181
182 void
183 mswindows_show_console (void)
184 {
185   /* What I really want is for the console window to appear on top of other
186      windows, but NOT get the focus.  This seems hard-to-impossible under
187      Windows.  The following sequence seems to do the best possible, along
188      with keeping the console window on top when xemacs --help is used. */
189   HWND hwnd = mswindows_get_console_hwnd ();
190   HWND hwndf = GetFocus ();
191   ShowWindow (hwnd, SW_SHOW);
192   BringWindowToTop (hwnd);
193   SetFocus (hwndf);
194 }
195
196 static int mswindows_console_buffered = 0;
197 HANDLE mswindows_console_buffer;
198
199 static void
200 mswindows_ensure_console_buffered (void)
201 {
202   if (!mswindows_console_buffered)
203     {
204       COORD new_size;
205
206       new_size.X = 80;
207       new_size.Y = 1000;
208       mswindows_ensure_console_allocated ();
209       mswindows_console_buffer =
210         CreateConsoleScreenBuffer (GENERIC_WRITE, 0, NULL,
211                                    CONSOLE_TEXTMODE_BUFFER, NULL);
212       SetConsoleScreenBufferSize (mswindows_console_buffer, new_size);
213       SetConsoleActiveScreenBuffer (mswindows_console_buffer);
214       mswindows_console_buffered = 1;
215     }
216 }
217
218 int mswindows_message_outputted;
219
220 int
221 mswindows_output_console_string (CONST Extbyte *str, Extcount len)
222 {
223   DWORD num_written;
224
225   mswindows_message_outputted = 1;
226   mswindows_ensure_console_buffered ();
227   mswindows_show_console ();
228   return WriteConsole (mswindows_console_buffer, str, len, &num_written, NULL);
229 }
230
231 /* Determine if running on Windows 9x and not NT */
232 int
233 mswindows_windows9x_p (void)
234 {
235   return GetVersion () & 0x80000000;
236 }
237
238 DEFUN ("mswindows-debugging-output", Fmswindows_debugging_output, 1, 1, 0, /*
239 Write CHAR-OR-STRING to the Windows debugger, using OutputDebugString().
240 This function can be used as the STREAM argument of Fprint() or the like.
241 */
242        (char_or_string))
243 {
244   Extbyte *extstr;
245
246   if (STRINGP (char_or_string))
247     {
248       TO_EXTERNAL_FORMAT (LISP_STRING, char_or_string,
249                           C_STRING_ALLOCA, extstr,
250                           Qmswindows_tstr);
251       OutputDebugString (extstr);
252     }
253   else
254     {
255       Bufbyte str[MAX_EMCHAR_LEN + 1];
256       Bytecount len;
257
258       CHECK_CHAR_COERCE_INT (char_or_string);
259       len = set_charptr_emchar (str, XCHAR (char_or_string));
260       str[len] = '\0';
261       TO_EXTERNAL_FORMAT (C_STRING, str,
262                           C_STRING_ALLOCA, extstr,
263                           Qmswindows_tstr);
264       OutputDebugString (extstr);
265     }
266
267   return char_or_string;
268 }
269
270 #ifdef DEBUG_XEMACS
271
272 /*
273  * Random helper functions for debugging.
274  * Intended for use in the MSVC "Watch" window which doesn't like
275  * the ABORTs that the error_check_foo() functions can make.
276  */
277 struct lrecord_header *DHEADER (Lisp_Object obj);
278 struct lrecord_header *
279 DHEADER (Lisp_Object obj)
280 {
281   return LRECORDP (obj) ? XRECORD_LHEADER (obj) : NULL;
282 }
283
284 void *DOPAQUE_DATA (Lisp_Object obj);
285 void *
286 DOPAQUE_DATA (Lisp_Object obj)
287 {
288   return OPAQUEP (obj) ? OPAQUE_DATA (XOPAQUE (obj)) : NULL;
289 }
290
291 Lisp_Event *DEVENT (Lisp_Object obj);
292 Lisp_Event *
293 DEVENT (Lisp_Object obj)
294 {
295   return EVENTP (obj) ? XEVENT (obj) : NULL;
296 }
297
298 Lisp_Cons *DCONS (Lisp_Object obj);
299 Lisp_Cons *
300 DCONS (Lisp_Object obj)
301 {
302   return CONSP (obj) ? XCONS (obj) : NULL;
303 }
304
305 Lisp_Cons *DCONSCDR (Lisp_Object obj);
306 Lisp_Cons *
307 DCONSCDR (Lisp_Object obj)
308 {
309   return (CONSP (obj) && CONSP (XCDR (obj))) ? XCONS (XCDR (obj)) : 0;
310 }
311
312 Bufbyte *DSTRING (Lisp_Object obj);
313 Bufbyte *
314 DSTRING (Lisp_Object obj)
315 {
316   return STRINGP (obj) ? XSTRING_DATA (obj) : NULL;
317 }
318
319 Lisp_Vector *DVECTOR (Lisp_Object obj);
320 Lisp_Vector *
321 DVECTOR (Lisp_Object obj)
322 {
323   return VECTORP (obj) ? XVECTOR (obj) : NULL;
324 }
325
326 Lisp_Symbol *DSYMBOL (Lisp_Object obj);
327 Lisp_Symbol *
328 DSYMBOL (Lisp_Object obj)
329 {
330   return SYMBOLP (obj) ? XSYMBOL (obj) : NULL;
331 }
332
333 Bufbyte *DSYMNAME (Lisp_Object obj);
334 Bufbyte *
335 DSYMNAME (Lisp_Object obj)
336 {
337   return SYMBOLP (obj) ? string_data (XSYMBOL (obj)->name) : NULL;
338 }
339
340 #endif /* DEBUG_XEMACS */
341
342 DEFUN ("mswindows-message-box", Fmswindows_message_box, 1, 3, 0, /*
343 Pop up an MS Windows message box.
344 MESSAGE is the string to display.  Optional argument FLAG controls
345 what appears in the box and how it behaves; it is a symbol or list of
346 symbols, described below.  Second optional argument TITLE controls the
347 title bar; if omitted, a standard title bar will be used, probably
348 displaying "XEmacs".
349
350 Possible flags are
351
352
353 -- To specify the buttons in the message box:
354
355 abortretryignore 
356   The message box contains three push buttons: Abort, Retry, and Ignore. 
357 ok 
358   The message box contains one push button: OK. This is the default. 
359 okcancel 
360   The message box contains two push buttons: OK and Cancel. 
361 retrycancel 
362   The message box contains two push buttons: Retry and Cancel. 
363 yesno 
364   The message box contains two push buttons: Yes and No. 
365 yesnocancel 
366   The message box contains three push buttons: Yes, No, and Cancel. 
367
368
369 -- To display an icon in the message box:
370  
371 iconexclamation, iconwarning
372   An exclamation-point icon appears in the message box. 
373 iconinformation, iconasterisk
374   An icon consisting of a lowercase letter i in a circle appears in
375   the message box. 
376 iconquestion
377   A question-mark icon appears in the message box. 
378 iconstop, iconerror, iconhand
379   A stop-sign icon appears in the message box. 
380
381
382 -- To indicate the default button: 
383
384 defbutton1
385   The first button is the default button.  This is the default.
386 defbutton2
387   The second button is the default button. 
388 defbutton3
389   The third button is the default button. 
390 defbutton4
391   The fourth button is the default button. 
392
393
394 -- To indicate the modality of the dialog box:
395  
396 applmodal
397   The user must respond to the message box before continuing work in
398   the window identified by the hWnd parameter. However, the user can
399   move to the windows of other applications and work in those windows.
400   Depending on the hierarchy of windows in the application, the user
401   may be able to move to other windows within the application. All
402   child windows of the parent of the message box are automatically
403   disabled, but popup windows are not.  This is the default.
404 systemmodal
405   Same as applmodal except that the message box has the WS_EX_TOPMOST
406   style. Use system-modal message boxes to notify the user of serious,
407   potentially damaging errors that require immediate attention (for
408   example, running out of memory). This flag has no effect on the
409   user's ability to interact with windows other than those associated
410   with hWnd.
411 taskmodal
412   Same as applmodal except that all the top-level windows belonging to
413   the current task are disabled if the hWnd parameter is NULL. Use
414   this flag when the calling application or library does not have a
415   window handle available but still needs to prevent input to other
416   windows in the current application without suspending other
417   applications.
418
419
420 In addition, you can specify the following flags: 
421
422 default-desktop-only 
423   The desktop currently receiving input must be a default desktop;
424   otherwise, the function fails. A default desktop is one an
425   application runs on after the user has logged on.
426 help 
427   Adds a Help button to the message box. Choosing the Help button or
428   pressing F1 generates a Help event.
429 right 
430   The text is right-justified. 
431 rtlreading 
432   Displays message and caption text using right-to-left reading order
433   on Hebrew and Arabic systems.
434 setforeground 
435   The message box becomes the foreground window. Internally, Windows
436   calls the SetForegroundWindow function for the message box.
437 topmost 
438   The message box is created with the WS_EX_TOPMOST window style. 
439 service-notification 
440   Windows NT only: The caller is a service notifying the user of an
441   event. The function displays a message box on the current active
442   desktop, even if there is no user logged on to the computer.  If
443   this flag is set, the hWnd parameter must be NULL. This is so the
444   message box can appear on a desktop other than the desktop
445   corresponding to the hWnd.
446
447
448
449 The return value is one of the following menu-item values returned by
450 the dialog box:
451  
452 abort
453   Abort button was selected. 
454 cancel
455   Cancel button was selected. 
456 ignore
457   Ignore button was selected. 
458 no
459   No button was selected. 
460 ok
461   OK button was selected. 
462 retry
463   Retry button was selected. 
464 yes
465   Yes button was selected. 
466
467 If a message box has a Cancel button, the function returns the
468 `cancel' value if either the ESC key is pressed or the Cancel button
469 is selected.  If the message box has no Cancel button, pressing ESC has
470 no effect.  */
471        (message_, flags, title))
472 {
473   Lisp_Object tail;
474   Extbyte *msgout;
475   Extbyte *titleout = 0;
476   UINT sty = 0;
477
478   if (!LISTP (flags))
479     {
480       CHECK_SYMBOL (flags);
481       flags = list1 (flags);
482     }
483
484   CHECK_STRING (message_);
485   TO_EXTERNAL_FORMAT (LISP_STRING, message_,
486                       C_STRING_ALLOCA, msgout,
487                       Qmswindows_tstr);
488   
489   if (!NILP (title))
490     {
491       CHECK_STRING (title);
492       TO_EXTERNAL_FORMAT (LISP_STRING, title,
493                           C_STRING_ALLOCA, titleout,
494                           Qmswindows_tstr);
495     }
496
497   EXTERNAL_LIST_LOOP (tail, flags)
498     {
499       Lisp_Object st = XCAR (tail);
500       CHECK_SYMBOL (st);
501       if (0)
502         ;
503 #define FROB(sym, val) else if (EQ (st, sym)) sty |= val
504       FROB (Qabortretryignore, MB_ABORTRETRYIGNORE);
505       FROB (Qapplmodal, MB_APPLMODAL);
506       FROB (Qdefault_desktop_only, MB_DEFAULT_DESKTOP_ONLY);
507       FROB (Qdefbutton1, MB_DEFBUTTON1);
508       FROB (Qdefbutton2, MB_DEFBUTTON2);
509       FROB (Qdefbutton3, MB_DEFBUTTON3);
510       FROB (Qdefbutton4, MB_DEFBUTTON4);
511       FROB (Qhelp, MB_HELP);
512       FROB (Qiconasterisk, MB_ICONASTERISK);
513       FROB (Qiconexclamation, MB_ICONEXCLAMATION);
514       FROB (Qiconhand, MB_ICONHAND);
515       FROB (Qiconinformation, MB_ICONINFORMATION);
516       FROB (Qiconquestion, MB_ICONQUESTION);
517       FROB (Qiconstop, MB_ICONSTOP);
518       FROB (Qok, MB_OK);
519       FROB (Qokcancel, MB_OKCANCEL);
520       FROB (Qretrycancel, MB_RETRYCANCEL);
521       FROB (Qright, MB_RIGHT);
522       FROB (Qrtlreading, MB_RTLREADING);
523       FROB (Qservice_notification, MB_SERVICE_NOTIFICATION);
524       FROB (Qsetforeground, MB_SETFOREGROUND);
525       FROB (Qsystemmodal, MB_SYSTEMMODAL);
526       FROB (Qtaskmodal, MB_TASKMODAL);
527       FROB (Qtopmost, MB_TOPMOST);
528       FROB (Qyesno, MB_YESNO);
529       FROB (Qyesnocancel, MB_YESNOCANCEL);
530 #undef FROB
531
532       else
533         signal_simple_error ("Unrecognized flag", st);
534     }
535
536   {
537     int retval = MessageBox (NULL, msgout, titleout, sty);
538
539     if (retval == 0)
540       error ("Out of memory when calling `mswindows-message-box'");
541
542 #define FROB(sym, val) if (retval == val) return sym
543     FROB (Qabort, IDABORT);
544     FROB (Qcancel, IDCANCEL);
545     FROB (Qignore, IDIGNORE);
546     FROB (Qno, IDNO);
547     FROB (Qok, IDOK);
548     FROB (Qretry, IDRETRY);
549     FROB (Qyes, IDYES);
550 #undef FROB
551     
552     signal_simple_error ("Unknown return value from MessageBox()",
553                          make_int (retval));
554   }
555
556   return Qnil;
557 }
558
559 void
560 mswindows_output_last_error (char *frob)
561 {
562   LPVOID lpMsgBuf;
563   int errval = GetLastError();
564   
565   FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER
566                  | FORMAT_MESSAGE_FROM_SYSTEM,
567                  NULL, errval,
568                  MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
569                  (LPTSTR) &lpMsgBuf,
570                  0,
571                  NULL);
572   stderr_out ("last error during %s is %d: %s\n",
573               frob, errval, (char*)lpMsgBuf);
574 }
575
576 static Lisp_Object
577 msprinter_canonicalize_console_connection (Lisp_Object connection,
578                                            Error_behavior errb)
579 {
580   /* If nil connection is specified, transform it into the name
581      of the default printer */
582   if (NILP (connection))
583     {
584       connection = msprinter_default_printer ();
585       if (NILP (connection))
586         {
587           if (ERRB_EQ (errb, ERROR_ME))
588             error ("There is no default printer in the system");
589           else
590             return Qunbound;
591         }
592     }
593
594   CHECK_STRING (connection);
595   return connection;
596 }
597
598 static Lisp_Object
599 msprinter_canonicalize_device_connection (Lisp_Object connection,
600                                           Error_behavior errb)
601 {
602   return msprinter_canonicalize_console_connection (connection, errb);
603 }
604
605 \f
606 /************************************************************************/
607 /*                            initialization                            */
608 /************************************************************************/
609
610 void
611 syms_of_console_mswindows (void)
612 {
613   DEFSUBR (Fmswindows_debugging_output);
614
615   defsymbol (&Qabortretryignore, "abortretryignore");
616   defsymbol (&Qapplmodal, "applmodal");
617   defsymbol (&Qdefault_desktop_only, "default-desktop-only");
618   defsymbol (&Qdefbutton1, "defbutton1");
619   defsymbol (&Qdefbutton2, "defbutton2");
620   defsymbol (&Qdefbutton3, "defbutton3");
621   defsymbol (&Qdefbutton4, "defbutton4");
622   /* defsymbol (&Qhelp, "help"); */
623   defsymbol (&Qiconasterisk, "iconasterisk");
624   defsymbol (&Qiconexclamation, "iconexclamation");
625   defsymbol (&Qiconhand, "iconhand");
626   defsymbol (&Qiconinformation, "iconinformation");
627   defsymbol (&Qiconquestion, "iconquestion");
628   defsymbol (&Qiconstop, "iconstop");
629   /* defsymbol (&Qok, "ok"); */
630   defsymbol (&Qokcancel, "okcancel");
631   defsymbol (&Qretrycancel, "retrycancel");
632   /* defsymbol (&Qright, "right"); */
633   defsymbol (&Qrtlreading, "rtlreading");
634   defsymbol (&Qservice_notification, "service-notification");
635   defsymbol (&Qsetforeground, "setforeground");
636   defsymbol (&Qsystemmodal, "systemmodal");
637   defsymbol (&Qtaskmodal, "taskmodal");
638   defsymbol (&Qtopmost, "topmost");
639   defsymbol (&Qyesno, "yesno");
640   defsymbol (&Qyesnocancel, "yesnocancel");
641
642   /* defsymbol (&Qabort, "abort"); */
643   /* defsymbol (&Qcancel, "cancel"); */
644   /* defsymbol (&Qignore, "ignore"); */
645   /* defsymbol (&Qno, "no"); */
646   /* defsymbol (&Qok, "ok"); */
647   /* defsymbol (&Qretry, "retry"); */
648   /* defsymbol (&Qyes, "yes"); */
649
650   DEFSUBR (Fmswindows_message_box);
651 }
652
653 void
654 console_type_create_mswindows (void)
655 {
656   INITIALIZE_CONSOLE_TYPE (mswindows, "mswindows", "console-mswindows-p");
657
658   /* console methods */
659 /*  CONSOLE_HAS_METHOD (mswindows, init_console); */
660 /*  CONSOLE_HAS_METHOD (mswindows, mark_console); */
661   CONSOLE_HAS_METHOD (mswindows, initially_selected_for_input);
662 /*  CONSOLE_HAS_METHOD (mswindows, delete_console); */
663   CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection);
664   CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection);
665 /*  CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */
666 /*  CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */
667
668   INITIALIZE_CONSOLE_TYPE (msprinter, "msprinter", "console-msprinter-p");
669   CONSOLE_HAS_METHOD (msprinter, canonicalize_console_connection);
670   CONSOLE_HAS_METHOD (msprinter, canonicalize_device_connection);
671 }
672
673 void
674 reinit_console_type_create_mswindows (void)
675 {
676   REINITIALIZE_CONSOLE_TYPE (mswindows);
677   REINITIALIZE_CONSOLE_TYPE (msprinter);
678 }
679
680 void
681 vars_of_console_mswindows (void)
682 {
683   Fprovide (Qmswindows);
684 }