return Qnil;
}
-\f
-static Lisp_Object
-list_processes_1 (Lisp_Object query_only)
-{
- register Lisp_Object tail;
- Lisp_Object proc, minspace;
- register struct Lisp_Process *p;
- char tembuf[300];
- int w_proc, w_buffer, w_tty;
- int exited = 0;
- Lisp_Object i_status, i_buffer, i_tty, i_command;
-
- w_proc = 4; /* Proc */
- w_buffer = 6; /* Buffer */
- w_tty = 0; /* Omit if no ttys */
-
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- int i;
-
- proc = Fcdr (XCAR (tail));
- p = XPROCESS (proc);
- if (NILP (p->type))
- continue;
- if (!NILP (query_only) && p->kill_without_query)
- continue;
- if (STRINGP (p->name)
- && ( i = SCHARS (p->name), (i > w_proc)))
- w_proc = i;
- if (!NILP (p->buffer))
- {
- if (NILP (BVAR (XBUFFER (p->buffer), name)))
- {
- if (w_buffer < 8)
- w_buffer = 8; /* (Killed) */
- }
- else if ((i = SCHARS (BVAR (XBUFFER (p->buffer), name)), (i > w_buffer)))
- w_buffer = i;
- }
- if (STRINGP (p->tty_name)
- && (i = SCHARS (p->tty_name), (i > w_tty)))
- w_tty = i;
- }
-
- XSETFASTINT (i_status, w_proc + 1);
- XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
- if (w_tty)
- {
- XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
- XSETFASTINT (i_command, XFASTINT (i_tty) + w_tty + 1);
- }
- else
- {
- i_tty = Qnil;
- XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
- }
-
- XSETFASTINT (minspace, 1);
-
- set_buffer_internal (XBUFFER (Vstandard_output));
- BVAR (current_buffer, undo_list) = Qt;
-
- BVAR (current_buffer, truncate_lines) = Qt;
-
- write_string ("Proc", -1);
- Findent_to (i_status, minspace); write_string ("Status", -1);
- Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
- if (!NILP (i_tty))
- {
- Findent_to (i_tty, minspace); write_string ("Tty", -1);
- }
- Findent_to (i_command, minspace); write_string ("Command", -1);
- write_string ("\n", -1);
-
- write_string ("----", -1);
- Findent_to (i_status, minspace); write_string ("------", -1);
- Findent_to (i_buffer, minspace); write_string ("------", -1);
- if (!NILP (i_tty))
- {
- Findent_to (i_tty, minspace); write_string ("---", -1);
- }
- Findent_to (i_command, minspace); write_string ("-------", -1);
- write_string ("\n", -1);
-
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object symbol;
-
- proc = Fcdr (XCAR (tail));
- p = XPROCESS (proc);
- if (NILP (p->type))
- continue;
- if (!NILP (query_only) && p->kill_without_query)
- continue;
-
- Finsert (1, &p->name);
- Findent_to (i_status, minspace);
-
- if (p->raw_status_new)
- update_status (p);
- symbol = p->status;
- if (CONSP (p->status))
- symbol = XCAR (p->status);
-
- if (EQ (symbol, Qsignal))
- Fprinc (symbol, Qnil);
- else if (NETCONN1_P (p) || SERIALCONN1_P (p))
- {
- if (EQ (symbol, Qexit))
- write_string ("closed", -1);
- else if (EQ (p->command, Qt))
- write_string ("stopped", -1);
- else if (EQ (symbol, Qrun))
- write_string ("open", -1);
- else
- Fprinc (symbol, Qnil);
- }
- else if (SERIALCONN1_P (p))
- {
- write_string ("running", -1);
- }
- else
- Fprinc (symbol, Qnil);
-
- if (EQ (symbol, Qexit))
- {
- Lisp_Object tem;
- tem = Fcar (Fcdr (p->status));
- if (XFASTINT (tem))
- {
- sprintf (tembuf, " %d", (int) XFASTINT (tem));
- write_string (tembuf, -1);
- }
- }
-
- if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed))
- exited++;
-
- Findent_to (i_buffer, minspace);
- if (NILP (p->buffer))
- insert_string ("(none)");
- else if (NILP (BVAR (XBUFFER (p->buffer), name)))
- insert_string ("(Killed)");
- else
- Finsert (1, &BVAR (XBUFFER (p->buffer), name));
-
- if (!NILP (i_tty))
- {
- Findent_to (i_tty, minspace);
- if (STRINGP (p->tty_name))
- Finsert (1, &p->tty_name);
- }
-
- Findent_to (i_command, minspace);
-
- if (EQ (p->status, Qlisten))
- {
- Lisp_Object port = Fplist_get (p->childp, QCservice);
- if (INTEGERP (port))
- port = Fnumber_to_string (port);
- if (NILP (port))
- port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
- sprintf (tembuf, "(network %s server on %s)\n",
- (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
- (STRINGP (port) ? SSDATA (port) : "?"));
- insert_string (tembuf);
- }
- else if (NETCONN1_P (p))
- {
- /* For a local socket, there is no host name,
- so display service instead. */
- Lisp_Object host = Fplist_get (p->childp, QChost);
- if (!STRINGP (host))
- {
- host = Fplist_get (p->childp, QCservice);
- if (INTEGERP (host))
- host = Fnumber_to_string (host);
- }
- if (NILP (host))
- host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
- sprintf (tembuf, "(network %s connection to %s)\n",
- (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
- (STRINGP (host) ? SSDATA (host) : "?"));
- insert_string (tembuf);
- }
- else if (SERIALCONN1_P (p))
- {
- Lisp_Object port = Fplist_get (p->childp, QCport);
- Lisp_Object speed = Fplist_get (p->childp, QCspeed);
- insert_string ("(serial port ");
- if (STRINGP (port))
- insert_string (SSDATA (port));
- else
- insert_string ("?");
- if (INTEGERP (speed))
- {
- sprintf (tembuf, " at %ld b/s", (long) XINT (speed));
- insert_string (tembuf);
- }
- insert_string (")\n");
- }
- else
- {
- Lisp_Object tem = p->command;
- while (1)
- {
- Lisp_Object tem1 = Fcar (tem);
- if (NILP (tem1))
- break;
- Finsert (1, &tem1);
- tem = Fcdr (tem);
- if (NILP (tem))
- break;
- insert_string (" ");
- }
- insert_string ("\n");
- }
- }
- if (exited)
- {
- status_notify (NULL);
- redisplay_preserve_echo_area (13);
- }
- return Qnil;
-}
-
-DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
- doc: /* Display a list of all processes.
-If optional argument QUERY-ONLY is non-nil, only processes with
-the query-on-exit flag set will be listed.
-Any process listed as exited or signaled is actually eliminated
-after the listing is made. */)
- (Lisp_Object query_only)
-{
- internal_with_output_to_temp_buffer ("*Process List*",
- list_processes_1, query_only);
- return Qnil;
-}
DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
doc: /* Return a list of all processes. */)
defsubr (&Sprocess_contact);
defsubr (&Sprocess_plist);
defsubr (&Sset_process_plist);
- defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
defsubr (&Sserial_process_configure);
projects / emacs.git / commitdiff