(linenum→info "unix/slp.c:2238")

emacs/22.1/src/dosfns.c

    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, 1996, 1997, 1998, 2001, 2002, 2003, 2004,
    4:                  2005, 2006, 2007 Free Software Foundation, Inc.
    5: 
    6: This file is part of GNU Emacs.
    7: 
    8: GNU Emacs is free software; you can redistribute it and/or modify
    9: it under the terms of the GNU General Public License as published by
   10: the Free Software Foundation; either version 2, or (at your option)
   11: any later version.
   12: 
   13: GNU Emacs is distributed in the hope that it will be useful,
   14: but WITHOUT ANY WARRANTY; without even the implied warranty of
   15: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16: GNU General Public License for more details.
   17: 
   18: You should have received a copy of the GNU General Public License
   19: along with GNU Emacs; see the file COPYING.  If not, write to
   20: the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   21: Boston, MA 02110-1301, USA.  */
   22: 
   23: #include <config.h>
   24: 
   25: #ifdef MSDOS
   26: /* The entire file is within this conditional */
   27: 
   28: #include <stdio.h>
   29: #include <string.h>
   30: #include <dos.h>
   31: #include "lisp.h"
   32: #include "buffer.h"
   33: #include "termchar.h"
   34: #include "termhooks.h"
   35: #include "frame.h"
   36: #include "blockinput.h"
   37: #include "window.h"
   38: #include "dosfns.h"
   39: #include "msdos.h"
   40: #include "dispextern.h"
   41: #include "charset.h"
   42: #include "coding.h"
   43: #include <dpmi.h>
   44: #include <go32.h>
   45: #include <dirent.h>
   46: #include <sys/vfs.h>
   47: 
   48: #ifndef __DJGPP_MINOR__
   49: # define __tb _go32_info_block.linear_address_of_transfer_buffer;
   50: #endif
   51: 
   52: DEFUN ("int86", Fint86, Sint86, 2, 2, 0,
   53:        doc: /* Call specific MSDOS interrupt number INTERRUPT with REGISTERS.
   54: Return the updated REGISTER vector.
   55: 
   56: INTERRUPT should be an integer in the range 0 to 255.
   57: REGISTERS should be a vector produced by `make-register' and
   58: `set-register-value'.  */)
   59:      (interrupt, registers)
   60:      Lisp_Object interrupt, registers;
   61: {
   62:   register int i;
   63:   int no;
   64:   union REGS inregs, outregs;
   65:   Lisp_Object val;
   66: 
   67:   CHECK_NUMBER (interrupt);
   68:   no = (unsigned long) XINT (interrupt);
   69:   CHECK_VECTOR (registers);
   70:   if (no < 0 || no > 0xff || XVECTOR (registers)-> size != 8)
   71:     return Qnil;
   72:   for (i = 0; i < 8; i++)
   73:     CHECK_NUMBER (XVECTOR (registers)->contents[i]);
   74: 
   75:   inregs.x.ax    = (unsigned long) XFASTINT (XVECTOR (registers)->contents[0]);
   76:   inregs.x.bx    = (unsigned long) XFASTINT (XVECTOR (registers)->contents[1]);
   77:   inregs.x.cx    = (unsigned long) XFASTINT (XVECTOR (registers)->contents[2]);
   78:   inregs.x.dx    = (unsigned long) XFASTINT (XVECTOR (registers)->contents[3]);
   79:   inregs.x.si    = (unsigned long) XFASTINT (XVECTOR (registers)->contents[4]);
   80:   inregs.x.di    = (unsigned long) XFASTINT (XVECTOR (registers)->contents[5]);
   81:   inregs.x.cflag = (unsigned long) XFASTINT (XVECTOR (registers)->contents[6]);
   82:   inregs.x.flags = (unsigned long) XFASTINT (XVECTOR (registers)->contents[7]);
   83: 
   84:   int86 (no, &inregs, &outregs);
   85: 
   86:   XVECTOR (registers)->contents[0] = make_number (outregs.x.ax);
   87:   XVECTOR (registers)->contents[1] = make_number (outregs.x.bx);
   88:   XVECTOR (registers)->contents[2] = make_number (outregs.x.cx);
   89:   XVECTOR (registers)->contents[3] = make_number (outregs.x.dx);
   90:   XVECTOR (registers)->contents[4] = make_number (outregs.x.si);
   91:   XVECTOR (registers)->contents[5] = make_number (outregs.x.di);
   92:   XVECTOR (registers)->contents[6] = make_number (outregs.x.cflag);
   93:   XVECTOR (registers)->contents[7] = make_number (outregs.x.flags);
   94: 
   95:   return registers;
   96: }
   97: 
   98: DEFUN ("msdos-memget", Fdos_memget, Sdos_memget, 2, 2, 0,
   99:        doc: /* Read DOS memory at offset ADDRESS into VECTOR.
  100: Return the updated VECTOR.  */)
  101:      (address, vector)
  102:      Lisp_Object address, vector;
  103: {
  104:   register int i;
  105:   int offs, len;
  106:   char *buf;
  107:   Lisp_Object val;
  108: 
  109:   CHECK_NUMBER (address);
  110:   offs = (unsigned long) XINT (address);
  111:   CHECK_VECTOR (vector);
  112:   len = XVECTOR (vector)-> size;
  113:   if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len)
  114:     return Qnil;
  115:   buf = alloca (len);
  116:   dosmemget (offs, len, buf);
  117: 
  118:   for (i = 0; i < len; i++)
  119:     XVECTOR (vector)->contents[i] = make_number (buf[i]);
  120: 
  121:   return vector;
  122: }
  123: 
  124: DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0,
  125:        doc: /* Write DOS memory at offset ADDRESS from VECTOR.  */)
  126:      (address, vector)
  127:      Lisp_Object address, vector;
  128: {
  129:   register int i;
  130:   int offs, len;
  131:   char *buf;
  132:   Lisp_Object val;
  133: 
  134:   CHECK_NUMBER (address);
  135:   offs = (unsigned long) XINT (address);
  136:   CHECK_VECTOR (vector);
  137:   len = XVECTOR (vector)-> size;
  138:   if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len)
  139:     return Qnil;
  140:   buf = alloca (len);
  141: 
  142:   for (i = 0; i < len; i++)
  143:     {
  144:       CHECK_NUMBER (XVECTOR (vector)->contents[i]);
  145:       buf[i] = (unsigned char) XFASTINT (XVECTOR (vector)->contents[i]) & 0xFF;
  146:     }
  147: 
  148:   dosmemput (buf, len, offs);
  149:   return Qt;
  150: }
  151: 
  152: DEFUN ("msdos-set-keyboard", Fmsdos_set_keyboard, Smsdos_set_keyboard, 1, 2, 0,
  153:        doc: /* Set keyboard layout according to COUNTRY-CODE.
  154: If the optional argument ALLKEYS is non-nil, the keyboard is mapped for
  155: all keys; otherwise it is only used when the ALT key is pressed.
  156: The current keyboard layout is available in dos-keyboard-code.  */)
  157:      (country_code, allkeys)
  158:      Lisp_Object country_code, allkeys;
  159: {
  160:   CHECK_NUMBER (country_code);
  161:   if (!dos_set_keyboard (XINT (country_code), !NILP (allkeys)))
  162:     return Qnil;
  163:   return Qt;
  164: }
  165: 
  166: #ifndef HAVE_X_WINDOWS
  167: /* Later we might want to control the mouse interface with this function,
  168:    e.g., with respect to non-80 column screen modes.  */
  169: 
  170: DEFUN ("msdos-mouse-p", Fmsdos_mouse_p, Smsdos_mouse_p, 0, 0, 0,
  171:        doc: /* Report whether a mouse is present.  */)
  172:      ()
  173: {
  174:   if (have_mouse)
  175:     return Qt;
  176:   else
  177:     return Qnil;
  178: }
  179: #endif
  180: 
  181: DEFUN ("msdos-mouse-init", Fmsdos_mouse_init, Smsdos_mouse_init, 0, 0, "",
  182:        doc: /* Initialize and enable mouse if available.  */)
  183:      ()
  184: {
  185:   if (have_mouse)
  186:     {
  187:       have_mouse = 1;
  188:       mouse_init ();
  189:       return Qt;
  190:     }
  191:   return Qnil;
  192: }
  193: 
  194: DEFUN ("msdos-mouse-enable", Fmsdos_mouse_enable, Smsdos_mouse_enable, 0, 0, "",
  195:        doc: /* Enable mouse if available.  */)
  196:      ()
  197: {
  198:   if (have_mouse)
  199:     {
  200:       have_mouse = 1;
  201:       mouse_on ();
  202:     }
  203:   return have_mouse ? Qt : Qnil;
  204: }
  205: 
  206: DEFUN ("msdos-mouse-disable", Fmsdos_mouse_disable, Smsdos_mouse_disable, 0, 0, "",
  207:        doc: /* Disable mouse if available.  */)
  208:      ()
  209: {
  210:   mouse_off ();
  211:   if (have_mouse) have_mouse = -1;
  212:   return Qnil;
  213: }
  214: 
  215: DEFUN ("insert-startup-screen", Finsert_startup_screen, Sinsert_startup_screen, 0, 0, "",
  216:        doc: /* Insert copy of screen contents prior to starting Emacs.
  217: Return nil if startup screen is not available.  */)
  218:      ()
  219: {
  220:   char *s;
  221:   int rows, cols, i, j;
  222: 
  223:   if (!dos_get_saved_screen (&s, &rows, &cols))
  224:     return Qnil;
  225: 
  226:   for (i = 0; i < rows; i++)
  227:     {
  228:       for (j = 0; j < cols; j++)
  229:         {
  230:           insert_char (*s);
  231:           s += 2;
  232:         }
  233:       insert_char ('\n');
  234:     }
  235: 
  236:   return Qt;
  237: }
  238: ^L
  239: /* country info */
  240: EMACS_INT dos_country_code;
  241: EMACS_INT dos_codepage;
  242: EMACS_INT dos_timezone_offset;
  243: EMACS_INT dos_decimal_point;
  244: EMACS_INT dos_keyboard_layout;
  245: unsigned char dos_country_info[DOS_COUNTRY_INFO];
  246: static unsigned char usa_country_info[DOS_COUNTRY_INFO] = {
  247:   0, 0,                         /* date format */
  248:   '$', 0, 0, 0, 0,              /* currency string */
  249:   ',', 0,                       /* thousands separator */
  250:   '.', 0,                       /* decimal separator */
  251:   '/', 0,                       /* date separator */
  252:   ':', 0,                       /* time separator */
  253:   0,                            /* currency format */
  254:   2,                            /* digits after decimal in currency */
  255:   0,                            /* time format */
  256:   0, 0, 0, 0,                   /* address of case map routine, GPF if used */
  257:   ' ', 0,                       /* data-list separator (?) */
  258:   0, 0, 0, 0, 0, 0, 0, 0, 0, 0  /* reserved */
  259: };
  260: 
  261: EMACS_INT dos_hyper_key;
  262: EMACS_INT dos_super_key;
  263: EMACS_INT dos_keypad_mode;
  264: 
  265: Lisp_Object Vdos_version;
  266: Lisp_Object Vdos_display_scancodes;
  267: 
  268: #ifndef HAVE_X_WINDOWS
  269: static unsigned dos_windows_version;
  270: Lisp_Object Vdos_windows_version;
  271: 
  272: char parent_vm_title[50];       /* Ralf Brown says 30 is enough */
  273: int w95_set_virtual_machine_title (const char *);
  274: 
  275: void
  276: restore_parent_vm_title (void)
  277: {
  278:   if (NILP (Vdos_windows_version))
  279:     return;
  280:   if ((dos_windows_version & 0xff) >= 4 && parent_vm_title[0])
  281:     w95_set_virtual_machine_title (parent_vm_title);
  282:   delay (50);
  283: }
  284: #endif /* !HAVE_X_WINDOWS */
  285: 
  286: void
  287: init_dosfns ()
  288: {
  289:   union REGS regs;
  290:   _go32_dpmi_registers dpmiregs;
  291:   unsigned long xbuf = _go32_info_block.linear_address_of_transfer_buffer;
  292: 
  293: #ifndef SYSTEM_MALLOC
  294:   get_lim_data (); /* why the hell isn't this called elsewhere? */
  295: #endif
  296: 
  297:   regs.x.ax = 0x3000;
  298:   intdos (&regs, &regs);
  299:   Vdos_version = Fcons (make_number (regs.h.al), make_number (regs.h.ah));
  300: 
  301:   /* Obtain the country code via DPMI, use DJGPP transfer buffer.  */
  302:   dpmiregs.x.ax = 0x3800;
  303:   dpmiregs.x.ds = xbuf >> 4;
  304:   dpmiregs.x.dx = 0;
  305:   dpmiregs.x.ss = dpmiregs.x.sp = dpmiregs.x.flags = 0;
  306:   _go32_dpmi_simulate_int (0x21, &dpmiregs);
  307:   if (dpmiregs.x.flags & 1)
  308:     {
  309:       dos_country_code = 1;     /* assume USA if 213800 failed */
  310:       memcpy (dos_country_info, usa_country_info, DOS_COUNTRY_INFO);
  311:     }
  312:   else
  313:     {
  314:       dos_country_code = dpmiregs.x.bx;
  315:       dosmemget (xbuf, DOS_COUNTRY_INFO, dos_country_info);
  316:     }
  317: 
  318:   dos_set_keyboard (dos_country_code, 0);
  319: 
  320:   regs.x.ax = 0x6601;
  321:   intdos (&regs, &regs);
  322:   if (regs.x.cflag)
  323:     /* Estimate code page from country code */
  324:     switch (dos_country_code)
  325:       {
  326:       case 45: /* Denmark */
  327:       case 47: /* Norway */
  328:         dos_codepage = 865;
  329:         break;
  330:       default:
  331:         /* US */
  332:         dos_codepage = 437;
  333:       }
  334:   else
  335:     dos_codepage = regs.x.bx & 0xffff;
  336: 
  337: #ifndef HAVE_X_WINDOWS
  338:   parent_vm_title[0] = '\0';
  339: 
  340:   /* If we are running from DOS box on MS-Windows, get Windows version.  */
  341:   dpmiregs.x.ax = 0x1600;       /* enhanced mode installation check */
  342:   dpmiregs.x.ss = dpmiregs.x.sp = dpmiregs.x.flags = 0;
  343:   _go32_dpmi_simulate_int (0x2f, &dpmiregs);
  344:   /* We only support Windows-specific features when we run on Windows 9X
  345:      or on Windows 3.X/enhanced mode.
  346: 
  347:      Int 2Fh/AX=1600h returns:
  348: 
  349:      AL = 00:  no Windows at all;
  350:      AL = 01:  Windows/386 2.x;
  351:      AL = 80h: Windows 3.x in mode other than enhanced;
  352:      AL = FFh: Windows/386 2.x
  353: 
  354:      We also check AH > 0 (Windows 3.1 or later), in case AL tricks us.  */
  355:   if (dpmiregs.h.al > 2 && dpmiregs.h.al != 0x80 && dpmiregs.h.al != 0xff
  356:       && (dpmiregs.h.al > 3 || dpmiregs.h.ah > 0))
  357:     {
  358:       dos_windows_version = dpmiregs.x.ax;
  359:       Vdos_windows_version =
  360:         Fcons (make_number (dpmiregs.h.al), make_number (dpmiregs.h.ah));
  361: 
  362:       /* Save the current title of this virtual machine, so we can restore
  363:          it before exiting.  Otherwise, Windows 95 will continue to use
  364:          the title we set even after we are history, stupido...  */
  365:       if (dpmiregs.h.al >= 4)
  366:         {
  367:           dpmiregs.x.ax = 0x168e;
  368:           dpmiregs.x.dx = 3;   /* get VM title */
  369:           dpmiregs.x.cx = sizeof(parent_vm_title) - 1;
  370:           dpmiregs.x.es = __tb >> 4;
  371:           dpmiregs.x.di = __tb & 15;
  372:           dpmiregs.x.sp = dpmiregs.x.ss = dpmiregs.x.flags = 0;
  373:           _go32_dpmi_simulate_int (0x2f, &dpmiregs);
  374:           if (dpmiregs.x.ax == 1)
  375:             dosmemget (__tb, sizeof(parent_vm_title), parent_vm_title);
  376:         }
  377:     }
  378:   else
  379:     {
  380:       dos_windows_version = 0;
  381:       Vdos_windows_version = Qnil;
  382:     }
  383: #endif /* !HAVE_X_WINDOWS */
  384: 
  385: #if __DJGPP__ >= 2
  386: 
  387:   /* Without this, we never see hidden files.
  388:      Don't OR it with the previous value, so the value recorded at dump
  389:      time, possibly with `preserve-case' flags set, won't get through.  */
  390:   __opendir_flags = __OPENDIR_FIND_HIDDEN;
  391: 
  392: #if __DJGPP_MINOR__ == 0
  393:   /* Under LFN, preserve the case of files as recorded in the directory
  394:      (in DJGPP 2.01 and later this is automagically done by the library).  */
  395:   if (!NILP (Fmsdos_long_file_names ()))
  396:     __opendir_flags |= __OPENDIR_PRESERVE_CASE;
  397: #endif /* __DJGPP_MINOR__ == 0 */
  398: #endif /* __DJGPP__ >= 2 */
  399: }
  400: ^L
  401: #ifndef HAVE_X_WINDOWS
  402: 
  403: /* Emulation of some X window features from xfns.c and xfaces.c.  */
  404: 
  405: /* Standard VGA colors, in the order of their standard numbering
  406:    in the default VGA palette.  */
  407: static char *vga_colors[16] = {
  408:   "black", "blue", "green", "cyan", "red", "magenta", "brown",
  409:   "lightgray", "darkgray", "lightblue", "lightgreen", "lightcyan",
  410:   "lightred", "lightmagenta", "yellow", "white"
  411: };
  412: 
  413: /* Given a color name, return its index, or -1 if not found.  Note
  414:    that this only performs case-insensitive comparison against the
  415:    standard names.  For anything more sophisticated, like matching
  416:    "gray" with "grey" or translating X color names into their MSDOS
  417:    equivalents, call the Lisp function Qtty_color_desc (defined
  418:    on lisp/term/tty-colors.el).  */
  419: int
  420: msdos_stdcolor_idx (const char *name)
  421: {
  422:   int i;
  423: 
  424:   for (i = 0; i < sizeof (vga_colors) / sizeof (vga_colors[0]); i++)
  425:     if (strcasecmp (name, vga_colors[i]) == 0)
  426:       return i;
  427: 
  428:   return
  429:     strcmp (name, unspecified_fg) == 0 ? FACE_TTY_DEFAULT_FG_COLOR
  430:     : strcmp (name, unspecified_bg) == 0 ? FACE_TTY_DEFAULT_BG_COLOR
  431:     : FACE_TTY_DEFAULT_COLOR;
  432: }
  433: 
  434: /* Given a color index, return its standard name.  */
  435: Lisp_Object
  436: msdos_stdcolor_name (int idx)
  437: {
  438:   extern Lisp_Object Qunspecified;
  439: 
  440:   if (idx == FACE_TTY_DEFAULT_FG_COLOR)
  441:     return build_string (unspecified_fg);
  442:   else if (idx == FACE_TTY_DEFAULT_BG_COLOR)
  443:     return build_string (unspecified_bg);
  444:   else if (idx >= 0 && idx < sizeof (vga_colors) / sizeof (vga_colors[0]))
  445:     return build_string (vga_colors[idx]);
  446:   else
  447:     return Qunspecified;        /* meaning the default */
  448: }
  449: 
  450: /* Support for features that are available when we run in a DOS box
  451:    on MS-Windows.  */
  452: int
  453: ms_windows_version (void)
  454: {
  455:   return dos_windows_version;
  456: }
  457: 
  458: /* Set the title of the current virtual machine, to appear on
  459:    the caption bar of that machine's window.  */
  460: 
  461: int
  462: w95_set_virtual_machine_title (const char *title_string)
  463: {
  464:   /* Only Windows 9X (version 4 and higher) support this function.  */
  465:   if (!NILP (Vdos_windows_version)
  466:       && (dos_windows_version & 0xff) >= 4)
  467:     {
  468:       _go32_dpmi_registers regs;
  469:       dosmemput (title_string, strlen (title_string) + 1, __tb);
  470:       regs.x.ax = 0x168e;
  471:       regs.x.dx = 1;
  472:       regs.x.es = __tb >> 4;
  473:       regs.x.di = __tb & 15;
  474:       regs.x.sp = regs.x.ss = regs.x.flags = 0;
  475:       _go32_dpmi_simulate_int (0x2f, &regs);
  476:       return regs.x.ax == 1;
  477:     }
  478:   return 0;
  479: }
  480: 
  481: /* Change the title of frame F to NAME.
  482:    If NAME is nil, use the frame name as the title.
  483: 
  484:    If Emacs is not run from a DOS box on Windows 9X, this only
  485:    sets the name in the frame struct, but has no other effects.  */
  486: 
  487: void
  488: x_set_title (f, name)
  489:      struct frame *f;
  490:      Lisp_Object name;
  491: {
  492:   /* Don't change the title if it's already NAME.  */
  493:   if (EQ (name, f->title))
  494:     return;
  495: 
  496:   update_mode_lines = 1;
  497: 
  498:   f->title = name;
  499: 
  500:   if (NILP (name))
  501:     name = f->name;
  502: 
  503:   if (FRAME_MSDOS_P (f))
  504:     {
  505:       BLOCK_INPUT;
  506:       w95_set_virtual_machine_title (SDATA (name));
  507:       UNBLOCK_INPUT;
  508:     }
  509: }
  510: #endif /* !HAVE_X_WINDOWS */
  511: ^L
  512: DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
  513:        doc: /* Return storage information about the file system FILENAME is on.
  514: Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
  515: storage of the file system, FREE is the free storage, and AVAIL is the
  516: storage available to a non-superuser.  All 3 numbers are in bytes.
  517: If the underlying system call fails, value is nil.  */)
  518:      (filename)
  519:      Lisp_Object filename;
  520: {
  521:   struct statfs stfs;
  522:   Lisp_Object encoded, value;
  523: 
  524:   CHECK_STRING (filename);
  525:   filename = Fexpand_file_name (filename, Qnil);
  526:   encoded = ENCODE_FILE (filename);
  527: 
  528:   if (statfs (SDATA (encoded), &stfs))
  529:     value = Qnil;
  530:   else
  531:     value = list3 (make_float ((double) stfs.f_bsize * stfs.f_blocks),
  532:                    make_float ((double) stfs.f_bsize * stfs.f_bfree),
  533:                    make_float ((double) stfs.f_bsize * stfs.f_bavail));
  534: 
  535:   return value;
  536: }
  537: ^L
  538: void
  539: dos_cleanup (void)
  540: {
  541: #ifndef HAVE_X_WINDOWS
  542:   restore_parent_vm_title ();
  543: #endif
  544:   /* Make sure the termscript file is committed, in case we are
  545:      crashing and some vital info was written there.  */
  546:   if (termscript)
  547:     {
  548:       fflush (termscript);
  549:       fsync (fileno (termscript));
  550:     }
  551: }
  552: 
  553: /*
  554:  *      Define everything
  555:  */
  556: syms_of_dosfns ()
  557: {
  558:   defsubr (&Sint86);
  559:   defsubr (&Sdos_memget);
  560:   defsubr (&Sdos_memput);
  561:   defsubr (&Smsdos_mouse_init);
  562:   defsubr (&Smsdos_mouse_enable);
  563:   defsubr (&Smsdos_set_keyboard);
  564:   defsubr (&Sinsert_startup_screen);
  565:   defsubr (&Smsdos_mouse_disable);
  566:   defsubr (&Sfile_system_info);
  567: #ifndef HAVE_X_WINDOWS
  568:   defsubr (&Smsdos_mouse_p);
  569: #endif
  570: 
  571:   DEFVAR_INT ("dos-country-code", &