From: Miles Bader <miles@gnu.org>
To: emacs-devel@gnu.org
Subject: process-attributes patch
Date: Tue, 03 Feb 2009 19:13:00 +0900 [thread overview]
Message-ID: <buoskmvhlqr.fsf@dhlpc061.dev.necel.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 963 bytes --]
The attached patch renames "system-process-attributes" to
"process-attributes", and adds the ability to use emacs process objects
as well as pids:
(1) Change the signature of the system-specific
system_process_attributes functions so that the argument is of
type pid_t, instead of Lisp_Object, and accordingly removes the
Lisp_Object->pid_t conversion code from those functions.
(2) Add a "process_pid" function in process.c that contains the
process->pid mapping code which used to be in Fsignal_process.
process_pid also accepts straight process-ids.
(3) Change Fsignal_process to use process_pid and remove the old
inline code which did the same thing.
(4) Rename Fsystem_process_attributes to Fprocess_attributes, and have
it call process_pid to convert a process object to a pid.
(5) Change the callers of system-process-attributes (basically proced)
to use process-attributes instead.
-Miles
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: process-attributes-20090203-0.patch --]
[-- Type: text/x-diff, Size: 13907 bytes --]
lisp/ChangeLog | 5 +++
lisp/proced.el | 10 +++---
lisp/server.el | 2 +-
src/ChangeLog | 15 ++++++++++
src/dosfns.c | 8 +----
src/process.c | 86 ++++++++++++++++++++++++++++++++------------------------
src/process.h | 2 +-
src/sysdep.c | 18 ++++-------
src/w32.c | 6 +--
9 files changed, 87 insertions(+), 65 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 613a510..aaf7d80 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2009-02-03 Miles Bader <miles@gnu.org>
+
+ * proced.el (proced-process-attributes):
+ * server.el (server-running-p): Use `process-attributes'.
+
2009-02-03 Glenn Morris <rgm@gnu.org>
* mail/unrmail.el (unrmail): In the absence of Mail-from, prefer Date
diff --git a/lisp/proced.el b/lisp/proced.el
index c6ce203..00fec38 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -32,12 +32,12 @@
;; - allow "sudo kill PID", "renice PID"
;;
;; Thoughts and Ideas
-;; - Currently, `system-process-attributes' returns the list of
+;; - Currently, `process-attributes' returns the list of
;; command-line arguments of a process as one concatenated string.
;; This format is compatible with `shell-command'. Also, under
;; MS-Windows, the command-line arguments are actually stored as a
;; single string, so that it is impossible to reverse-engineer it back
-;; into separate arguments. Alternatively, `system-process-attributes'
+;; into separate arguments. Alternatively, `process-attributes'
;; could (try to) return a list of strings that correspond to individual
;; command-line arguments. Then one could feed such a list of
;; command-line arguments into `call-process' or `start-process'.
@@ -94,7 +94,7 @@ the external command (usually \"kill\")."
;; It would be neat if one could temporarily override the following
;; predefined rules.
(defcustom proced-grammar-alist
- '( ;; attributes defined in `system-process-attributes'
+ '( ;; attributes defined in `process-attributes'
(euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil))
(user "USER" nil left proced-string-lessp nil (user pid) (nil t nil))
(egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil))
@@ -218,7 +218,7 @@ If REFINER is nil no refinement is done."
This variable extends the functionality of `proced-process-attributes'.
Each function is called with one argument, the list of attributes
of a system process. It returns a cons cell of the form (KEY . VALUE)
-like `system-process-attributes'. This cons cell is appended to the list
+like `process-attributes'. This cons cell is appended to the list
returned by `proced-process-attributes'.
If the function returns nil, the value is ignored."
:group 'proced
@@ -1530,7 +1530,7 @@ the process is ignored."
;; lists are ignored? When would such processes be of interest?
(let (process-alist attributes attr)
(dolist (pid (or pid-list (list-system-processes)) process-alist)
- (when (setq attributes (system-process-attributes pid))
+ (when (setq attributes (process-attributes pid))
(setq attributes (cons (cons 'pid pid) attributes))
(dolist (fun proced-custom-attributes)
(if (setq attr (funcall fun attributes))
diff --git a/lisp/server.el b/lisp/server.el
index 5f7cc50..d2262ac 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -588,7 +588,7 @@ Return values:
(insert-file-contents-literally (expand-file-name name server-auth-dir))
(or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
(assq 'comm
- (system-process-attributes
+ (process-attributes
(string-to-number (match-string 1))))
t)
:other))
diff --git a/src/ChangeLog b/src/ChangeLog
index b21fde0..4032baa 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,18 @@
+2009-02-03 Miles Bader <miles@gnu.org>
+
+ * process.c (process_pid): New function, code mostly from parse_signal.
+ (parse_signal): Use process_pid to do process-to-pid mapping.
+ (Fprocess_attributes): Renamed from "Fsystem_process_attributes".
+ Use process_pid to do process-to-pid mapping.
+ (syms_of_process): Update defsubr of Fprocess_attributes.
+
+ * process.h: Update decl of system_process_attributes.
+
+ * sysdep.c (system_process_attributes):
+ * dosfns.c (system_process_attributes):
+ * w32.c (system_process_attributes): Change argument type to pid_t.
+ Remove PID type-checking code.
+
2009-02-02 Andreas Schwab <schwab@suse.de>
* unexelf.c (unexec): Handle unaligned bss offset.
diff --git a/src/dosfns.c b/src/dosfns.c
index 12c260e..50cf50c 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -552,15 +552,11 @@ list_system_processes ()
}
Lisp_Object
-system_process_attributes (Lisp_Object pid)
+system_process_attributes (int pid)
{
- int proc_id;
Lisp_Object attrs = Qnil;
- CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
-
- if (proc_id == getpid ())
+ if (pid == getpid ())
{
EMACS_INT uid, gid;
char *usr;
diff --git a/src/process.c b/src/process.c
index 892a779..18b27ac 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6234,30 +6234,22 @@ traffic. */)
return process;
}
-DEFUN ("signal-process", Fsignal_process, Ssignal_process,
- 2, 2, "sProcess (name or number): \nnSignal code: ",
- doc: /* Send PROCESS the signal with code SIGCODE.
-PROCESS may also be a number specifying the process id of the
-process to signal; in this case, the process need not be a child of
-this Emacs.
-SIGCODE may be an integer, or a symbol whose name is a signal name. */)
- (process, sigcode)
- Lisp_Object process, sigcode;
+/* Return the system process-id associated with PROCESS. PROCESS may
+ either a number, in which case its value is returned directly, or an
+ emacs process. In the latter case, an error is signalled if the process
+ does not have an associated process id (e.g., a network socket),
+ using the message INVALID_PID_ERR_MSG. */
+
+static pid_t
+process_pid (Lisp_Object process, const char *invalid_pid_err_msg)
{
- pid_t pid;
-
if (INTEGERP (process))
- {
- pid = XINT (process);
- goto got_it;
- }
+ return XINT (process);
if (FLOATP (process))
- {
- pid = (pid_t) XFLOAT_DATA (process);
- goto got_it;
- }
+ return (pid_t) XFLOAT_DATA (process);
+ pid_t pid;
if (STRINGP (process))
{
Lisp_Object tem;
@@ -6272,15 +6264,27 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */)
else
process = get_process (process);
- if (NILP (process))
- return process;
-
CHECK_PROCESS (process);
pid = XPROCESS (process)->pid;
- if (pid <= 0)
- error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
got_it:
+ if (pid <= 0)
+ error (invalid_pid_err_msg, SDATA (XPROCESS (process)->name));
+
+ return pid;
+}
+
+DEFUN ("signal-process", Fsignal_process, Ssignal_process,
+ 2, 2, "sProcess (name or number): \nnSignal code: ",
+ doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be a number specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
+SIGCODE may be an integer, or a symbol whose name is a signal name. */)
+ (process, sigcode)
+ Lisp_Object process, sigcode;
+{
+ pid_t pid = process_pid (process, "Cannot signal process %s");
#define parse_signal(NAME, VALUE) \
else if (!xstrcasecmp (name, NAME)) \
@@ -7071,16 +7075,19 @@ DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
doc: /* Return a list of numerical process IDs of all running processes.
If this functionality is unsupported, return nil.
-See `system-process-attributes' for getting attributes of a process
+See `process-attributes' for getting attributes of a process
given its ID. */)
()
{
return list_system_processes ();
}
-DEFUN ("system-process-attributes", Fsystem_process_attributes,
- Ssystem_process_attributes, 1, 1, 0,
- doc: /* Return attributes of the process given by its PID, a number.
+DEFUN ("process-attributes", Fprocess_attributes,
+ Sprocess_attributes, 1, 1, 0,
+ doc: /* Return attributes of PROCESS.
+PROCESS may be an emacs subprocess, the name of an emacs subprocess, or an
+integer process-id; in the latter case, the process need not be a child of
+this Emacs.
Value is an alist where each element is a cons cell of the form
@@ -7129,10 +7136,11 @@ integer or floating point values.
pmem -- percents of total physical memory used by process's resident set
(floating-point number)
args -- command line which invoked the process (string). */)
- (pid)
+ (process)
- Lisp_Object pid;
+ Lisp_Object process;
{
+ pid_t pid = process_pid (process, "Cannot get status of process %s");
return system_process_attributes (pid);
}
\f
@@ -7507,7 +7515,7 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Sset_process_filter_multibyte);
defsubr (&Sprocess_filter_multibyte_p);
defsubr (&Slist_system_processes);
- defsubr (&Ssystem_process_attributes);
+ defsubr (&Sprocess_attributes);
}
\f
@@ -7813,9 +7821,12 @@ given its ID. */)
return list_system_processes ();
}
-DEFUN ("system-process-attributes", Fsystem_process_attributes,
- Ssystem_process_attributes, 1, 1, 0,
- doc: /* Return attributes of the process given by its PID, a number.
+DEFUN ("process-attributes", Fprocess_attributes,
+ Sprocess_attributes, 1, 1, 0,
+ doc: /* Return attributes of PROCESS.
+PROCESS may be an emacs subprocess, the name of an emacs subprocess, or an
+integer process-id; in the latter case, the process need not be a child of
+this Emacs.
Value is an alist where each element is a cons cell of the form
@@ -7864,10 +7875,11 @@ integer or floating point values.
pmem -- percents of total physical memory used by process's resident set
(floating-point number)
args -- command line which invoked the process (string). */)
- (pid)
+ (process)
- Lisp_Object pid;
+ Lisp_Object process;
{
+ pid_t pid = process_pid (pid, "Cannot get status of process %s");
return system_process_attributes (pid);
}
@@ -7953,7 +7965,7 @@ syms_of_process ()
defsubr (&Sget_buffer_process);
defsubr (&Sprocess_inherit_coding_system_flag);
defsubr (&Slist_system_processes);
- defsubr (&Ssystem_process_attributes);
+ defsubr (&Sprocess_attributes);
}
\f
diff --git a/src/process.h b/src/process.h
index 39c7f58..734fcee 100644
--- a/src/process.h
+++ b/src/process.h
@@ -168,7 +168,7 @@ extern Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtpgid, Qcstime;
extern Lisp_Object Qtime, Qctime;
extern Lisp_Object list_system_processes (void);
-extern Lisp_Object system_process_attributes (Lisp_Object);
+extern Lisp_Object system_process_attributes (pid_t);
/* arch-tag: dffedfc4-d7bc-4b58-a26f-c16155449c72
(do not change this comment) */
diff --git a/src/sysdep.c b/src/sysdep.c
index dfefed7..b0154e2 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -3360,7 +3360,7 @@ procfs_get_total_memory (void)
}
Lisp_Object
-system_process_attributes (Lisp_Object pid)
+system_process_attributes (pid_t pid)
{
char procfn[PATH_MAX], fn[PATH_MAX];
struct stat st;
@@ -3375,7 +3375,7 @@ system_process_attributes (Lisp_Object pid)
char *cmdline = NULL;
size_t cmdsize = 0, cmdline_size;
unsigned char c;
- int proc_id, ppid, uid, gid, pgrp, sess, tty, tpgid, thcount;
+ int ppid, uid, gid, pgrp, sess, tty, tpgid, thcount;
unsigned long long utime, stime, cutime, cstime, start;
long priority, nice, rss;
unsigned long minflt, majflt, cminflt, cmajflt, vsize;
@@ -3388,9 +3388,7 @@ system_process_attributes (Lisp_Object pid)
struct gcpro gcpro1, gcpro2;
EMACS_INT uid_eint, gid_eint;
- CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%lu", proc_id);
+ sprintf (procfn, "/proc/%lu", pid);
if (stat (procfn, &st) < 0)
return attrs;
@@ -3632,7 +3630,7 @@ system_process_attributes (Lisp_Object pid)
#endif /* PROCFS_FILE_OFFSET_BITS_HACK == 1 */
Lisp_Object
-system_process_attributes (Lisp_Object pid)
+system_process_attributes (pid_t pid)
{
char procfn[PATH_MAX], fn[PATH_MAX];
struct stat st;
@@ -3642,15 +3640,13 @@ system_process_attributes (Lisp_Object pid)
struct psinfo pinfo;
int fd;
ssize_t nread;
- int proc_id, uid, gid;
+ int uid, gid;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_cmd, tem;
struct gcpro gcpro1, gcpro2;
EMACS_INT uid_eint, gid_eint;
- CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
- sprintf (procfn, "/proc/%u", proc_id);
+ sprintf (procfn, "/proc/%u", pid);
if (stat (procfn, &st) < 0)
return attrs;
@@ -3764,7 +3760,7 @@ system_process_attributes (Lisp_Object pid)
#elif !defined (WINDOWSNT) && !defined (MSDOS)
Lisp_Object
-system_process_attributes (Lisp_Object pid)
+system_process_attributes (pid_t pid)
{
return Qnil;
}
diff --git a/src/w32.c b/src/w32.c
index 999541b..7a64b2d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -3819,8 +3819,7 @@ process_times (h_proc, ctime, etime, stime, utime, ttime, pcpu)
}
Lisp_Object
-system_process_attributes (pid)
- Lisp_Object pid;
+system_process_attributes (pid_t pid)
{
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object attrs = Qnil;
@@ -3850,8 +3849,7 @@ system_process_attributes (pid)
double pcpu;
BOOL result = FALSE;
- CHECK_NUMBER_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
+ proc_id = pid;
h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0);
[-- Attachment #3: Type: text/plain, Size: 40 bytes --]
--
We live, as we dream -- alone....
next reply other threads:[~2009-02-03 10:13 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2009-02-03 10:13 Miles Bader [this message]
2009-02-03 19:50 ` process-attributes patch Eli Zaretskii
2009-02-03 21:05 ` Stefan Monnier
2009-02-03 22:34 ` Miles Bader
2009-02-04 4:11 ` Eli Zaretskii
2009-02-04 6:39 ` Ulrich Mueller
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=buoskmvhlqr.fsf@dhlpc061.dev.necel.com \
--to=miles@gnu.org \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.