Add prototype for emacs_tparam to avoid warning

[sxemacs] / src / ui / console.c

/* The console object.
   Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
   Copyright (C) 1996 Ben Wing.

This file is part of SXEmacs

SXEmacs 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 3 of the License, or
(at your option) any later version.

SXEmacs 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 this program.  If not, see <http://www.gnu.org/licenses/>. */


/* Synched up with: Not in FSF. */

/* Written by Ben Wing. */

#include <config.h>
#include "lisp.h"

#include "buffer.h"
#include "TTY/console-tty.h" /* for Fconsole_tty_controlling process ins
                                suspend-console. Needs refactoring...*/
#include "events/events.h"
#include "frame.h"
#include "redisplay.h"
#include "sysdep.h"
#include "window.h"

Lisp_Object Vconsole_list, Vselected_console;

Lisp_Object Vcreate_console_hook, Vdelete_console_hook;

Lisp_Object Qconsolep, Qconsole_live_p;
Lisp_Object Qcreate_console_hook;
Lisp_Object Qdelete_console_hook;

Lisp_Object Qsuspend_hook;
Lisp_Object Qsuspend_resume_hook;

/* This structure holds the default values of the console-local
   variables defined with DEFVAR_CONSOLE_LOCAL, that have special
   slots in each console.  The default value occupies the same slot
   in this structure as an individual console's value occupies in
   that console.  Setting the default value also goes through the
   list of consoles and stores into each console that does not say
   it has a local value.  */
Lisp_Object Vconsole_defaults;
static void *console_defaults_saved_slots;

/* This structure marks which slots in a console have corresponding
   default values in console_defaults.
   Each such slot has a nonzero value in this structure.
   The value has only one nonzero bit.

   When a console has its own local value for a slot,
   the bit for that slot (found in the same slot in this structure)
   is turned on in the console's local_var_flags slot.

   If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL
   for the slot, but there is no default value for it; the corresponding
   slot in console_defaults is not used except to initialize newly-created
   consoles.

   If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it
  as well as a default value which is used to initialize newly-created
   consoles and as a reset-value when local-vars are killed.

   If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it.
   (The slot is always local, but there's no lisp variable for it.)
   The default value is only used to initialize newly-creation consoles.

   If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but
   there is a default which is used to initialize newly-creation
   consoles and as a reset-value when local-vars are killed.

   */
struct console console_local_flags;

/* This structure holds the names of symbols whose values may be
   console-local.  It is indexed and accessed in the same way as the above. */
static Lisp_Object Vconsole_local_symbols;
static void *console_local_symbols_saved_slots;

DEFINE_CONSOLE_TYPE(dead);

Lisp_Object Vconsole_type_list;

console_type_entry_dynarr *the_console_type_entry_dynarr;
\f
static Lisp_Object mark_console(Lisp_Object obj)
{
        struct console *con = XCONSOLE(obj);

#define MARKED_SLOT(x) mark_object (con->x)
#include "conslots.h"
#undef MARKED_SLOT

        /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
        if (con->conmeths) {
                mark_object(con->conmeths->symbol);
                MAYBE_CONMETH(con, mark_console, (con));
        }

        return Qnil;
}

static void
print_console(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
        struct console *con = XCONSOLE(obj);

        if (print_readably)
                error("printing unreadable object #<console %s 0x%x>",
                      XSTRING_DATA(con->name), con->header.uid);

        write_fmt_string(printcharfun, "#<%s-console", 
                         (!CONSOLE_LIVE_P(con) ? "dead" : CONSOLE_TYPE_NAME(con)));
        if (CONSOLE_LIVE_P(con) && !NILP(CONSOLE_CONNECTION(con))) {
                write_c_string(" on ", printcharfun);
                print_internal(CONSOLE_CONNECTION(con), printcharfun, 1);
        }
        write_fmt_str(printcharfun, " 0x%x>", con->header.uid);
}

DEFINE_LRECORD_IMPLEMENTATION("console", console,
                              mark_console, print_console, 0, 0, 0, 0,
                              struct console);
\f
static struct console *allocate_console(void)
{
        Lisp_Object console;
        struct console *con =
            alloc_lcrecord_type(struct console, &lrecord_console);
        struct gcpro gcpro1;

        copy_lcrecord(con, XCONSOLE(Vconsole_defaults));

        XSETCONSOLE(console, con);
        GCPRO1(console);

        con->quit_char = 7;     /* C-g */
        con->command_builder = allocate_command_builder(console);
        con->function_key_map = Fmake_sparse_keymap(Qnil);

        UNGCPRO;
        return con;
}

struct console *decode_console(Lisp_Object console)
{
        if (NILP(console))
                console = Fselected_console();
        /* quietly accept devices and frames for the console arg */
        if (DEVICEP(console) || FRAMEP(console))
                console = DEVICE_CONSOLE(decode_device(console));
        CHECK_LIVE_CONSOLE(console);
        return XCONSOLE(console);
}

struct console_methods *decode_console_type(Lisp_Object type,
                                            Error_behavior errb)
{
        int i;

        for (i = 0; i < Dynarr_length(the_console_type_entry_dynarr); i++)
                if (EQ
                    (type, Dynarr_at(the_console_type_entry_dynarr, i).symbol))
                        return Dynarr_at(the_console_type_entry_dynarr,
                                         i).meths;

        maybe_signal_simple_error("Invalid console type", type, Qconsole, errb);

        return 0;
}

int valid_console_type_p(Lisp_Object type)
{
        return decode_console_type(type, ERROR_ME_NOT) != 0;
}

DEFUN("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0,   /*
Return t if CONSOLE-TYPE is a valid console type.
Valid types are 'x, 'tty, and 'stream.
*/
      (console_type))
{
        return valid_console_type_p(console_type) ? Qt : Qnil;
}

DEFUN("console-type-list", Fconsole_type_list, 0, 0, 0, /*
Return a list of valid console types.
*/
      ())
{
        return Fcopy_sequence(Vconsole_type_list);
}

DEFUN("cdfw-console", Fcdfw_console, 1, 1, 0,   /*
Given a console, device, frame, or window, return the associated console.
Return nil otherwise.
*/
      (object))
{
        return CDFW_CONSOLE(object);
}
\f
DEFUN("selected-console", Fselected_console, 0, 0, 0,   /*
Return the console which is currently active.
*/
      ())
{
        return Vselected_console;
}

/* Called from selected_device_1(), called from selected_frame_1(),
   called from Fselect_window() */
void select_console_1(Lisp_Object console)
{
        /* perhaps this should do something more complicated */
        Vselected_console = console;

        /* #### Schedule this to be removed in 19.14 */
#ifdef HAVE_X_WINDOWS
        if (CONSOLE_X_P(XCONSOLE(console)))
                Vwindow_system = Qx;
        else
#endif
#ifdef HAVE_GTK
        if (CONSOLE_GTK_P(XCONSOLE(console)))
                Vwindow_system = Qgtk;
        else
#endif
                Vwindow_system = Qnil;
}

DEFUN("select-console", Fselect_console, 1, 1, 0,       /*
Select the console CONSOLE.
Subsequent editing commands apply to its selected device, selected frame,
and selected window.  The selection of CONSOLE lasts until the next time
the user does something to select a different console, or until the next
time this function is called.
*/
      (console))
{
        Lisp_Object device;

        CHECK_LIVE_CONSOLE(console);

        device = CONSOLE_SELECTED_DEVICE(XCONSOLE(console));
        if (!NILP(device)) {
                struct device *d = XDEVICE(device);
                Lisp_Object frame = DEVICE_SELECTED_FRAME(d);
                if (!NILP(frame)) {
                        struct frame *f = XFRAME(frame);
                        Fselect_window(FRAME_SELECTED_WINDOW(f), Qnil);
                } else
                        error("Can't select console with no frames.");
        } else
                error("Can't select a console with no devices");
        return Qnil;
}

void set_console_last_nonminibuf_frame(struct console *con, Lisp_Object frame)
{
        con->last_nonminibuf_frame = frame;
}

DEFUN("consolep", Fconsolep, 1, 1, 0,   /*
Return non-nil if OBJECT is a console.
*/
      (object))
{
        return CONSOLEP(object) ? Qt : Qnil;
}

DEFUN("console-live-p", Fconsole_live_p, 1, 1, 0,       /*
Return non-nil if OBJECT is a console that has not been deleted.
*/
      (object))
{
        return CONSOLEP(object) && CONSOLE_LIVE_P(XCONSOLE(object)) ? Qt : Qnil;
}

DEFUN("console-type", Fconsole_type, 0, 1, 0,   /*
Return the console type (e.g. `x' or `tty') of CONSOLE.
Value is `tty' for a tty console (a character-only terminal),
`x' for a console that is an X display,
`mswindows' for a console that is a Windows NT/95/97 connection,
`pc' for a console that is a direct-write MS-DOS connection (not yet
implemented),
`stream' for a stream console (which acts like a stdio stream), and
`dead' for a deleted console.
*/
      (console))
{
        /* don't call decode_console() because we want to allow for dead
           consoles. */
        if (NILP(console))
                console = Fselected_console();
        CHECK_CONSOLE(console);
        return CONSOLE_TYPE(XCONSOLE(console));
}

DEFUN("console-name", Fconsole_name, 0, 1, 0,   /*
Return the name of CONSOLE.
*/
      (console))
{
        return CONSOLE_NAME(decode_console(console));
}

DEFUN("console-connection", Fconsole_connection, 0, 1, 0,       /*
Return the connection of the specified console.
CONSOLE defaults to the selected console if omitted.
*/
      (console))
{
        return CONSOLE_CONNECTION(decode_console(console));
}

Lisp_Object make_console(struct console * con)
{
        Lisp_Object console;
        XSETCONSOLE(console, con);
        return console;
}

static Lisp_Object
semi_canonicalize_console_connection(struct console_methods *meths,
                                     Lisp_Object name, Error_behavior errb)
{
        if (HAS_CONTYPE_METH_P(meths, semi_canonicalize_console_connection))
                return CONTYPE_METH(meths, semi_canonicalize_console_connection,
                                    (name, errb));
        else
                return CONTYPE_METH_OR_GIVEN(meths,
                                             canonicalize_console_connection,
                                             (name, errb), name);
}

static Lisp_Object
canonicalize_console_connection(struct console_methods *meths,
                                Lisp_Object name, Error_behavior errb)
{
        if (HAS_CONTYPE_METH_P(meths, canonicalize_console_connection))
                return CONTYPE_METH(meths, canonicalize_console_connection,
                                    (name, errb));
        else
                return CONTYPE_METH_OR_GIVEN(meths,
                                             semi_canonicalize_console_connection,
                                             (name, errb), name);
}

static Lisp_Object
find_console_of_type(struct console_methods *meths, Lisp_Object canon)
{
        Lisp_Object concons;

        CONSOLE_LOOP(concons) {
                Lisp_Object console = XCAR(concons);

                if (EQ(CONMETH_TYPE(meths), CONSOLE_TYPE(XCONSOLE(console)))
                    &&
                    internal_equal(CONSOLE_CANON_CONNECTION(XCONSOLE(console)),
                                   canon, 0))
                        return console;
        }

        return Qnil;
}

DEFUN("find-console", Ffind_console, 1, 2, 0,   /*
Look for an existing console attached to connection CONNECTION.
Return the console if found; otherwise, return nil.

If TYPE is specified, only return consoles of that type; otherwise,
return consoles of any type. (It is possible, although unlikely,
that two consoles of different types could have the same connection
name; in such a case, the first console found is returned.)
*/
      (connection, type))
{
        Lisp_Object canon = Qnil;
        struct gcpro gcpro1;

        GCPRO1(canon);

        if (!NILP(type)) {
                struct console_methods *conmeths =
                    decode_console_type(type, ERROR_ME);
                canon =
                    canonicalize_console_connection(conmeths, connection,
                                                    ERROR_ME_NOT);
                if (UNBOUNDP(canon))
                        RETURN_UNGCPRO(Qnil);

                RETURN_UNGCPRO(find_console_of_type(conmeths, canon));
        } else {
                int i;

                for (i = 0; i < Dynarr_length(the_console_type_entry_dynarr);
                     i++) {
                        struct console_methods *conmeths =
                            Dynarr_at(the_console_type_entry_dynarr, i).meths;
                        canon =
                            canonicalize_console_connection(conmeths,
                                                            connection,
                                                            ERROR_ME_NOT);
                        if (!UNBOUNDP(canon)) {
                                Lisp_Object console =
                                    find_console_of_type(conmeths, canon);
                                if (!NILP(console))
                                        RETURN_UNGCPRO(console);
                        }
                }

                RETURN_UNGCPRO(Qnil);
        }
}

DEFUN("get-console", Fget_console, 1, 2, 0,     /*
Look for an existing console attached to connection CONNECTION.
Return the console if found; otherwise, signal an error.

If TYPE is specified, only return consoles of that type; otherwise,
return consoles of any type. (It is possible, although unlikely,
that two consoles of different types could have the same connection
name; in such a case, the first console found is returned.)
*/
      (connection, type))
{
        Lisp_Object console = Ffind_console(connection, type);
        if (NILP(console)) {
                if (NILP(type))
                        signal_simple_error("No such console", connection);
                else
                        signal_simple_error_2("No such console", type,
                                              connection);
        }
        return console;
}

Lisp_Object
create_console(Lisp_Object name, Lisp_Object type, Lisp_Object connection,
               Lisp_Object props)
{
        /* This function can GC */
        struct console *con;
        Lisp_Object console;
        struct gcpro gcpro1;

        console = Ffind_console(connection, type);
        if (!NILP(console))
                return console;

        con = allocate_console();
        XSETCONSOLE(console, con);

        GCPRO1(console);

        con->conmeths = decode_console_type(type, ERROR_ME);

        CONSOLE_NAME(con) = name;
        CONSOLE_CONNECTION(con) =
            semi_canonicalize_console_connection(con->conmeths, connection,
                                                 ERROR_ME);
        CONSOLE_CANON_CONNECTION(con) =
            canonicalize_console_connection(con->conmeths, connection,
                                            ERROR_ME);

        MAYBE_CONMETH(con, init_console, (con, props));

        /* Do it this way so that the console list is in order of creation */
        Vconsole_list = nconc2(Vconsole_list, Fcons(console, Qnil));

        if (CONMETH_OR_GIVEN(con, initially_selected_for_input, (con), 0))
                event_stream_select_console(con);

        UNGCPRO;
        return console;
}

void
add_entry_to_console_type_list(Lisp_Object symbol,
                               struct console_methods *meths)
{
        struct console_type_entry entry;

        entry.symbol = symbol;
        entry.meths = meths;
        Dynarr_add(the_console_type_entry_dynarr, entry);
        Vconsole_type_list = Fcons(symbol, Vconsole_type_list);
}

/* find a console other than the selected one.  Prefer non-stream
   consoles over stream consoles. */

static Lisp_Object find_other_console(Lisp_Object console)
{
        Lisp_Object concons;

        /* look for a non-stream console */
        CONSOLE_LOOP(concons) {
                Lisp_Object con = XCAR(concons);
                if (!CONSOLE_STREAM_P(XCONSOLE(con))
                    && !EQ(con, console)
                    && !NILP(CONSOLE_SELECTED_DEVICE(XCONSOLE(con)))
                    && !NILP(DEVICE_SELECTED_FRAME
                             (XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(con))))))
                        break;
        }
        if (!NILP(concons))
                return XCAR(concons);

        /* OK, now look for a stream console */
        CONSOLE_LOOP(concons) {
                Lisp_Object con = XCAR(concons);
                if (!EQ(con, console)
                    && !NILP(CONSOLE_SELECTED_DEVICE(XCONSOLE(con)))
                    && !NILP(DEVICE_SELECTED_FRAME
                             (XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(con))))))
                        break;
        }
        if (!NILP(concons))
                return XCAR(concons);

        /* Sorry, there ain't none */
        return Qnil;
}

static int
find_nonminibuffer_frame_not_on_console_predicate(Lisp_Object frame,
                                                  void *closure)
{
        Lisp_Object console;

        VOID_TO_LISP(console, closure);
        if (FRAME_MINIBUF_ONLY_P(XFRAME(frame)))
                return 0;
        if (EQ(console, FRAME_CONSOLE(XFRAME(frame))))
                return 0;
        return 1;
}

static Lisp_Object find_nonminibuffer_frame_not_on_console(Lisp_Object console)
{
        return
            find_some_frame(find_nonminibuffer_frame_not_on_console_predicate,
                            LISP_TO_VOID(console));
}

/* Delete console CON.

   If FORCE is non-zero, allow deletion of the only frame.

   If CALLED_FROM_KILL_EMACS is non-zero, then, if
   deleting the last console, just delete it,
   instead of calling `save-buffers-kill-emacs'.

   If FROM_IO_ERROR is non-zero, then the console is gone due
   to an I/O error.  This affects what happens if we exit
   (we do an emergency exit instead of `save-buffers-kill-emacs'.)
*/

void
delete_console_internal(struct console *con, int force,
                        int called_from_kill_emacs, int from_io_error)
{
        /* This function can GC */
        Lisp_Object console;
        struct gcpro gcpro1;

        /* OK to delete an already-deleted console. */
        if (!CONSOLE_LIVE_P(con))
                return;

        XSETCONSOLE(console, con);
        GCPRO1(console);

        if (!called_from_kill_emacs) {
                int down_we_go = 0;

                if ((XINT(Flength(Vconsole_list)) == 1)
                    /* if we just created the console, it might not be listed,
                       or something ... */
                    && !NILP(memq_no_quit(console, Vconsole_list)))
                        down_we_go = 1;
                /* If there aren't any nonminibuffer frames that would
                   be left, then exit. */
                else if (NILP(find_nonminibuffer_frame_not_on_console(console)))
                        down_we_go = 1;

                if (down_we_go) {
                        if (!force)
                                error("Attempt to delete the only frame");
                        else if (from_io_error) {
                                /* Mayday mayday!  We're going down! */
                                stderr_out("  Autosaving and exiting...\n");
                                Vwindow_system = Qnil;  /* let it lie! */
                                preparing_for_armageddon = 1;
                                Fkill_emacs(make_int(70));
                        } else {
                                call0(Qsave_buffers_kill_emacs);
                                UNGCPRO;
                                /* If we get here, the user said they didn't want
                                   to exit, so don't. */
                                return;
                        }
                }
        }

        /* Breathe a sigh of relief.  We're still alive. */

        {
                Lisp_Object frmcons, devcons;

                /* First delete all frames without their own minibuffers,
                   to avoid errors coming from attempting to delete a frame
                   that is a surrogate for another frame.

                   We don't set "called_from_delete_console" because we want the
                   device to go ahead and get deleted if we delete the last frame
                   on a device.  We won't run into trouble here because for any
                   frame without a minibuffer, there has to be another one on
                   the same console with a minibuffer, and we're not deleting that,
                   so delete_console_internal() won't get recursively called.

                   WRONG!  With surrogate minibuffers this isn't true.  Frames
                   with only a minibuffer are not enough to prevent
                   delete_frame_internal from triggering a device deletion. */
                CONSOLE_FRAME_LOOP_NO_BREAK(frmcons, devcons, con) {
                        struct frame *f = XFRAME(XCAR(frmcons));
                        /* delete_frame_internal() might do anything such as run hooks,
                           so be defensive. */
                        if (FRAME_LIVE_P(f) && !FRAME_HAS_MINIBUF_P(f))
                                delete_frame_internal(f, 1, 1, from_io_error);

                        if (!CONSOLE_LIVE_P(con)) {     /* make sure the delete-*-hook didn't
                                                           go ahead and delete anything */
                                UNGCPRO;
                                return;
                        }
                }

                CONSOLE_DEVICE_LOOP(devcons, con) {
                        struct device *d = XDEVICE(XCAR(devcons));
                        /* delete_device_internal() might do anything such as run hooks,
                           so be defensive. */
                        if (DEVICE_LIVE_P(d))
                                delete_device_internal(d, 1, 1, from_io_error);
                        if (!CONSOLE_LIVE_P(con)) {     /* make sure the delete-*-hook didn't
                                                           go ahead and delete anything */
                                UNGCPRO;
                                return;
                        }
                }
        }

        CONSOLE_SELECTED_DEVICE(con) = Qnil;

        /* try to select another console */

        if (EQ(console, Fselected_console())) {
                Lisp_Object other_dev = find_other_console(console);
                if (!NILP(other_dev))
                        Fselect_console(other_dev);
                else {
                        /* necessary? */
                        Vselected_console = Qnil;
                        Vwindow_system = Qnil;
                }
        }

        if (con->input_enabled)
                event_stream_unselect_console(con);

        MAYBE_CONMETH(con, delete_console, (con));

        Vconsole_list = delq_no_quit(console, Vconsole_list);
        RESET_CHANGED_SET_FLAGS;
        con->conmeths = dead_console_methods;

        UNGCPRO;
}

void io_error_delete_console(Lisp_Object console)
{
        delete_console_internal(XCONSOLE(console), 1, 0, 1);
}

DEFUN("delete-console", Fdelete_console, 1, 2, 0,       /*
Delete CONSOLE, permanently eliminating it from use.
Normally, you cannot delete the last non-minibuffer-only frame (you must
use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
second argument FORCE is non-nil, you can delete the last frame. (This
will automatically call `save-buffers-kill-emacs'.)
*/
      (console, force))
{
        CHECK_CONSOLE(console);
        delete_console_internal(XCONSOLE(console), !NILP(force), 0, 0);
        return Qnil;
}

DEFUN("console-list", Fconsole_list, 0, 0, 0,   /*
Return a list of all consoles.
*/
      ())
{
        return Fcopy_sequence(Vconsole_list);
}

DEFUN("console-device-list", Fconsole_device_list, 0, 1, 0,     /*
Return a list of all devices on CONSOLE.
If CONSOLE is nil, the selected console is used.
*/
      (console))
{
        return Fcopy_sequence(CONSOLE_DEVICE_LIST(decode_console(console)));
}

DEFUN("console-enable-input", Fconsole_enable_input, 1, 1, 0,   /*
Enable input on console CONSOLE.
*/
      (console))
{
        struct console *con = decode_console(console);
        if (!con->input_enabled)
                event_stream_select_console(con);
        return Qnil;
}

DEFUN("console-disable-input", Fconsole_disable_input, 1, 1, 0, /*
Disable input on console CONSOLE.
*/
      (console))
{
        struct console *con = decode_console(console);