/* emxdep.c, emx-specific bits of GNU Emacs.
   Copyright (C) 1993 Eberhard Mattes.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
#include <sys/process.h>

#define INCL_DEVICES
#define INCL_DOSPROCESS
#define INCL_WINSWITCHLIST
#define UCHAR OS2UCHAR
#include <os2.h>
#undef UCHAR

#include "config.h"
#include "lisp.h"
#include "commands.h"

Lisp_Object Vemx_shell_regexp;
extern Lisp_Object Vprocess_environment;


int sigblock (int mask)
{
  return 0;
}

int sigsetmask (int mask)
{
  return 0;
}

int nice (int incr)
{
  return 0;
}

int setuid (int id)
{
  return 0;
}

int link (char *name1, char *name2)
{
  return (rename (name1, name2));
}

int setpgrp (int pid, int pgrp)
{
  return 0;
}

int gethostname (char *name, int namelen)
{
  char *sp = getenv ("SYSTEMNAME");
  if (!sp)
    sp = "standalone";
  _strncpy (name, sp, namelen);
  return 0;
}

int vfork (void)
{
  return 0;                     /* We're the child process! */
}


/* Stolen from child_setup of callproc.c and hacked severly. */

int emx_child_setup (in, out, err, new_argv, set_pgrp, current_dir)
     int in, out, err;
     register char **new_argv;
     int set_pgrp;
     Lisp_Object current_dir;
{
  int saved_in, saved_out, saved_err;
  char *org_cwd = 0;
  char org_cwd_buf[512];
  char **env, *p;
  int pid;

  {
    Lisp_Object prog;

    prog = build_string (new_argv[0]);
    if (XTYPE (Vemx_shell_regexp) == Lisp_String
        && fast_string_match (Vemx_shell_regexp, prog) >= 0
        && new_argv[0] != 0 && new_argv[1] != 0
        && strcmp (new_argv[1], "-c") == 0)
      {
        new_argv[1] = "/c";
        if (new_argv[2] != 0)
          {
            if (strncmp (new_argv[2], "exec ", 5) == 0)
              new_argv[2] += 5;
            p = alloca (strlen (new_argv[2]) + 1);
            strcpy (p, new_argv[2]);
            new_argv[2] = p;
            while (*p != 0 && *p != ' ' && *p != '\t')
              {
                if (*p == '/')
                  *p = '\\';
                ++p;
              }
          }
      }
  }

  {
    register unsigned char *temp;
    register int i;

    i = XSTRING (current_dir)->size;
    temp = (unsigned char *) alloca (i + 2);
    bcopy (XSTRING (current_dir)->data, temp, i);
    if (i > 1 && (temp[i-1] == '/' || temp[i-1] == '\\') && temp[i-2] != ':')
      --i;
    temp[i] = 0;
    org_cwd = _getcwd2 (org_cwd_buf, sizeof (org_cwd_buf));
    _chdir2 (temp);
  }

  /* Set `env' to a vector of the strings in Vprocess_environment.  */
  {
    register Lisp_Object tem;
    register char **new_env;
    register int new_length;

    new_length = 0;
    for (tem = Vprocess_environment;
	 (XTYPE (tem) == Lisp_Cons
	  && XTYPE (XCONS (tem)->car) == Lisp_String);
	 tem = XCONS (tem)->cdr)
      new_length++;

    /* new_length + 1 to include terminating 0 */
    env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));

    /* Copy the Vprocess_alist strings into new_env.  */
    for (tem = Vprocess_environment;
	 (XTYPE (tem) == Lisp_Cons
	  && XTYPE (XCONS (tem)->car) == Lisp_String);
	 tem = XCONS (tem)->cdr)
      *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
    *new_env = 0;
  }

  saved_in = dup (0); fcntl (saved_in, F_SETFD, 1);
  saved_out = dup (1); fcntl (saved_out, F_SETFD, 1);
  saved_err = dup (2); fcntl (saved_err, F_SETFD, 1);

  close (0);
  close (1);
  close (2);

  dup2 (in, 0);
  dup2 (out, 1);
  dup2 (err, 2);
  close (in);
  close (out);
  close (err);

  /* Close Emacs's descriptors that this process should not have.  */
  close_process_descs ();

  pid = spawnvpe (P_SESSION | P_MINIMIZE | P_BACKGROUND,
                  new_argv[0], (const char * const *)new_argv,
                  (const char * const *)env);
  dup2 (saved_in, 0); close (saved_in);
  dup2 (saved_out, 1); close (saved_out);
  dup2 (saved_err, 2); close (saved_err);
  if (org_cwd != 0)
    _chdir2 (org_cwd);
  return pid;
}


/* Remove this process from the task list. */

void remove_switch_entry (void)
{
  HSWITCH hSwitch;

  hSwitch = WinQuerySwitchHandle (NULL, getpid ());
  WinRemoveSwitchEntry (hSwitch);
}


DEFUN ("filesystem-type", Ffilesystem_type, Sfilesystem_type,
  1, 1, 0,
  "Return a string identifying the filesystem type of PATH.\n\
Filesystem types include FAT, HPFS, LAN, CDFS and NFS.")
  (string)
     Lisp_Object string;
{
  char drive[3], type[16];
  int d;

  CHECK_STRING (string, 0);
  d = _fngetdrive (XSTRING (string)->data);
  if (d == 0)
    d = _getdrive ();
  drive[0] = (char)d;
  drive[1] = ':';
  drive[2] = 0;
  if (_filesys (drive, type, sizeof (type)) != 0)
    error ("_filesys() failed");
  return build_string (type);
}


DEFUN ("file-name-valid-p", Ffile_name_valid_p, Sfile_name_valid_p,
  1, 1, 0,
  "Return t if STRING is a valid file name.\n\
Whether a file name is valid or not depends on the file system.\n\
This is a special feature of GNU Emacs for emx.")
  (string)
     Lisp_Object string;
{
  int i;
  unsigned char *name;

  CHECK_STRING (string, 0);
  name = XSTRING (string)->data;
  if (_osmode == OS2_MODE)
    {
      i = open (name, O_RDONLY);
      if (i >= 0)
        {
          close (i);
          return Qt;
        }
      i = _syserrno ();
      return (i != 15 && i != 123 && i != 206) ? Qt : Qnil;
    }
  else
    {
      if (_fngetdrive (name) != 0)
        name += 2;
      if (*name == 0)
        return Qnil;
      if (strpbrk (name, " \"'*+,:;<=>?[]|") != NULL)
        return Qnil;
      for (i = 0; name[i] != 0; ++i)
        if (name[i] < 0x20)
          return Qnil;
      for (;;)
        {
          i = 0;
          while (*name != 0 && *name != '/' && *name != '\\' && *name != '.')
            ++i, ++name;
          if (i > 8)
            return Qnil;
          if (*name == '.')
            {
              ++name;
              if (i == 0)
                {
                  if (*name == '.')
                    ++name;
                  if (*name != 0 && *name != '/' && *name != '\\')
                    return Qnil;
                }
              i = 0;
              while (*name != 0 && *name != '/' && *name != '\\'
                     && *name != '.')
                ++i, ++name;
              if (i > 3)
                return Qnil;
            }
          if (*name == 0)
            return Qt;
          if (*name != '/' && *name != '\\')
            return Qnil;
          ++name;
        }
    }
}


DEFUN ("keyboard-type", Fkeyboard_type, Skeyboard_type,
  0, 0, 0,
  "Return information about the keyboard.\n\
The value is a list of the form (COUNTRY SUBCOUNTRY CODEPAGE), where\n\
  COUNTRY is the country code of the keyboard layout (a string),\n\
    for instance \"US\".\n\
  SUBCOUNTRY is the subcountry code (a string), for instance \"103 \".\n\
  CODEPAGE is the codepage (a number), on which the current keyboard\n\
    translation table is based, for instance 437.\n\
This function is currently implemented under OS/2 only.\n\
If the keyboard information cannot be retrieved (because Emacs is\n\
running under MS-DOS, for instance), nil is returned.")
  ()
{
  ULONG plen, dlen, action;
  HFILE handle;
  struct
    {
      USHORT length;
      USHORT codepage;
      UCHAR strings[8];
    } kd;
  Lisp_Object value;

  value = Qnil;
  if (_osmode == OS2_MODE
      && DosOpen ("KBD$", &handle, &action, 0, 0,
                  OPEN_ACTION_FAIL_IF_NEW | OPEN_ACTION_OPEN_IF_EXISTS,
                  OPEN_ACCESS_READONLY | OPEN_SHARE_DENYNONE,
                  NULL) == 0)
    {
      kd.length = sizeof (kd);
      dlen = sizeof (kd); plen = 0;
      if (DosDevIOCtl (handle, 4, 0x7b, NULL, plen, &plen,
                       &kd, dlen, &dlen) == 0)
        value = Fcons (build_string (kd.strings),
                       Fcons (build_string (strchr (kd.strings, 0) + 1),
                              Fcons (make_number (kd.codepage), Qnil)));
      DosClose (handle);
    }
  return value;
}


DEFUN ("emacs-priority", Femacs_priority, Semacs_priority,
  1, 2, 0,
  "Set the priority of the Emacs process.\n\
PCLASS selects the priority class.  Possible values are\n\
  nil (no change),\n\
  regular (regular priority class -- this is the OS/2 default,\n\
    a priority boost is applied if the process is in the foreground), and\n\
  foreground-server (fixed-high priority class -- use with care).\n\
PLEVEL is nil (same as 0) or a number between 0 and 31 which indicates\n\
  the priority level within the priority class.  Level 31 has the highest\n\
  priority in each class, the default value assigned by OS/2 is 0.\n\
The priority is inherited by child processes!\n\
This function is implemented under OS/2 only.")
  (pclass, plevel)
     Lisp_Object pclass, plevel;
{
  ULONG cclass;
  LONG clevel;

  if (NILP (pclass))
    cclass = PRTYC_NOCHANGE;
  else if (EQ (pclass, intern ("regular")))
    cclass = PRTYC_REGULAR;
  else if (EQ (pclass, intern ("foreground-server")))
    cclass = PRTYC_FOREGROUNDSERVER;
  else
    error ("invalid priority class");
  if (NILP (plevel))
    clevel = 0;
  else
    {
      CHECK_NUMBER (plevel, 1);
      clevel = XINT (plevel);
      if (clevel < 0 || clevel > 31)
        error ("invalid priority level");
    }
  if (_osmode == OS2_MODE)
    {
      DosSetPriority (PRTYS_THREAD, cclass, -31, 0);
      if (clevel != 0)
        DosSetPriority (PRTYS_THREAD, cclass, clevel, 0);
    }
  return Qnil;
}


syms_of_emxdep ()
{
  DEFVAR_LISP ("emx-shell-regexp", &Vemx_shell_regexp,
    "*Regular expression for detecting OS/2 shells which require\n\
conversion of command line options.  If this regular expression\n\
matches the command passed to call-process, a first argument of\n\
-c is translated to /c.");
  Vemx_shell_regexp = build_string ("\\(^\\|[:/\\\\]\\)\\(cmd\\|CMD\\)\\(\\.exe\\|\\.EXE\\)$");

  defsubr (&Semacs_priority);
  defsubr (&Sfilesystem_type);
  defsubr (&Skeyboard_type);
  defsubr (&Sfile_name_valid_p);
}
