Mercurial > hg > xemacs-beta
annotate src/process.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| parents | c096d8051f89 |
| children | 8d29f1c4bb98 |
| rev | line source |
|---|---|
| 428 | 1 /* Asynchronous subprocess control for XEmacs. |
| 2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 | |
| 3 Free Software Foundation, Inc. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 5125 | 5 Copyright (C) 1995, 1996, 2001, 2002, 2004, 2005, 2010 Ben Wing. |
| 428 | 6 |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 814 | 24 /* This file has been Mule-ized. */ |
| 428 | 25 |
| 26 /* This file has been split into process.c and process-unix.c by | |
| 27 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not | |
| 814 | 28 the original author(s). |
| 29 | |
| 30 Non-synch-subprocess stuff (mostly process environment) moved from | |
| 853 | 31 callproc.c, 4-3-02, Ben Wing. |
| 32 | |
| 33 callproc.c deleted entirely 5-23-02, Ben Wing. Good riddance! | |
| 34 */ | |
| 428 | 35 |
| 36 #include <config.h> | |
| 37 | |
| 38 #include "lisp.h" | |
| 39 | |
| 40 #include "buffer.h" | |
| 41 #include "commands.h" | |
| 800 | 42 #include "device.h" |
| 428 | 43 #include "events.h" |
| 800 | 44 #include "file-coding.h" |
| 428 | 45 #include "frame.h" |
| 46 #include "hash.h" | |
| 47 #include "insdel.h" | |
| 48 #include "lstream.h" | |
| 49 #include "opaque.h" | |
| 50 #include "process.h" | |
| 51 #include "procimpl.h" | |
| 816 | 52 #include "sysdep.h" |
| 428 | 53 #include "window.h" |
| 54 | |
| 55 #include "sysfile.h" | |
| 56 #include "sysproc.h" | |
| 859 | 57 #include "syssignal.h" |
| 428 | 58 #include "systime.h" |
| 59 #include "systty.h" | |
| 60 #include "syswait.h" | |
| 61 | |
| 2367 | 62 #ifdef WIN32_NATIVE |
| 63 #include "syswindows.h" | |
| 64 #endif | |
| 65 | |
| 863 | 66 Lisp_Object Qprocessp, Qprocess_live_p, Qprocess_readable_p; |
| 428 | 67 |
| 68 /* Process methods */ | |
| 69 struct process_methods the_process_methods; | |
| 70 | |
| 71 /* a process object is a network connection when its pid field a cons | |
| 72 (name of name of port we are connected to . foreign host name) */ | |
| 73 | |
| 74 /* Valid values of process->status_symbol */ | |
| 75 Lisp_Object Qrun, Qstop; | |
| 76 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ | |
| 77 Lisp_Object Qopen, Qclosed; | |
| 78 /* Protocol families */ | |
| 79 Lisp_Object Qtcp, Qudp; | |
| 80 | |
| 81 #ifdef HAVE_MULTICAST | |
| 82 Lisp_Object Qmulticast; /* Will be used for occasional warnings */ | |
| 83 #endif | |
| 84 | |
| 85 /* t means use pty, nil means use a pipe, | |
| 86 maybe other values to come. */ | |
| 87 Lisp_Object Vprocess_connection_type; | |
| 88 | |
| 89 /* Read comments to DEFVAR of this */ | |
| 90 int windowed_process_io; | |
| 91 | |
| 92 #ifdef PROCESS_IO_BLOCKING | |
| 93 /* List of port numbers or port names to set a blocking I/O mode. | |
| 94 Nil means set a non-blocking I/O mode [default]. */ | |
| 95 Lisp_Object network_stream_blocking_port_list; | |
| 96 #endif /* PROCESS_IO_BLOCKING */ | |
| 97 | |
| 98 /* Number of events of change of status of a process. */ | |
| 99 volatile int process_tick; | |
| 100 | |
| 101 /* Number of events for which the user or sentinel has been notified. */ | |
| 102 static int update_tick; | |
| 103 | |
| 104 /* Nonzero means delete a process right away if it exits. */ | |
| 105 int delete_exited_processes; | |
| 106 | |
| 853 | 107 /* Hash table which maps USIDs as returned by create_io_streams_cb to |
| 428 | 108 process objects. Processes are not GC-protected through this! */ |
| 109 struct hash_table *usid_to_process; | |
| 110 | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
111 /* Read-only to Lisp. See DEFUN Fprocess_list. */ |
| 428 | 112 Lisp_Object Vprocess_list; |
| 113 | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
114 /* Lisp variables; see docstrings below. */ |
| 442 | 115 Lisp_Object Vnull_device; |
| 771 | 116 Lisp_Object Vdefault_process_coding_system; |
| 853 | 117 Lisp_Object Vdefault_network_coding_system; |
| 563 | 118 Lisp_Object Qprocess_error; |
| 119 Lisp_Object Qnetwork_error; | |
| 771 | 120 Fixnum debug_process_io; |
| 814 | 121 Lisp_Object Vshell_file_name; |
| 122 Lisp_Object Vprocess_environment; | |
| 123 | |
| 124 /* Make sure egetenv() not called too soon */ | |
| 125 int env_initted; | |
| 126 | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
127 /* Internal Lisp variable. */ |
| 814 | 128 Lisp_Object Vlisp_EXEC_SUFFIXES; |
| 129 | |
| 428 | 130 |
| 131 | |
| 1204 | 132 static const struct memory_description process_description [] = { |
| 133 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Process, x) }, | |
| 134 #include "process-slots.h" | |
| 934 | 135 { XD_END } |
| 136 }; | |
| 137 | |
| 428 | 138 static Lisp_Object |
| 444 | 139 mark_process (Lisp_Object object) |
| 428 | 140 { |
| 444 | 141 Lisp_Process *process = XPROCESS (object); |
| 1204 | 142 #define MARKED_SLOT(x) mark_object (process->x); |
| 143 #include "process-slots.h" | |
| 144 return Qnil; | |
| 428 | 145 } |
| 146 | |
| 147 static void | |
| 4846 | 148 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
| 428 | 149 { |
| 4846 | 150 Lisp_Process *process = XPROCESS (obj); |
| 428 | 151 |
| 152 if (print_readably) | |
|
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
153 printing_unreadable_lisp_object (obj, XSTRING_DATA (process->name)); |
| 428 | 154 |
| 155 if (!escapeflag) | |
| 156 { | |
| 444 | 157 print_internal (process->name, printcharfun, 0); |
| 428 | 158 } |
| 159 else | |
| 160 { | |
| 4846 | 161 int netp = network_connection_p (obj); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
162 write_ascstring (printcharfun, |
| 826 | 163 netp ? GETTEXT ("#<network connection ") : |
| 164 GETTEXT ("#<process ")); | |
| 444 | 165 print_internal (process->name, printcharfun, 1); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
166 write_ascstring (printcharfun, (netp ? " " : " pid ")); |
| 444 | 167 print_internal (process->pid, printcharfun, 1); |
| 800 | 168 write_fmt_string_lisp (printcharfun, " state:%S", 1, process->status_symbol); |
| 444 | 169 MAYBE_PROCMETH (print_process_data, (process, printcharfun)); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
170 write_ascstring (printcharfun, ">"); |
| 428 | 171 } |
| 172 } | |
|
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
173 /* Process plists are directly accessible, so we need to protect against |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
174 invalid property list structure */ |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
175 |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
176 static Lisp_Object |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
177 process_getprop (Lisp_Object process, Lisp_Object property) |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
178 { |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
179 return external_plist_get (&XPROCESS (process)->plist, property, 0, |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
180 ERROR_ME); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
181 } |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
182 |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
183 static int |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
184 process_putprop (Lisp_Object process, Lisp_Object property, Lisp_Object value) |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
185 { |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
186 external_plist_put (&XPROCESS (process)->plist, property, value, 0, |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
187 ERROR_ME); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
188 return 1; |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
189 } |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
190 |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
191 static int |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
192 process_remprop (Lisp_Object process, Lisp_Object property) |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
193 { |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
194 return external_remprop (&XPROCESS (process)->plist, property, 0, ERROR_ME); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
195 } |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
196 |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
197 static Lisp_Object |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
198 process_plist (Lisp_Object process) |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
199 { |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
200 return XPROCESS (process)->plist; |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
201 } |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
202 |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
203 static Lisp_Object |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
204 process_setplist (Lisp_Object process, Lisp_Object newplist) |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
205 { |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
206 XPROCESS (process)->plist = newplist; |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
207 return newplist; |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
208 } |
| 428 | 209 |
| 210 #ifdef HAVE_WINDOW_SYSTEM | |
| 440 | 211 extern void debug_process_finalization (Lisp_Process *p); |
| 428 | 212 #endif /* HAVE_WINDOW_SYSTEM */ |
| 213 | |
| 214 static void | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
215 finalize_process (Lisp_Object obj) |
| 428 | 216 { |
| 217 /* #### this probably needs to be tied into the tty event loop */ | |
| 218 /* #### when there is one */ | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
219 Lisp_Process *p = XPROCESS (obj); |
| 428 | 220 #ifdef HAVE_WINDOW_SYSTEM |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
221 debug_process_finalization (p); |
| 428 | 222 #endif /* HAVE_WINDOW_SYSTEM */ |
| 223 | |
| 224 if (p->process_data) | |
| 225 { | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
226 MAYBE_PROCMETH (finalize_process_data, (p)); |
| 5125 | 227 xfree (p->process_data); |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
228 p->process_data = 0; |
| 428 | 229 } |
| 230 } | |
| 231 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
232 DEFINE_NODUMP_LISP_OBJECT ("process", process, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
233 mark_process, print_process, finalize_process, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
234 0, 0, process_description, Lisp_Process); |
| 428 | 235 |
| 236 /************************************************************************/ | |
| 237 /* basic process accessors */ | |
| 238 /************************************************************************/ | |
| 239 | |
| 771 | 240 /* This function returns low-level streams, connected directly to the child |
| 241 process, rather than en/decoding streams */ | |
| 428 | 242 void |
| 853 | 243 get_process_streams (Lisp_Process *p, Lisp_Object *instr, Lisp_Object *outstr, |
| 244 Lisp_Object *errstr) | |
| 428 | 245 { |
| 246 assert (p); | |
| 853 | 247 assert (NILP (p->pipe_instream) || LSTREAMP (p->pipe_instream)); |
| 248 assert (NILP (p->pipe_outstream) || LSTREAMP (p->pipe_outstream)); | |
| 249 assert (NILP (p->pipe_errstream) || LSTREAMP (p->pipe_errstream)); | |
| 428 | 250 *instr = p->pipe_instream; |
| 251 *outstr = p->pipe_outstream; | |
| 853 | 252 *errstr = p->pipe_errstream; |
| 428 | 253 } |
| 254 | |
| 853 | 255 /* Given a USID referring to either a process's instream or errstream, |
| 256 return the associated process. */ | |
| 440 | 257 Lisp_Process * |
| 428 | 258 get_process_from_usid (USID usid) |
| 259 { | |
| 442 | 260 const void *vval; |
| 428 | 261 |
| 262 assert (usid != USID_ERROR && usid != USID_DONTHASH); | |
| 263 | |
| 442 | 264 if (gethash ((const void*)usid, usid_to_process, &vval)) |
| 428 | 265 { |
| 444 | 266 Lisp_Object process; |
| 5013 | 267 process = GET_LISP_FROM_VOID (vval); |
| 444 | 268 return XPROCESS (process); |
| 428 | 269 } |
| 270 else | |
| 271 return 0; | |
| 272 } | |
| 273 | |
| 274 int | |
| 853 | 275 get_process_selected_p (Lisp_Process *p, int do_err) |
| 428 | 276 { |
| 853 | 277 return do_err ? p->err_selected : p->in_selected; |
| 428 | 278 } |
| 279 | |
| 280 void | |
| 853 | 281 set_process_selected_p (Lisp_Process *p, int in_selected, int err_selected) |
| 428 | 282 { |
| 853 | 283 p->in_selected = !!in_selected; |
| 284 p->err_selected = !!err_selected; | |
| 428 | 285 } |
| 286 | |
| 287 int | |
| 440 | 288 connected_via_filedesc_p (Lisp_Process *p) |
| 428 | 289 { |
| 290 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); | |
| 291 } | |
| 292 | |
| 293 #ifdef HAVE_SOCKETS | |
| 294 int | |
| 295 network_connection_p (Lisp_Object process) | |
| 296 { | |
| 297 return CONSP (XPROCESS (process)->pid); | |
| 298 } | |
| 299 #endif | |
| 300 | |
| 301 DEFUN ("processp", Fprocessp, 1, 1, 0, /* | |
| 302 Return t if OBJECT is a process. | |
| 303 */ | |
| 444 | 304 (object)) |
| 428 | 305 { |
| 444 | 306 return PROCESSP (object) ? Qt : Qnil; |
| 428 | 307 } |
| 308 | |
| 440 | 309 DEFUN ("process-live-p", Fprocess_live_p, 1, 1, 0, /* |
| 310 Return t if OBJECT is a process that is alive. | |
| 311 */ | |
| 444 | 312 (object)) |
| 440 | 313 { |
| 444 | 314 return PROCESSP (object) && PROCESS_LIVE_P (XPROCESS (object)) |
| 315 ? Qt : Qnil; | |
| 440 | 316 } |
| 317 | |
| 863 | 318 #if 0 |
| 319 /* This is a reasonable definition for this new primitive. Kyle sez: | |
| 320 | |
| 321 "The patch looks OK to me except for the creation and exporting of the | |
| 322 Fprocess_readable_p function. I don't think a new Lisp function | |
| 323 should be created until we know something actually needs it. If | |
| 324 we later want to give process-readable-p different semantics it | |
| 325 may be hard to do it and stay compatible with what we hastily | |
| 326 create today." | |
| 327 | |
| 328 He's right, not yet. Let's discuss the semantics on XEmacs Design | |
| 329 before enabling this. | |
| 330 */ | |
| 331 DEFUN ("process-readable-p", Fprocess_readable_p, 1, 1, 0, /* | |
| 332 Return t if OBJECT is a process from which input may be available. | |
| 333 */ | |
| 334 (object)) | |
| 335 { | |
| 336 return PROCESSP (object) && PROCESS_READABLE_P (XPROCESS (object)) | |
| 337 ? Qt : Qnil; | |
| 338 } | |
| 339 #endif | |
| 340 | |
| 428 | 341 DEFUN ("process-list", Fprocess_list, 0, 0, 0, /* |
| 342 Return a list of all processes. | |
| 343 */ | |
| 344 ()) | |
| 345 { | |
| 346 return Fcopy_sequence (Vprocess_list); | |
| 347 } | |
| 348 | |
| 349 DEFUN ("get-process", Fget_process, 1, 1, 0, /* | |
| 444 | 350 Return the process named PROCESS-NAME (a string), or nil if there is none. |
| 351 PROCESS-NAME may also be a process; if so, the value is that process. | |
| 428 | 352 */ |
| 444 | 353 (process_name)) |
| 428 | 354 { |
| 444 | 355 if (PROCESSP (process_name)) |
| 356 return process_name; | |
| 428 | 357 |
| 358 if (!gc_in_progress) | |
| 359 /* this only gets called during GC when emacs is going away as a result | |
| 360 of a signal or crash. */ | |
| 444 | 361 CHECK_STRING (process_name); |
| 428 | 362 |
| 444 | 363 { |
| 364 LIST_LOOP_2 (process, Vprocess_list) | |
| 365 if (internal_equal (process_name, XPROCESS (process)->name, 0)) | |
| 366 return process; | |
| 367 } | |
| 428 | 368 return Qnil; |
| 369 } | |
| 370 | |
| 371 DEFUN ("get-buffer-process", Fget_buffer_process, 1, 1, 0, /* | |
| 372 Return the (or, a) process associated with BUFFER. | |
| 373 BUFFER may be a buffer or the name of one. | |
| 374 */ | |
| 444 | 375 (buffer)) |
| 428 | 376 { |
| 444 | 377 if (NILP (buffer)) return Qnil; |
| 378 buffer = Fget_buffer (buffer); | |
| 379 if (NILP (buffer)) return Qnil; | |
| 428 | 380 |
| 444 | 381 { |
| 382 LIST_LOOP_2 (process, Vprocess_list) | |
| 383 if (EQ (XPROCESS (process)->buffer, buffer)) | |
| 384 return process; | |
| 385 } | |
| 428 | 386 return Qnil; |
| 387 } | |
| 388 | |
| 389 /* This is how commands for the user decode process arguments. It | |
| 390 accepts a process, a process name, a buffer, a buffer name, or nil. | |
| 391 Buffers denote the first process in the buffer, and nil denotes the | |
| 392 current buffer. */ | |
| 393 | |
| 394 static Lisp_Object | |
| 395 get_process (Lisp_Object name) | |
| 396 { | |
| 444 | 397 Lisp_Object buffer; |
| 428 | 398 |
| 399 #ifdef I18N3 | |
| 400 /* #### Look more closely into translating process names. */ | |
| 401 #endif | |
| 402 | |
| 403 /* This may be called during a GC from process_send_signal() from | |
| 2500 | 404 kill_buffer_processes() if emacs decides to ABORT(). */ |
| 428 | 405 if (PROCESSP (name)) |
| 406 return name; | |
| 444 | 407 else if (STRINGP (name)) |
| 428 | 408 { |
| 444 | 409 Lisp_Object object = Fget_process (name); |
| 410 if (PROCESSP (object)) | |
| 411 return object; | |
| 412 | |
| 413 buffer = Fget_buffer (name); | |
| 414 if (BUFFERP (buffer)) | |
| 415 goto have_buffer_object; | |
| 416 | |
| 563 | 417 invalid_argument ("Process does not exist", name); |
| 428 | 418 } |
| 419 else if (NILP (name)) | |
| 444 | 420 { |
| 421 buffer = Fcurrent_buffer (); | |
| 422 goto have_buffer_object; | |
| 423 } | |
| 424 else if (BUFFERP (name)) | |
| 425 { | |
| 426 Lisp_Object process; | |
| 427 buffer = name; | |
| 428 | 428 |
| 444 | 429 have_buffer_object: |
| 430 process = Fget_buffer_process (buffer); | |
| 431 if (PROCESSP (process)) | |
| 432 return process; | |
| 433 | |
| 563 | 434 invalid_argument ("Buffer has no process", buffer); |
| 428 | 435 } |
| 436 else | |
| 444 | 437 return get_process (Fsignal (Qwrong_type_argument, |
| 771 | 438 (list2 (build_msg_string ("process or buffer or nil"), |
| 444 | 439 name)))); |
| 428 | 440 } |
| 441 | |
| 442 DEFUN ("process-id", Fprocess_id, 1, 1, 0, /* | |
| 443 Return the process id of PROCESS. | |
| 444 This is the pid of the Unix process which PROCESS uses or talks to. | |
| 445 For a network connection, this value is a cons of | |
| 446 (foreign-network-port . foreign-host-name). | |
| 447 */ | |
| 444 | 448 (process)) |
| 428 | 449 { |
| 450 Lisp_Object pid; | |
| 444 | 451 CHECK_PROCESS (process); |
| 428 | 452 |
| 444 | 453 pid = XPROCESS (process)->pid; |
| 454 if (network_connection_p (process)) | |
| 428 | 455 /* return Qnil; */ |
| 456 return Fcons (Fcar (pid), Fcdr (pid)); | |
| 457 else | |
| 458 return pid; | |
| 459 } | |
| 460 | |
| 461 DEFUN ("process-name", Fprocess_name, 1, 1, 0, /* | |
| 462 Return the name of PROCESS, as a string. | |
| 463 This is the name of the program invoked in PROCESS, | |
| 464 possibly modified to make it unique among process names. | |
| 465 */ | |
| 444 | 466 (process)) |
| 428 | 467 { |
| 444 | 468 CHECK_PROCESS (process); |
| 469 return XPROCESS (process)->name; | |
| 428 | 470 } |
| 471 | |
| 472 DEFUN ("process-command", Fprocess_command, 1, 1, 0, /* | |
| 473 Return the command that was executed to start PROCESS. | |
| 474 This is a list of strings, the first string being the program executed | |
| 475 and the rest of the strings being the arguments given to it. | |
| 476 */ | |
| 444 | 477 (process)) |
| 428 | 478 { |
| 444 | 479 CHECK_PROCESS (process); |
| 480 return XPROCESS (process)->command; | |
| 428 | 481 } |
| 482 | |
| 483 | |
| 484 /************************************************************************/ | |
| 485 /* creating a process */ | |
| 486 /************************************************************************/ | |
| 487 | |
| 563 | 488 DOESNT_RETURN |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
489 report_process_error (const Ascbyte *reason, Lisp_Object data) |
| 563 | 490 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
491 report_error_with_errno (Qprocess_error, reason, data); |
| 563 | 492 } |
| 493 | |
| 494 DOESNT_RETURN | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
495 report_network_error (const Ascbyte *reason, Lisp_Object data) |
| 563 | 496 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
497 report_error_with_errno (Qnetwork_error, reason, data); |
| 563 | 498 } |
| 499 | |
| 428 | 500 Lisp_Object |
| 501 make_process_internal (Lisp_Object name) | |
| 502 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
503 Lisp_Object name1; |
| 428 | 504 int i; |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
505 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (process); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
506 Lisp_Process *p = XPROCESS (obj); |
| 428 | 507 |
| 1204 | 508 #define MARKED_SLOT(x) p->x = Qnil; |
| 509 #include "process-slots.h" | |
| 510 | |
| 428 | 511 /* If name is already in use, modify it until it is unused. */ |
| 512 name1 = name; | |
| 513 for (i = 1; ; i++) | |
| 514 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
515 Ascbyte suffix[10]; |
| 428 | 516 Lisp_Object tem = Fget_process (name1); |
| 517 if (NILP (tem)) | |
| 518 break; | |
| 519 sprintf (suffix, "<%d>", i); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
520 name1 = concat2 (name, build_ascstring (suffix)); |
| 428 | 521 } |
| 522 name = name1; | |
| 523 p->name = name; | |
| 524 | |
| 525 p->mark = Fmake_marker (); | |
| 853 | 526 p->stderr_mark = Fmake_marker (); |
| 428 | 527 p->status_symbol = Qrun; |
| 528 | |
| 529 MAYBE_PROCMETH (alloc_process_data, (p)); | |
| 530 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
531 Vprocess_list = Fcons (obj, Vprocess_list); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
532 return obj; |
| 428 | 533 } |
| 534 | |
| 535 void | |
| 853 | 536 init_process_io_handles (Lisp_Process *p, void* in, void* out, void* err, |
| 537 int flags) | |
| 428 | 538 { |
| 853 | 539 USID in_usid, err_usid; |
| 771 | 540 Lisp_Object incode, outcode; |
| 541 | |
| 853 | 542 if (flags & STREAM_NETWORK_CONNECTION) |
| 543 { | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
544 if (!LISTP (Vdefault_network_coding_system) || |
| 853 | 545 NILP (incode = (find_coding_system_for_text_file |
| 546 (Fcar (Vdefault_network_coding_system), 1))) || | |
| 547 NILP (outcode = (find_coding_system_for_text_file | |
| 548 (Fcdr (Vdefault_network_coding_system), 0)))) | |
| 549 signal_error (Qinvalid_state, | |
| 550 "Bogus value for `default-network-coding-system'", | |
| 551 Vdefault_network_coding_system); | |
| 552 } | |
| 553 else | |
| 554 { | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
555 if (!LISTP (Vdefault_process_coding_system) || |
| 853 | 556 NILP (incode = (find_coding_system_for_text_file |
| 557 (Fcar (Vdefault_process_coding_system), 1))) || | |
| 558 NILP (outcode = (find_coding_system_for_text_file | |
| 559 (Fcdr (Vdefault_process_coding_system), 0)))) | |
| 560 signal_error (Qinvalid_state, | |
| 561 "Bogus value for `default-process-coding-system'", | |
| 562 Vdefault_process_coding_system); | |
| 563 } | |
| 771 | 564 |
| 784 | 565 if (!NILP (Vcoding_system_for_read) && |
| 566 NILP (incode = (find_coding_system_for_text_file | |
| 567 (Vcoding_system_for_read, 1)))) | |
| 568 signal_error (Qinvalid_state, | |
| 569 "Bogus value for `coding-system-for-read'", | |
| 570 Vcoding_system_for_read); | |
| 571 | |
| 572 if (!NILP (Vcoding_system_for_write) && | |
| 573 NILP (outcode = (find_coding_system_for_text_file | |
| 574 (Vcoding_system_for_write, 0)))) | |
| 575 signal_error (Qinvalid_state, | |
| 576 "Bogus value for `coding-system-for-write'", | |
| 577 Vcoding_system_for_write); | |
| 578 | |
| 853 | 579 event_stream_create_io_streams (in, out, err, |
| 580 &p->pipe_instream, | |
| 581 &p->pipe_outstream, | |
| 582 &p->pipe_errstream, | |
| 583 &in_usid, &err_usid, | |
| 584 flags); | |
| 428 | 585 |
| 853 | 586 if (in_usid == USID_ERROR || err_usid == USID_ERROR) |
| 563 | 587 signal_error (Qprocess_error, "Setting up communication with subprocess", |
| 853 | 588 wrap_process (p)); |
| 428 | 589 |
| 853 | 590 if (in_usid != USID_DONTHASH) |
| 428 | 591 { |
| 444 | 592 Lisp_Object process = Qnil; |
| 793 | 593 process = wrap_process (p); |
| 5013 | 594 puthash ((const void*) in_usid, STORE_LISP_IN_VOID (process), usid_to_process); |
| 428 | 595 } |
| 596 | |
| 853 | 597 if (err_usid != USID_DONTHASH) |
| 598 { | |
| 599 Lisp_Object process = Qnil; | |
| 600 process = wrap_process (p); | |
| 5013 | 601 puthash ((const void*) err_usid, STORE_LISP_IN_VOID (process), |
| 853 | 602 usid_to_process); |
| 603 } | |
| 604 | |
| 605 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, err, flags)); | |
| 428 | 606 |
| 771 | 607 p->coding_instream = |
| 800 | 608 make_coding_input_stream (XLSTREAM (p->pipe_instream), incode, |
| 609 CODING_DECODE, 0); | |
| 853 | 610 if (!NILP (p->pipe_errstream)) |
| 611 p->coding_errstream = | |
| 612 make_coding_input_stream | |
| 613 (XLSTREAM (p->pipe_errstream), incode, CODING_DECODE, 0); | |
| 771 | 614 p->coding_outstream = |
| 800 | 615 make_coding_output_stream (XLSTREAM (p->pipe_outstream), outcode, |
| 616 CODING_ENCODE, 0); | |
| 428 | 617 } |
| 618 | |
| 619 static void | |
| 620 create_process (Lisp_Object process, Lisp_Object *argv, int nargv, | |
| 853 | 621 Lisp_Object program, Lisp_Object cur_dir, |
| 622 int separate_err) | |
| 428 | 623 { |
| 440 | 624 Lisp_Process *p = XPROCESS (process); |
| 428 | 625 int pid; |
| 626 | |
| 627 /* *_create_process may change status_symbol, if the process | |
| 628 is a kind of "fire-and-forget" (no I/O, unwaitable) */ | |
| 629 p->status_symbol = Qrun; | |
| 630 p->exit_code = 0; | |
| 631 | |
| 853 | 632 pid = PROCMETH (create_process, (p, argv, nargv, program, cur_dir, |
| 633 separate_err)); | |
| 428 | 634 |
| 635 p->pid = make_int (pid); | |
| 863 | 636 if (PROCESS_READABLE_P (p)) |
| 853 | 637 event_stream_select_process (p, 1, 1); |
| 428 | 638 } |
| 639 | |
| 640 /* This function is the unwind_protect form for Fstart_process_internal. If | |
| 444 | 641 PROCESS doesn't have its pid set, then we know someone has signalled |
| 428 | 642 an error and the process wasn't started successfully, so we should |
| 643 remove it from the process list. */ | |
| 444 | 644 static void remove_process (Lisp_Object process); |
| 428 | 645 static Lisp_Object |
| 444 | 646 start_process_unwind (Lisp_Object process) |
| 428 | 647 { |
| 444 | 648 /* Was PROCESS started successfully? */ |
| 649 if (EQ (XPROCESS (process)->pid, Qnil)) | |
| 650 remove_process (process); | |
| 428 | 651 return Qnil; |
| 652 } | |
| 653 | |
| 654 DEFUN ("start-process-internal", Fstart_process_internal, 3, MANY, 0, /* | |
| 853 | 655 Internal function to start a program in a subprocess. |
| 656 Lisp callers should use `start-process' instead. | |
| 657 | |
| 658 Returns the process object for it. | |
| 428 | 659 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS |
| 660 NAME is name for process. It is modified if necessary to make it unique. | |
| 661 BUFFER is the buffer or (buffer-name) to associate with the process. | |
| 662 Process output goes at end of that buffer, unless you specify | |
| 663 an output stream or filter function to handle the output. | |
| 664 BUFFER may be also nil, meaning that this process is not associated | |
| 853 | 665 with any buffer. |
| 666 BUFFER can also have the form (REAL-BUFFER STDERR-BUFFER); in that case, | |
| 667 REAL-BUFFER says what to do with standard output, as above, | |
| 668 while STDERR-BUFFER says what to do with standard error in the child. | |
| 669 STDERR-BUFFER may be nil (discard standard error output, unless a stderr | |
| 670 filter is set). Note that if you do not use this form at process creation, | |
| 671 stdout and stderr will be mixed in the output buffer, and this cannot be | |
| 672 changed, even by setting a stderr filter. | |
| 428 | 673 Third arg is program file name. It is searched for as in the shell. |
| 674 Remaining arguments are strings to give program as arguments. | |
| 853 | 675 |
| 676 Read and write coding systems for the process are determined from | |
| 677 `coding-system-for-read' and `coding-system-for-write' (intended as | |
| 678 overriding coding systems to be *bound* by Lisp code, not set), or | |
| 679 from `default-process-coding-system' if either or both are nil. You can | |
| 680 change the coding systems later on using `set-process-coding-system', | |
| 681 `set-process-input-coding-system', or `set-process-output-coding-system'. | |
| 682 | |
| 683 See also `set-process-filter' and `set-process-stderr-filter'. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
684 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3025
diff
changeset
|
685 arguments: (NAME BUFFER PROGRAM &rest PROGRAM-ARGS) |
| 428 | 686 */ |
| 687 (int nargs, Lisp_Object *args)) | |
| 688 { | |
| 689 /* This function can call lisp */ | |
| 853 | 690 Lisp_Object buffer, stderr_buffer, name, program, process, current_dir; |
| 691 int separate_stderr; | |
| 428 | 692 Lisp_Object tem; |
| 910 | 693 int i; |
| 428 | 694 int speccount = specpdl_depth (); |
| 695 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 696 | |
| 697 name = args[0]; | |
| 698 buffer = args[1]; | |
| 699 program = args[2]; | |
| 700 current_dir = Qnil; | |
| 701 | |
| 702 /* Protect against various file handlers doing GCs below. */ | |
| 703 GCPRO3 (buffer, program, current_dir); | |
| 704 | |
| 853 | 705 if (CONSP (buffer)) |
| 706 { | |
| 707 if (!CONSP (XCDR (buffer))) | |
| 708 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
| 709 buffer); | |
| 710 if (!NILP (XCDR (XCDR (buffer)))) | |
| 711 invalid_argument ("Invalid BUFFER argument to `start-process'", | |
| 712 buffer); | |
| 713 stderr_buffer = XCAR (XCDR (buffer)); | |
| 714 buffer = XCAR (buffer); | |
| 715 separate_stderr = 1; | |
| 716 } | |
| 717 else | |
| 718 { | |
| 719 stderr_buffer = Qnil; | |
| 720 separate_stderr = 0; | |
| 721 } | |
| 722 | |
| 428 | 723 if (!NILP (buffer)) |
| 724 buffer = Fget_buffer_create (buffer); | |
| 853 | 725 if (!NILP (stderr_buffer)) |
| 726 stderr_buffer = Fget_buffer_create (stderr_buffer); | |
| 428 | 727 |
| 728 CHECK_STRING (name); | |
| 729 CHECK_STRING (program); | |
| 910 | 730 for (i = 3; i < nargs; ++i) |
| 731 CHECK_STRING (args[i]); | |
| 428 | 732 |
| 733 /* Make sure that the child will be able to chdir to the current | |
| 502 | 734 buffer's current directory, or its unhandled equivalent. [[ We |
| 428 | 735 can't just have the child check for an error when it does the |
| 502 | 736 chdir, since it's in a vfork. ]] -- not any more, we don't use |
| 737 vfork. -ben | |
| 428 | 738 |
| 502 | 739 Note: These calls are spread out to insure that the return values |
| 740 of the calls (which may be newly-created strings) are properly | |
| 741 GC-protected. */ | |
| 428 | 742 current_dir = current_buffer->directory; |
| 502 | 743 /* If the current dir has no terminating slash, we'll get undesirable |
| 744 results, so put the slash back. */ | |
| 745 current_dir = Ffile_name_as_directory (current_dir); | |
| 428 | 746 current_dir = Funhandled_file_name_directory (current_dir); |
| 747 current_dir = expand_and_dir_to_file (current_dir, Qnil); | |
| 748 | |
| 749 #if 0 /* This loser breaks ange-ftp */ | |
| 750 /* dmoore - if you re-enable this code, you have to gcprotect | |
| 751 current_buffer through the above calls. */ | |
| 752 if (NILP (Ffile_accessible_directory_p (current_dir))) | |
| 563 | 753 signal_error (Qprocess_error, "Setting current directory", |
| 754 current_buffer->directory); | |
| 428 | 755 #endif /* 0 */ |
| 756 | |
| 757 /* If program file name is not absolute, search our path for it */ | |
| 826 | 758 if (!IS_DIRECTORY_SEP (string_byte (program, 0)) |
| 428 | 759 && !(XSTRING_LENGTH (program) > 1 |
| 826 | 760 && IS_DEVICE_SEP (string_byte (program, 1)))) |
| 428 | 761 { |
| 762 struct gcpro ngcpro1; | |
| 763 | |
| 764 tem = Qnil; | |
| 765 NGCPRO1 (tem); | |
| 766 locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &tem, X_OK); | |
| 767 if (NILP (tem)) | |
| 563 | 768 signal_error (Qprocess_error, "Searching for program", program); |
| 428 | 769 program = Fexpand_file_name (tem, Qnil); |
| 770 NUNGCPRO; | |
| 771 } | |
| 772 else | |
| 773 { | |
| 442 | 774 /* we still need to canonicalize it and ensure it has the proper |
| 775 ending, e.g. .exe */ | |
| 776 struct gcpro ngcpro1; | |
| 777 | |
| 778 tem = Qnil; | |
| 779 NGCPRO1 (tem); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
780 locate_file (list1 (build_ascstring ("")), program, Vlisp_EXEC_SUFFIXES, |
| 442 | 781 &tem, X_OK); |
| 782 if (NILP (tem)) | |
| 563 | 783 signal_error (Qprocess_error, "Searching for program", program); |
| 442 | 784 program = tem; |
| 785 NUNGCPRO; | |
| 428 | 786 } |
| 787 | |
| 442 | 788 if (!NILP (Ffile_directory_p (program))) |
| 789 invalid_operation ("Specified program for new process is a directory", | |
| 790 program); | |
| 791 | |
| 444 | 792 process = make_process_internal (name); |
| 428 | 793 |
| 444 | 794 XPROCESS (process)->buffer = buffer; |
| 853 | 795 XPROCESS (process)->stderr_buffer = stderr_buffer; |
| 796 XPROCESS (process)->separate_stderr = separate_stderr; | |
| 814 | 797 XPROCESS (process)->command = Flist (nargs - 2, args + 2); |
| 428 | 798 |
| 799 /* Make the process marker point into the process buffer (if any). */ | |
| 800 if (!NILP (buffer)) | |
| 444 | 801 Fset_marker (XPROCESS (process)->mark, |
| 428 | 802 make_int (BUF_ZV (XBUFFER (buffer))), buffer); |
| 853 | 803 if (!NILP (stderr_buffer)) |
| 804 Fset_marker (XPROCESS (process)->stderr_mark, | |
| 805 make_int (BUF_ZV (XBUFFER (stderr_buffer))), stderr_buffer); | |
| 428 | 806 |
| 807 /* If an error occurs and we can't start the process, we want to | |
| 808 remove it from the process list. This means that each error | |
| 809 check in create_process doesn't need to call remove_process | |
| 810 itself; it's all taken care of here. */ | |
| 444 | 811 record_unwind_protect (start_process_unwind, process); |
| 428 | 812 |
| 853 | 813 create_process (process, args + 3, nargs - 3, program, current_dir, |
| 814 separate_stderr); | |
| 428 | 815 |
| 816 UNGCPRO; | |
| 771 | 817 return unbind_to_1 (speccount, process); |
| 428 | 818 } |
| 819 | |
| 820 | |
| 821 #ifdef HAVE_SOCKETS | |
| 822 | |
| 823 | |
| 824 /* #### The network support is fairly synthetical. What we actually | |
| 825 need is a single function, which supports all datagram, stream and | |
| 826 packet stream connections, arbitrary protocol families should they | |
| 827 be supported by the target system, multicast groups, in both data | |
| 828 and control rooted/nonrooted flavors, service quality etc whatever | |
| 829 is supported by the underlying network. | |
| 830 | |
| 831 It must accept a property list describing the connection. The current | |
| 832 functions must then go to lisp and provide a suitable list for the | |
| 833 generalized connection function. | |
| 834 | |
| 835 Both UNIX and Win32 support BSD sockets, and there are many extensions | |
| 836 available (Sockets 2 spec). | |
| 837 | |
| 838 A todo is define a consistent set of properties abstracting a | |
| 839 network connection. -kkm | |
| 840 */ | |
| 841 | |
| 842 | |
| 843 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
| 844 exactly like a normal process when reading and writing. Only | |
| 845 differences are in status display and process deletion. A network | |
| 846 connection has no PID; you cannot signal it. All you can do is | |
| 847 deactivate and close it via delete-process */ | |
| 848 | |
| 442 | 849 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, |
| 850 0, /* | |
| 428 | 851 Open a TCP connection for a service to a host. |
| 444 | 852 Return a process object to represent the connection. |
| 428 | 853 Input and output work as for subprocesses; `delete-process' closes it. |
| 854 | |
| 855 NAME is name for process. It is modified if necessary to make it unique. | |
| 856 BUFFER is the buffer (or buffer-name) to associate with the process. | |
| 857 Process output goes at end of that buffer, unless you specify | |
| 858 an output stream or filter function to handle the output. | |
| 859 BUFFER may also be nil, meaning that this process is not associated | |
| 860 with any buffer. | |
| 444 | 861 Third arg HOST (a string) is the name of the host to connect to, |
| 862 or its IP address. | |
| 863 Fourth arg SERVICE is the name of the service desired (a string), | |
| 864 or an integer specifying a port number to connect to. | |
| 3025 | 865 Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp' |
| 866 (Transmission Control Protocol) and `udp' (User Datagram Protocol) are | |
| 867 supported. When omitted, `tcp' is assumed. | |
| 428 | 868 |
| 442 | 869 Output via `process-send-string' and input via buffer or filter (see |
| 428 | 870 `set-process-filter') are stream-oriented. That means UDP datagrams are |
| 871 not guaranteed to be sent and received in discrete packets. (But small | |
| 872 datagrams around 500 bytes that are not truncated by `process-send-string' | |
| 444 | 873 are usually fine.) Note further that the UDP protocol does not guard |
| 874 against lost packets. | |
| 428 | 875 */ |
| 876 (name, buffer, host, service, protocol)) | |
| 877 { | |
| 878 /* This function can GC */ | |
| 444 | 879 Lisp_Object process = Qnil; |
| 428 | 880 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; |
| 881 void *inch, *outch; | |
| 882 | |
| 883 GCPRO5 (name, buffer, host, service, protocol); | |
| 884 CHECK_STRING (name); | |
| 885 | |
| 771 | 886 if (NILP (protocol)) |
| 428 | 887 protocol = Qtcp; |
| 888 else | |
| 889 CHECK_SYMBOL (protocol); | |
| 890 | |
| 891 /* Since this code is inside HAVE_SOCKETS, existence of | |
| 892 open_network_stream is mandatory */ | |
| 893 PROCMETH (open_network_stream, (name, host, service, protocol, | |
| 894 &inch, &outch)); | |
| 895 | |
| 896 if (!NILP (buffer)) | |
| 897 buffer = Fget_buffer_create (buffer); | |
| 444 | 898 process = make_process_internal (name); |
| 899 NGCPRO1 (process); | |
| 428 | 900 |
| 444 | 901 XPROCESS (process)->pid = Fcons (service, host); |
| 902 XPROCESS (process)->buffer = buffer; | |
| 771 | 903 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
| 853 | 904 (void *) -1, |
| 428 | 905 STREAM_NETWORK_CONNECTION); |
| 906 | |
| 853 | 907 event_stream_select_process (XPROCESS (process), 1, 1); |
| 428 | 908 |
| 1204 | 909 NUNGCPRO; |
| 428 | 910 UNGCPRO; |
| 444 | 911 return process; |
| 428 | 912 } |
| 913 | |
| 914 #ifdef HAVE_MULTICAST | |
| 915 | |
| 916 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* | |
| 917 Open a multicast connection on the specified dest/port/ttl. | |
| 444 | 918 Return a process object to represent the connection. |
| 428 | 919 Input and output work as for subprocesses; `delete-process' closes it. |
| 920 | |
| 921 NAME is name for process. It is modified if necessary to make it unique. | |
| 922 BUFFER is the buffer (or buffer-name) to associate with the process. | |
| 923 Process output goes at end of that buffer, unless you specify | |
| 924 an output stream or filter function to handle the output. | |
| 925 BUFFER may also be nil, meaning that this process is not associated | |
| 926 with any buffer. | |
| 927 Third, fourth and fifth args are the multicast destination group, port and ttl. | |
| 928 dest must be an internet address between 224.0.0.0 and 239.255.255.255 | |
| 929 port is a communication port like in traditional unicast | |
| 930 ttl is the time-to-live (15 for site, 63 for region and 127 for world) | |
| 931 */ | |
| 932 (name, buffer, dest, port, ttl)) | |
| 933 { | |
| 934 /* This function can GC */ | |
| 444 | 935 Lisp_Object process = Qnil; |
| 428 | 936 struct gcpro gcpro1; |
| 937 void *inch, *outch; | |
| 938 | |
| 939 CHECK_STRING (name); | |
| 940 | |
| 941 /* Since this code is inside HAVE_MULTICAST, existence of | |
| 771 | 942 open_multicast_group is mandatory */ |
| 428 | 943 PROCMETH (open_multicast_group, (name, dest, port, ttl, |
| 944 &inch, &outch)); | |
| 945 | |
| 946 if (!NILP (buffer)) | |
| 947 buffer = Fget_buffer_create (buffer); | |
| 948 | |
| 444 | 949 process = make_process_internal (name); |
| 950 GCPRO1 (process); | |
| 428 | 951 |
| 444 | 952 XPROCESS (process)->pid = Fcons (port, dest); |
| 953 XPROCESS (process)->buffer = buffer; | |
| 853 | 954 init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, |
| 955 (void *) -1, | |
| 428 | 956 STREAM_NETWORK_CONNECTION); |
| 957 | |
| 853 | 958 event_stream_select_process (XPROCESS (process), 1, 1); |
| 428 | 959 |
| 960 UNGCPRO; | |
| 444 | 961 return process; |
| 428 | 962 } |
| 963 #endif /* HAVE_MULTICAST */ | |
| 964 | |
| 965 #endif /* HAVE_SOCKETS */ | |
| 966 | |
| 967 Lisp_Object | |
| 968 canonicalize_host_name (Lisp_Object host) | |
| 969 { | |
| 970 return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); | |
| 971 } | |
| 972 | |
| 973 | |
| 974 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* | |
| 975 Tell PROCESS that it has logical window size HEIGHT and WIDTH. | |
| 976 */ | |
| 444 | 977 (process, height, width)) |
| 428 | 978 { |
| 444 | 979 CHECK_PROCESS (process); |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
980 check_integer_range (height, Qzero, make_integer (EMACS_INT_MAX)); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5255
diff
changeset
|
981 check_integer_range (width, Qzero, make_integer (EMACS_INT_MAX)); |
| 428 | 982 return |
| 444 | 983 MAYBE_INT_PROCMETH (set_window_size, |
| 984 (XPROCESS (process), XINT (height), XINT (width))) <= 0 | |
| 428 | 985 ? Qnil : Qt; |
| 986 } | |
| 987 | |
| 988 | |
| 989 /************************************************************************/ | |
| 990 /* Process I/O */ | |
| 991 /************************************************************************/ | |
| 992 | |
| 844 | 993 /* Set up PROCESS's buffer for insertion of process data at PROCESS's |
| 994 mark. | |
| 995 | |
| 996 Sets the current buffer to PROCESS's buffer, inhibits read only, | |
| 997 remembers current point, sets point to PROCESS'S mark, widens if | |
| 998 necessary. | |
| 999 */ | |
| 1000 static int | |
| 853 | 1001 process_setup_for_insertion (Lisp_Object process, int read_stderr) |
| 844 | 1002 { |
| 1003 Lisp_Process *p = XPROCESS (process); | |
| 1004 int spec = specpdl_depth (); | |
| 853 | 1005 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; |
| 1006 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
| 1007 struct buffer *buf = XBUFFER (buffer); | |
| 844 | 1008 Charbpos output_pt; |
| 1009 | |
| 1010 if (buf != current_buffer) | |
| 1011 { | |
| 1012 record_unwind_protect (save_current_buffer_restore, | |
| 1013 Fcurrent_buffer ()); | |
| 1014 set_buffer_internal (buf); | |
| 1015 } | |
| 1016 | |
| 1017 record_unwind_protect (save_excursion_restore, save_excursion_save ()); | |
| 1018 specbind (Qinhibit_read_only, Qt); | |
| 854 | 1019 |
| 844 | 1020 /* Insert new output into buffer |
| 1021 at the current end-of-output marker, | |
| 1022 thus preserving logical ordering of input and output. */ | |
| 853 | 1023 if (XMARKER (mark)->buffer) |
| 1024 output_pt = marker_position (mark); | |
| 844 | 1025 else |
| 1026 output_pt = BUF_ZV (buf); | |
| 1027 | |
| 1028 /* If the output marker is outside of the visible region, save | |
| 1029 the restriction and widen. */ | |
| 1030 if (! (BUF_BEGV (buf) <= output_pt && output_pt <= BUF_ZV (buf))) | |
| 1031 { | |
| 1032 record_unwind_protect (save_restriction_restore, | |
| 1033 save_restriction_save (buf)); | |
| 1034 Fwiden (wrap_buffer (buf)); | |
| 1035 } | |
| 1036 | |
| 1037 BUF_SET_PT (buf, output_pt); | |
| 1038 return spec; | |
| 1039 } | |
| 1040 | |
| 428 | 1041 /* Read pending output from the process channel, |
| 1042 starting with our buffered-ahead character if we have one. | |
| 1043 Yield number of characters read. | |
| 1044 | |
| 1045 This function reads at most 1024 bytes. | |
| 1046 If you want to read all available subprocess output, | |
| 1047 you must call it repeatedly until it returns zero. */ | |
| 1048 | |
| 1049 Charcount | |
| 853 | 1050 read_process_output (Lisp_Object process, int read_stderr) |
| 428 | 1051 { |
| 1052 /* This function can GC */ | |
| 1053 Bytecount nbytes, nchars; | |
| 867 | 1054 Ibyte chars[1025]; |
| 428 | 1055 Lisp_Object outstream; |
| 444 | 1056 Lisp_Process *p = XPROCESS (process); |
| 853 | 1057 Lisp_Object filter = read_stderr ? p->stderr_filter : p->filter; |
| 1058 Lisp_Object buffer = read_stderr ? p->stderr_buffer : p->buffer; | |
| 1059 Lisp_Object mark = read_stderr ? p->stderr_mark : p->mark; | |
| 428 | 1060 |
| 1061 /* If there is a lot of output from the subprocess, the loop in | |
| 1062 execute_internal_event() might call read_process_output() more | |
| 1063 than once. If the filter that was executed from one of these | |
| 1064 calls set the filter to t, we have to stop now. Return -1 rather | |
| 1065 than 0 so execute_internal_event() doesn't close the process. | |
| 1066 Really, the loop in execute_internal_event() should check itself | |
| 1067 for a process-filter change, like in status_notify(); but the | |
| 1068 struct Lisp_Process is not exported outside of this file. */ | |
| 863 | 1069 if (!PROCESS_READABLE_P (p)) |
| 853 | 1070 { |
| 1071 errno = 0; | |
| 1072 return -1; /* already closed */ | |
| 1073 } | |
| 428 | 1074 |
| 853 | 1075 if (!NILP (filter) && (p->filter_does_read)) |
| 428 | 1076 { |
| 1077 Lisp_Object filter_result; | |
| 1078 | |
| 1079 /* Some weird FSFmacs crap here with | |
| 853 | 1080 Vdeactivate_mark and current_buffer->keymap. |
| 1081 Some FSF junk with running_asynch_code, to preserve the match | |
| 1082 data. Not necessary because we don't call process filters | |
| 1083 asynchronously (i.e. from within QUIT). */ | |
| 1084 /* Don't catch errors here; we're not in any critical code. */ | |
| 1085 filter_result = call2 (filter, process, Qnil); | |
| 428 | 1086 CHECK_INT (filter_result); |
| 1087 return XINT (filter_result); | |
| 1088 } | |
| 1089 | |
| 853 | 1090 nbytes = Lstream_read (read_stderr ? XLSTREAM (DATA_ERRSTREAM (p)) : |
| 1091 XLSTREAM (DATA_INSTREAM (p)), chars, | |
| 771 | 1092 sizeof (chars) - 1); |
| 428 | 1093 if (nbytes <= 0) return nbytes; |
| 1094 | |
| 771 | 1095 if (debug_process_io) |
| 1096 { | |
| 1097 chars[nbytes] = '\0'; | |
| 1098 stderr_out ("Read: %s\n", chars); | |
| 1099 } | |
| 1100 | |
| 1101 /* !!#### if the coding system changed as a result of reading, we | |
| 1102 need to change the output coding system accordingly. */ | |
| 428 | 1103 nchars = bytecount_to_charcount (chars, nbytes); |
| 853 | 1104 outstream = filter; |
| 428 | 1105 if (!NILP (outstream)) |
| 1106 { | |
| 853 | 1107 /* Some FSF junk with running_asynch_code, to preserve the match |
| 1108 data. Not necessary because we don't call process filters | |
| 1109 asynchronously (i.e. from within QUIT). */ | |
| 1110 /* Don't catch errors here; we're not in any critical code. */ | |
| 1111 call2 (outstream, process, make_string (chars, nbytes)); | |
| 428 | 1112 return nchars; |
| 1113 } | |
| 1114 | |
| 1115 /* If no filter, write into buffer if it isn't dead. */ | |
| 853 | 1116 if (!NILP (buffer) && BUFFER_LIVE_P (XBUFFER (buffer))) |
| 428 | 1117 { |
| 844 | 1118 struct gcpro gcpro1; |
| 853 | 1119 struct buffer *buf = XBUFFER (buffer); |
| 1120 int spec = process_setup_for_insertion (process, read_stderr); | |
| 428 | 1121 |
| 844 | 1122 GCPRO1 (process); |
| 428 | 1123 |
| 1124 #if 0 | |
| 1125 /* This screws up initial display of the window. jla */ | |
| 1126 | |
| 1127 /* Insert before markers in case we are inserting where | |
| 1128 the buffer's mark is, and the user's next command is Meta-y. */ | |
| 1129 buffer_insert_raw_string_1 (buf, -1, chars, | |
| 1130 nbytes, INSDEL_BEFORE_MARKERS); | |
| 1131 #else | |
| 1132 buffer_insert_raw_string (buf, chars, nbytes); | |
| 1133 #endif | |
| 1134 | |
| 853 | 1135 Fset_marker (mark, make_int (BUF_PT (buf)), buffer); |
| 1136 | |
| 428 | 1137 MARK_MODELINE_CHANGED; |
| 844 | 1138 unbind_to (spec); |
| 428 | 1139 UNGCPRO; |
| 1140 } | |
| 1141 return nchars; | |
| 1142 } | |
| 853 | 1143 |
| 1144 int | |
| 1145 process_has_separate_stderr (Lisp_Object process) | |
| 1146 { | |
| 1147 return XPROCESS (process)->separate_stderr; | |
| 1148 } | |
| 1149 | |
| 859 | 1150 DEFUN ("process-has-separate-stderr-p", Fprocess_has_separate_stderr_p, 1, 1, |
| 1151 0, /* | |
| 1152 Return non-nil if process has stderr separate from stdout. | |
| 1153 */ | |
| 1154 (process)) | |
| 1155 { | |
| 1156 CHECK_PROCESS (process); | |
| 1157 return process_has_separate_stderr (process) ? Qt : Qnil; | |
| 1158 } | |
| 1159 | |
| 428 | 1160 |
| 1161 /* Sending data to subprocess */ | |
| 1162 | |
| 444 | 1163 /* send some data to process PROCESS. If NONRELOCATABLE is non-NULL, it |
| 428 | 1164 specifies the address of the data. Otherwise, the data comes from the |
| 1165 object RELOCATABLE (either a string or a buffer). START and LEN | |
| 1166 specify the offset and length of the data to send. | |
| 1167 | |
| 665 | 1168 Note that START and LEN are in Charbpos's if RELOCATABLE is a buffer, |
| 428 | 1169 and in Bytecounts otherwise. */ |
| 1170 | |
| 1171 void | |
| 444 | 1172 send_process (Lisp_Object process, |
| 867 | 1173 Lisp_Object relocatable, const Ibyte *nonrelocatable, |
| 428 | 1174 int start, int len) |
| 1175 { | |
| 1176 /* This function can GC */ | |
| 1177 struct gcpro gcpro1, gcpro2; | |
| 1178 Lisp_Object lstream = Qnil; | |
| 1179 | |
| 444 | 1180 GCPRO2 (process, lstream); |
| 428 | 1181 |
| 444 | 1182 if (NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
| 563 | 1183 invalid_operation ("Process not open for writing", process); |
| 428 | 1184 |
| 1185 if (nonrelocatable) | |
| 1186 lstream = | |
| 1187 make_fixed_buffer_input_stream (nonrelocatable + start, len); | |
| 1188 else if (BUFFERP (relocatable)) | |
| 1189 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), | |
| 1190 start, start + len, 0); | |
| 1191 else | |
| 1192 lstream = make_lisp_string_input_stream (relocatable, start, len); | |
| 1193 | |
| 771 | 1194 if (debug_process_io) |
| 1195 { | |
| 1196 if (nonrelocatable) | |
| 1197 stderr_out ("Writing: %s\n", nonrelocatable); | |
| 1198 else | |
| 1199 { | |
| 1200 stderr_out ("Writing: "); | |
| 1201 print_internal (relocatable, Qexternal_debugging_output, 0); | |
| 1202 } | |
| 1203 } | |
| 1204 | |
| 444 | 1205 PROCMETH (send_process, (process, XLSTREAM (lstream))); |
| 428 | 1206 |
| 1207 UNGCPRO; | |
| 1208 Lstream_delete (XLSTREAM (lstream)); | |
| 1209 } | |
| 1210 | |
| 1211 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* | |
| 1212 Return the name of the terminal PROCESS uses, or nil if none. | |
| 1213 This is the terminal that the process itself reads and writes on, | |
| 1214 not the name of the pty that Emacs uses to talk with that terminal. | |
| 1215 */ | |
| 444 | 1216 (process)) |
| 428 | 1217 { |
| 444 | 1218 CHECK_PROCESS (process); |
| 1204 | 1219 return XPROCESS (process)->tty_name; |
| 428 | 1220 } |
| 1221 | |
| 1222 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* | |
| 1223 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). | |
| 2297 | 1224 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
| 428 | 1225 */ |
| 444 | 1226 (process, buffer)) |
| 428 | 1227 { |
| 444 | 1228 CHECK_PROCESS (process); |
| 428 | 1229 if (!NILP (buffer)) |
| 1230 CHECK_BUFFER (buffer); | |
| 444 | 1231 XPROCESS (process)->buffer = buffer; |
| 428 | 1232 return buffer; |
| 1233 } | |
| 1234 | |
| 1235 DEFUN ("process-buffer", Fprocess_buffer, 1, 1, 0, /* | |
| 1236 Return the buffer PROCESS is associated with. | |
| 2297 | 1237 Output from PROCESS is inserted in this buffer unless PROCESS has a filter. |
| 1238 Set the buffer with `set-process-buffer'. | |
| 428 | 1239 */ |
| 444 | 1240 (process)) |
| 428 | 1241 { |
| 444 | 1242 CHECK_PROCESS (process); |
| 1243 return XPROCESS (process)->buffer; | |
| 428 | 1244 } |
| 1245 | |
| 853 | 1246 DEFUN ("set-process-stderr-buffer", Fset_process_stderr_buffer, 2, 2, 0, /* |
| 2297 | 1247 Output from the stderr of PROCESS is inserted in this buffer unless |
| 1248 PROCESS has a stderr filter. | |
| 853 | 1249 Set stderr buffer associated with PROCESS to BUFFER (a buffer, or nil). |
| 1250 */ | |
| 1251 (process, buffer)) | |
| 1252 { | |
| 1253 CHECK_PROCESS (process); | |
| 1254 if (!XPROCESS (process)->separate_stderr) | |
| 1255 invalid_change ("stdout and stderr not separate", process); | |
| 1256 if (!NILP (buffer)) | |
| 1257 CHECK_BUFFER (buffer); | |
| 1258 XPROCESS (process)->stderr_buffer = buffer; | |
| 1259 return buffer; | |
| 1260 } | |
| 1261 | |
| 1262 DEFUN ("process-stderr-buffer", Fprocess_stderr_buffer, 1, 1, 0, /* | |
| 1263 Return the stderr buffer PROCESS is associated with. | |
| 2297 | 1264 Output from the stderr of PROCESS is inserted in this buffer unless PROCESS |
| 1265 has a stderr filter. Set the buffer with `set-process-stderr-buffer'. | |
| 853 | 1266 */ |
| 1267 (process)) | |
| 1268 { | |
| 1269 CHECK_PROCESS (process); | |
| 1270 if (!XPROCESS (process)->separate_stderr) | |
| 1271 invalid_change ("stdout and stderr not separate", process); | |
| 1272 return XPROCESS (process)->stderr_buffer; | |
| 1273 } | |
| 1274 | |
| 428 | 1275 DEFUN ("process-mark", Fprocess_mark, 1, 1, 0, /* |
| 1276 Return the marker for the end of the last output from PROCESS. | |
| 1277 */ | |
| 444 | 1278 (process)) |
| 428 | 1279 { |
| 444 | 1280 CHECK_PROCESS (process); |
| 1281 return XPROCESS (process)->mark; | |
| 428 | 1282 } |
| 1283 | |
| 853 | 1284 DEFUN ("process-stderr-mark", Fprocess_stderr_mark, 1, 1, 0, /* |
| 1285 Return the marker for the end of the last stderr output from PROCESS. | |
| 1286 */ | |
| 1287 (process)) | |
| 1288 { | |
| 1289 CHECK_PROCESS (process); | |
| 1290 if (!XPROCESS (process)->separate_stderr) | |
| 1291 invalid_operation ("stdout and stderr not separate", process); | |
| 1292 return XPROCESS (process)->stderr_mark; | |
| 1293 } | |
| 1294 | |
| 428 | 1295 void |
| 853 | 1296 set_process_filter (Lisp_Object process, Lisp_Object filter, |
| 1297 int filter_does_read, int set_stderr) | |
| 428 | 1298 { |
| 444 | 1299 CHECK_PROCESS (process); |
| 853 | 1300 if (set_stderr && !XPROCESS (process)->separate_stderr) |
| 1301 invalid_change ("stdout and stderr not separate", process); | |
| 863 | 1302 if (PROCESS_READABLE_P (XPROCESS (process))) |
| 853 | 1303 { |
| 1304 if (EQ (filter, Qt)) | |
| 1305 event_stream_unselect_process (XPROCESS (process), !set_stderr, | |
| 1306 set_stderr); | |
| 1307 else | |
| 1308 event_stream_select_process (XPROCESS (process), !set_stderr, | |
| 1309 set_stderr); | |
| 1310 } | |
| 428 | 1311 |
| 853 | 1312 if (set_stderr) |
| 1313 XPROCESS (process)->stderr_filter = filter; | |
| 1314 else | |
| 1315 XPROCESS (process)->filter = filter; | |
| 444 | 1316 XPROCESS (process)->filter_does_read = filter_does_read; |
| 428 | 1317 } |
| 1318 | |
| 1319 DEFUN ("set-process-filter", Fset_process_filter, 2, 2, 0, /* | |
| 1320 Give PROCESS the filter function FILTER; nil means no filter. | |
| 853 | 1321 t means stop accepting output from the process. (If process was created |
| 854 | 1322 with |
| 853 | 1323 When a process has a filter, each time it does output |
| 1324 the entire string of output is passed to the filter. | |
| 1325 The filter gets two arguments: the process and the string of output. | |
| 1326 If the process has a filter, its buffer is not used for output. | |
| 1327 */ | |
| 1328 (process, filter)) | |
| 1329 { | |
| 1330 set_process_filter (process, filter, 0, 0); | |
| 1331 return filter; | |
| 1332 } | |
| 1333 | |
| 1334 DEFUN ("set-process-stderr-filter", Fset_process_stderr_filter, 2, 2, 0, /* | |
| 1335 Give PROCESS the stderr filter function FILTER; nil means no filter. | |
| 428 | 1336 t means stop accepting output from the process. |
| 1337 When a process has a filter, each time it does output | |
| 1338 the entire string of output is passed to the filter. | |
| 1339 The filter gets two arguments: the process and the string of output. | |
| 1340 If the process has a filter, its buffer is not used for output. | |
| 1341 */ | |
| 444 | 1342 (process, filter)) |
| 428 | 1343 { |
| 853 | 1344 set_process_filter (process, filter, 0, 1); |
| 428 | 1345 return filter; |
| 1346 } | |
| 1347 | |
| 1348 DEFUN ("process-filter", Fprocess_filter, 1, 1, 0, /* | |
| 1349 Return the filter function of PROCESS; nil if none. | |
| 1350 See `set-process-filter' for more info on filter functions. | |
| 1351 */ | |
| 444 | 1352 (process)) |
| 428 | 1353 { |
| 444 | 1354 CHECK_PROCESS (process); |
| 1355 return XPROCESS (process)->filter; | |
| 428 | 1356 } |
| 1357 | |
| 853 | 1358 DEFUN ("process-stderr-filter", Fprocess_stderr_filter, 1, 1, 0, /* |
| 1359 Return the filter function of PROCESS; nil if none. | |
| 1360 See `set-process-stderr-filter' for more info on filter functions. | |
| 1361 */ | |
| 1362 (process)) | |
| 1363 { | |
| 1364 CHECK_PROCESS (process); | |
| 1365 if (!XPROCESS (process)->separate_stderr) | |
| 1366 invalid_operation ("stdout and stderr not separate", process); | |
| 1367 return XPROCESS (process)->stderr_filter; | |
| 1368 } | |
| 1369 | |
| 442 | 1370 DEFUN ("process-send-region", Fprocess_send_region, 3, 4, 0, /* |
| 1371 Send current contents of the region between START and END as input to PROCESS. | |
| 444 | 1372 PROCESS may be a process or the name of a process, or a buffer or the |
| 1373 name of a buffer, in which case the buffer's process is used. If it | |
| 1374 is nil, the current buffer's process is used. | |
| 442 | 1375 BUFFER specifies the buffer to look in; if nil, the current buffer is used. |
| 853 | 1376 If the region is more than 100 or so characters long, it may be sent in |
| 1377 several chunks. This may happen even for shorter regions. Output | |
| 444 | 1378 from processes can arrive in between chunks. |
| 428 | 1379 */ |
| 442 | 1380 (process, start, end, buffer)) |
| 428 | 1381 { |
| 1382 /* This function can GC */ | |
| 665 | 1383 Charbpos bstart, bend; |
| 442 | 1384 struct buffer *buf = decode_buffer (buffer, 0); |
| 428 | 1385 |
| 793 | 1386 buffer = wrap_buffer (buf); |
| 444 | 1387 process = get_process (process); |
| 1388 get_buffer_range_char (buf, start, end, &bstart, &bend, 0); | |
| 442 | 1389 |
| 444 | 1390 send_process (process, buffer, 0, bstart, bend - bstart); |
| 428 | 1391 return Qnil; |
| 1392 } | |
| 1393 | |
| 1394 DEFUN ("process-send-string", Fprocess_send_string, 2, 4, 0, /* | |
| 1395 Send PROCESS the contents of STRING as input. | |
| 444 | 1396 PROCESS may be a process or the name of a process, or a buffer or the |
| 1397 name of a buffer, in which case the buffer's process is used. If it | |
| 1398 is nil, the current buffer's process is used. | |
| 1399 Optional arguments START and END specify part of STRING; see `substring'. | |
| 1400 If STRING is more than 100 or so characters long, it may be sent in | |
| 1401 several chunks. This may happen even for shorter strings. Output | |
| 1402 from processes can arrive in between chunks. | |
| 428 | 1403 */ |
| 444 | 1404 (process, string, start, end)) |
| 428 | 1405 { |
| 1406 /* This function can GC */ | |
| 444 | 1407 Bytecount bstart, bend; |
| 428 | 1408 |
| 444 | 1409 process = get_process (process); |
| 428 | 1410 CHECK_STRING (string); |
| 444 | 1411 get_string_range_byte (string, start, end, &bstart, &bend, |
| 428 | 1412 GB_HISTORICAL_STRING_BEHAVIOR); |
| 1413 | |
| 444 | 1414 send_process (process, string, 0, bstart, bend - bstart); |
| 428 | 1415 return Qnil; |
| 1416 } | |
| 1417 | |
| 1418 | |
| 1419 DEFUN ("process-input-coding-system", Fprocess_input_coding_system, 1, 1, 0, /* | |
| 1420 Return PROCESS's input coding system. | |
| 1421 */ | |
| 1422 (process)) | |
| 1423 { | |
| 1424 process = get_process (process); | |
| 863 | 1425 CHECK_READABLE_PROCESS (process); |
| 771 | 1426 return (coding_stream_detected_coding_system |
| 1427 (XLSTREAM (XPROCESS (process)->coding_instream))); | |
| 428 | 1428 } |
| 1429 | |
| 1430 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* | |
| 1431 Return PROCESS's output coding system. | |
| 1432 */ | |
| 1433 (process)) | |
| 1434 { | |
| 1435 process = get_process (process); | |
| 440 | 1436 CHECK_LIVE_PROCESS (process); |
| 771 | 1437 return (coding_stream_coding_system |
| 1438 (XLSTREAM (XPROCESS (process)->coding_outstream))); | |
| 428 | 1439 } |
| 1440 | |
| 1441 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* | |
| 1442 Return a pair of coding-system for decoding and encoding of PROCESS. | |
| 1443 */ | |
| 1444 (process)) | |
| 1445 { | |
| 1446 process = get_process (process); | |
| 863 | 1447 CHECK_READABLE_PROCESS (process); |
| 771 | 1448 return Fcons (coding_stream_detected_coding_system |
| 428 | 1449 (XLSTREAM (XPROCESS (process)->coding_instream)), |
| 771 | 1450 coding_stream_coding_system |
| 428 | 1451 (XLSTREAM (XPROCESS (process)->coding_outstream))); |
| 1452 } | |
| 1453 | |
| 1454 DEFUN ("set-process-input-coding-system", Fset_process_input_coding_system, | |
| 1455 2, 2, 0, /* | |
| 1456 Set PROCESS's input coding system to CODESYS. | |
| 771 | 1457 This is used for reading data from PROCESS. |
| 428 | 1458 */ |
| 1459 (process, codesys)) | |
| 1460 { | |
| 771 | 1461 codesys = get_coding_system_for_text_file (codesys, 1); |
| 428 | 1462 process = get_process (process); |
| 863 | 1463 CHECK_READABLE_PROCESS (process); |
| 440 | 1464 |
| 771 | 1465 set_coding_stream_coding_system |
| 428 | 1466 (XLSTREAM (XPROCESS (process)->coding_instream), codesys); |
| 1467 return Qnil; | |
| 1468 } | |
| 1469 | |
| 1470 DEFUN ("set-process-output-coding-system", Fset_process_output_coding_system, | |
| 1471 2, 2, 0, /* | |
| 1472 Set PROCESS's output coding system to CODESYS. | |
| 771 | 1473 This is used for writing data to PROCESS. |
| 428 | 1474 */ |
| 1475 (process, codesys)) | |
| 1476 { | |
| 771 | 1477 codesys = get_coding_system_for_text_file (codesys, 0); |
| 428 | 1478 process = get_process (process); |
| 440 | 1479 CHECK_LIVE_PROCESS (process); |
| 1480 | |
| 771 | 1481 set_coding_stream_coding_system |
| 428 | 1482 (XLSTREAM (XPROCESS (process)->coding_outstream), codesys); |
| 1483 return Qnil; | |
| 1484 } | |
| 1485 | |
| 1486 DEFUN ("set-process-coding-system", Fset_process_coding_system, | |
| 1487 1, 3, 0, /* | |
| 1488 Set coding-systems of PROCESS to DECODING and ENCODING. | |
| 440 | 1489 DECODING will be used to decode subprocess output and ENCODING to |
| 1490 encode subprocess input. | |
| 428 | 1491 */ |
| 1492 (process, decoding, encoding)) | |
| 1493 { | |
| 1494 if (!NILP (decoding)) | |
| 1495 Fset_process_input_coding_system (process, decoding); | |
| 1496 | |
| 1497 if (!NILP (encoding)) | |
| 1498 Fset_process_output_coding_system (process, encoding); | |
| 1499 | |
| 1500 return Qnil; | |
| 1501 } | |
| 1502 | |
| 1503 | |
| 1504 /************************************************************************/ | |
| 1505 /* process status */ | |
| 1506 /************************************************************************/ | |
| 1507 | |
| 1508 static Lisp_Object | |
| 1509 exec_sentinel_unwind (Lisp_Object datum) | |
| 1510 { | |
| 853 | 1511 XPROCESS (XCAR (datum))->sentinel = XCDR (datum); |
| 1512 free_cons (datum); | |
| 428 | 1513 return Qnil; |
| 1514 } | |
| 1515 | |
| 1516 static void | |
| 444 | 1517 exec_sentinel (Lisp_Object process, Lisp_Object reason) |
| 428 | 1518 { |
| 1519 /* This function can GC */ | |
| 1520 int speccount = specpdl_depth (); | |
| 444 | 1521 Lisp_Process *p = XPROCESS (process); |
| 428 | 1522 Lisp_Object sentinel = p->sentinel; |
| 1523 | |
| 1524 if (NILP (sentinel)) | |
| 1525 return; | |
| 1526 | |
| 1527 /* Some weird FSFmacs crap here with | |
| 1528 Vdeactivate_mark and current_buffer->keymap */ | |
| 1529 | |
| 853 | 1530 /* Some FSF junk with running_asynch_code, to preserve the match |
| 1531 data. Not necessary because we don't call process filters | |
| 1532 asynchronously (i.e. from within QUIT). */ | |
| 1533 | |
| 428 | 1534 /* Zilch the sentinel while it's running, to avoid recursive invocations; |
| 853 | 1535 assure that it gets restored no matter how the sentinel exits. |
| 1536 | |
| 1537 (#### Why is this necessary? Probably another relic of asynchronous | |
| 1538 calling of process filters/sentinels.) */ | |
| 428 | 1539 p->sentinel = Qnil; |
| 853 | 1540 record_unwind_protect (exec_sentinel_unwind, |
| 1541 noseeum_cons (process, sentinel)); | |
| 1542 /* Don't catch errors here; we're not in any critical code. */ | |
| 1543 call2 (sentinel, process, reason); | |
| 771 | 1544 unbind_to (speccount); |
| 428 | 1545 } |
| 1546 | |
| 1547 DEFUN ("set-process-sentinel", Fset_process_sentinel, 2, 2, 0, /* | |
| 1548 Give PROCESS the sentinel SENTINEL; nil for none. | |
| 1549 The sentinel is called as a function when the process changes state. | |
| 1550 It gets two arguments: the process, and a string describing the change. | |
| 1551 */ | |
| 444 | 1552 (process, sentinel)) |
| 428 | 1553 { |
| 444 | 1554 CHECK_PROCESS (process); |
| 1555 XPROCESS (process)->sentinel = sentinel; | |
| 428 | 1556 return sentinel; |
| 1557 } | |
| 1558 | |
| 1559 DEFUN ("process-sentinel", Fprocess_sentinel, 1, 1, 0, /* | |
| 1560 Return the sentinel of PROCESS; nil if none. | |
| 1561 See `set-process-sentinel' for more info on sentinels. | |
| 1562 */ | |
| 444 | 1563 (process)) |
| 428 | 1564 { |
| 444 | 1565 CHECK_PROCESS (process); |
| 1566 return XPROCESS (process)->sentinel; | |
| 428 | 1567 } |
| 1568 | |
| 1569 | |
| 442 | 1570 const char * |
| 428 | 1571 signal_name (int signum) |
| 1572 { | |
| 1573 if (signum >= 0 && signum < NSIG) | |
| 442 | 1574 return (const char *) sys_siglist[signum]; |
| 428 | 1575 |
| 442 | 1576 return (const char *) GETTEXT ("unknown signal"); |
| 428 | 1577 } |
| 1578 | |
| 1579 void | |
| 1580 update_process_status (Lisp_Object p, | |
| 1581 Lisp_Object status_symbol, | |
| 1582 int exit_code, | |
| 1583 int core_dumped) | |
| 1584 { | |
| 1585 XPROCESS (p)->tick++; | |
| 1586 process_tick++; | |
| 1587 XPROCESS (p)->status_symbol = status_symbol; | |
| 1588 XPROCESS (p)->exit_code = exit_code; | |
| 1589 XPROCESS (p)->core_dumped = core_dumped; | |
| 1590 } | |
| 1591 | |
| 1592 /* Return a string describing a process status list. */ | |
| 1593 | |
| 1594 static Lisp_Object | |
| 440 | 1595 status_message (Lisp_Process *p) |
| 428 | 1596 { |
| 1597 Lisp_Object symbol = p->status_symbol; | |
| 1598 int code = p->exit_code; | |
| 1599 int coredump = p->core_dumped; | |
| 1600 Lisp_Object string, string2; | |
| 1601 | |
| 1602 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop)) | |
| 1603 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1604 string = build_cistring (signal_name (code)); |
| 428 | 1605 if (coredump) |
| 771 | 1606 string2 = build_msg_string (" (core dumped)\n"); |
| 428 | 1607 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1608 string2 = build_ascstring ("\n"); |
| 793 | 1609 set_string_char (string, 0, |
| 867 | 1610 DOWNCASE (0, string_ichar (string, 0))); |
| 428 | 1611 return concat2 (string, string2); |
| 1612 } | |
| 1613 else if (EQ (symbol, Qexit)) | |
| 1614 { | |
| 1615 if (code == 0) | |
| 771 | 1616 return build_msg_string ("finished\n"); |
| 428 | 1617 string = Fnumber_to_string (make_int (code)); |
| 1618 if (coredump) | |
| 771 | 1619 string2 = build_msg_string (" (core dumped)\n"); |
| 428 | 1620 else |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
1621 string2 = build_ascstring ("\n"); |
| 771 | 1622 return concat2 (build_msg_string ("exited abnormally with code "), |
| 428 | 1623 concat2 (string, string2)); |
| 1624 } | |
| 1625 else | |
| 1626 return Fcopy_sequence (Fsymbol_name (symbol)); | |
| 1627 } | |
| 1628 | |
| 1629 /* Tell status_notify() to check for terminated processes. We do this | |
| 1630 because on some systems we sometimes miss SIGCHLD calls. (Not sure | |
| 853 | 1631 why.) This is also used under Mswin. */ |
| 428 | 1632 |
| 1633 void | |
| 1634 kick_status_notify (void) | |
| 1635 { | |
| 1636 process_tick++; | |
| 1637 } | |
| 1638 | |
| 1639 | |
| 1640 /* Report all recent events of a change in process status | |
| 1641 (either run the sentinel or output a message). | |
| 1642 This is done while Emacs is waiting for keyboard input. */ | |
| 1643 | |
| 1644 void | |
| 1645 status_notify (void) | |
| 1646 { | |
| 1647 /* This function can GC */ | |
| 1648 Lisp_Object tail = Qnil; | |
| 1649 Lisp_Object symbol = Qnil; | |
| 1650 Lisp_Object msg = Qnil; | |
| 1651 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 1652 /* process_tick is volatile, so we have to remember it now. | |
| 444 | 1653 Otherwise, we get a race condition if SIGCHLD happens during |
| 428 | 1654 this function. |
| 1655 | |
| 1656 (Actually, this is not the case anymore. The code to | |
| 1657 update the process structures has been moved out of the | |
| 1658 SIGCHLD handler. But for the moment I'm leaving this | |
| 1659 stuff in -- it can't hurt.) */ | |
| 1660 int temp_process_tick; | |
| 1661 | |
| 1662 MAYBE_PROCMETH (reap_exited_processes, ()); | |
| 1663 | |
| 1664 temp_process_tick = process_tick; | |
| 1665 | |
| 1666 if (update_tick == temp_process_tick) | |
| 1667 return; | |
| 1668 | |
| 1669 /* We need to gcpro tail; if read_process_output calls a filter | |
| 1670 which deletes a process and removes the cons to which tail points | |
| 1671 from Vprocess_alist, and then causes a GC, tail is an unprotected | |
| 1672 reference. */ | |
| 1673 GCPRO3 (tail, symbol, msg); | |
| 1674 | |
| 1675 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
| 1676 { | |
| 444 | 1677 Lisp_Object process = XCAR (tail); |
| 1678 Lisp_Process *p = XPROCESS (process); | |
| 428 | 1679 /* p->tick is also volatile. Same thing as above applies. */ |
| 1680 int this_process_tick; | |
| 1681 | |
| 1682 /* #### extra check for terminated processes, in case a SIGCHLD | |
| 1683 got missed (this seems to happen sometimes, I'm not sure why). | |
| 1684 */ | |
| 1685 if (INTP (p->pid)) | |
| 1686 MAYBE_PROCMETH (update_status_if_terminated, (p)); | |
| 1687 | |
| 1688 this_process_tick = p->tick; | |
| 1689 if (this_process_tick != p->update_tick) | |
| 1690 { | |
| 1691 p->update_tick = this_process_tick; | |
| 1692 | |
| 1693 /* If process is still active, read any output that remains. */ | |
| 1694 while (!EQ (p->filter, Qt) | |
| 853 | 1695 && read_process_output (process, 0) > 0) |
| 1696 ; | |
| 1697 while (p->separate_stderr && !EQ (p->stderr_filter, Qt) | |
| 1698 && read_process_output (process, 1) > 0) | |
| 428 | 1699 ; |
| 1700 | |
| 1701 /* Get the text to use for the message. */ | |
| 1702 msg = status_message (p); | |
| 1703 | |
| 1704 /* If process is terminated, deactivate it or delete it. */ | |
| 1705 symbol = p->status_symbol; | |
| 1706 | |
| 1707 if (EQ (symbol, Qsignal) | |
| 1708 || EQ (symbol, Qexit)) | |
| 1709 { | |
| 1710 if (delete_exited_processes) | |
| 444 | 1711 remove_process (process); |
| 428 | 1712 else |
| 444 | 1713 deactivate_process (process); |
| 428 | 1714 } |
| 1715 | |
| 1716 /* Now output the message suitably. */ | |
| 1717 if (!NILP (p->sentinel)) | |
| 444 | 1718 exec_sentinel (process, msg); |
| 428 | 1719 /* Don't bother with a message in the buffer |
| 1720 when a process becomes runnable. */ | |
| 844 | 1721 else if (!EQ (symbol, Qrun) && !NILP (p->buffer) && |
| 1722 /* Avoid error if buffer is deleted | |
| 1723 (probably that's why the process is dead, too) */ | |
| 1724 BUFFER_LIVE_P (XBUFFER (p->buffer))) | |
| 428 | 1725 { |
| 844 | 1726 struct gcpro ngcpro1; |
| 853 | 1727 int spec = process_setup_for_insertion (process, 0); |
| 428 | 1728 |
| 844 | 1729 NGCPRO1 (process); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1730 buffer_insert_ascstring (current_buffer, "\nProcess "); |
| 428 | 1731 Finsert (1, &p->name); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1732 buffer_insert_ascstring (current_buffer, " "); |
| 428 | 1733 Finsert (1, &msg); |
| 1734 Fset_marker (p->mark, make_int (BUF_PT (current_buffer)), | |
| 1735 p->buffer); | |
| 1736 | |
| 844 | 1737 unbind_to (spec); |
| 428 | 1738 NUNGCPRO; |
| 1739 } | |
| 1740 } | |
| 1741 } /* end for */ | |
| 1742 | |
| 1743 /* in case buffers use %s in modeline-format */ | |
| 1744 MARK_MODELINE_CHANGED; | |
| 1745 redisplay (); | |
| 1746 | |
| 1747 update_tick = temp_process_tick; | |
| 1748 | |
| 1749 UNGCPRO; | |
| 1750 } | |
| 1751 | |
| 1752 DEFUN ("process-status", Fprocess_status, 1, 1, 0, /* | |
| 1753 Return the status of PROCESS. | |
| 1754 This is a symbol, one of these: | |
| 1755 | |
| 1756 run -- for a process that is running. | |
| 1757 stop -- for a process stopped but continuable. | |
| 1758 exit -- for a process that has exited. | |
| 1759 signal -- for a process that has got a fatal signal. | |
| 1760 open -- for a network stream connection that is open. | |
| 1761 closed -- for a network stream connection that is closed. | |
| 1762 nil -- if arg is a process name and no such process exists. | |
| 1763 | |
| 1764 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
| 1765 nil, indicating the current buffer's process. | |
| 1766 */ | |
| 444 | 1767 (process)) |
| 428 | 1768 { |
| 1769 Lisp_Object status_symbol; | |
| 1770 | |
| 444 | 1771 if (STRINGP (process)) |
| 1772 process = Fget_process (process); | |
| 428 | 1773 else |
| 444 | 1774 process = get_process (process); |
| 428 | 1775 |
| 444 | 1776 if (NILP (process)) |
| 428 | 1777 return Qnil; |
| 1778 | |
| 444 | 1779 status_symbol = XPROCESS (process)->status_symbol; |
| 1780 if (network_connection_p (process)) | |
| 428 | 1781 { |
| 1782 if (EQ (status_symbol, Qrun)) | |
| 1783 status_symbol = Qopen; | |
| 1784 else if (EQ (status_symbol, Qexit)) | |
| 1785 status_symbol = Qclosed; | |
| 1786 } | |
| 1787 return status_symbol; | |
| 1788 } | |
| 1789 | |
| 1790 DEFUN ("process-exit-status", Fprocess_exit_status, 1, 1, 0, /* | |
| 1791 Return the exit status of PROCESS or the signal number that killed it. | |
| 1792 If PROCESS has not yet exited or died, return 0. | |
| 1793 */ | |
| 444 | 1794 (process)) |
| 428 | 1795 { |
| 444 | 1796 CHECK_PROCESS (process); |
| 1797 return make_int (XPROCESS (process)->exit_code); | |
| 428 | 1798 } |
| 1799 | |
| 1800 | |
| 1801 | |
| 442 | 1802 static int |
| 1803 decode_signal (Lisp_Object signal_) | |
| 428 | 1804 { |
| 442 | 1805 if (INTP (signal_)) |
| 1806 return XINT (signal_); | |
| 428 | 1807 else |
| 1808 { | |
| 867 | 1809 Ibyte *name; |
| 428 | 1810 |
| 442 | 1811 CHECK_SYMBOL (signal_); |
| 793 | 1812 name = XSTRING_DATA (XSYMBOL (signal_)->name); |
| 428 | 1813 |
| 793 | 1814 #define handle_signal(sym) do { \ |
| 2367 | 1815 if (!qxestrcmp_ascii ( name, #sym)) \ |
| 793 | 1816 return sym; \ |
| 442 | 1817 } while (0) |
| 428 | 1818 |
| 1819 handle_signal (SIGINT); /* ANSI */ | |
| 1820 handle_signal (SIGILL); /* ANSI */ | |
| 1821 handle_signal (SIGABRT); /* ANSI */ | |
| 1822 handle_signal (SIGFPE); /* ANSI */ | |
| 1823 handle_signal (SIGSEGV); /* ANSI */ | |
| 1824 handle_signal (SIGTERM); /* ANSI */ | |
| 1825 | |
| 1826 #ifdef SIGHUP | |
| 1827 handle_signal (SIGHUP); /* POSIX */ | |
| 1828 #endif | |
| 1829 #ifdef SIGQUIT | |
| 1830 handle_signal (SIGQUIT); /* POSIX */ | |
| 1831 #endif | |
| 1832 #ifdef SIGTRAP | |
| 1833 handle_signal (SIGTRAP); /* POSIX */ | |
| 1834 #endif | |
| 1835 #ifdef SIGKILL | |
| 1836 handle_signal (SIGKILL); /* POSIX */ | |
| 1837 #endif | |
| 1838 #ifdef SIGUSR1 | |
| 1839 handle_signal (SIGUSR1); /* POSIX */ | |
| 1840 #endif | |
| 1841 #ifdef SIGUSR2 | |
| 1842 handle_signal (SIGUSR2); /* POSIX */ | |
| 1843 #endif | |
| 1844 #ifdef SIGPIPE | |
| 1845 handle_signal (SIGPIPE); /* POSIX */ | |
| 1846 #endif | |
| 1847 #ifdef SIGALRM | |
| 1848 handle_signal (SIGALRM); /* POSIX */ | |
| 1849 #endif | |
| 1850 #ifdef SIGCHLD | |
| 1851 handle_signal (SIGCHLD); /* POSIX */ | |
| 1852 #endif | |
| 1853 #ifdef SIGCONT | |
| 1854 handle_signal (SIGCONT); /* POSIX */ | |
| 1855 #endif | |
| 1856 #ifdef SIGSTOP | |
| 1857 handle_signal (SIGSTOP); /* POSIX */ | |
| 1858 #endif | |
| 1859 #ifdef SIGTSTP | |
| 1860 handle_signal (SIGTSTP); /* POSIX */ | |
| 1861 #endif | |
| 1862 #ifdef SIGTTIN | |
| 1863 handle_signal (SIGTTIN); /* POSIX */ | |
| 1864 #endif | |
| 1865 #ifdef SIGTTOU | |
| 1866 handle_signal (SIGTTOU); /* POSIX */ | |
| 1867 #endif | |
| 1868 | |
| 1869 #ifdef SIGBUS | |
| 1870 handle_signal (SIGBUS); /* XPG5 */ | |
| 1871 #endif | |
| 1872 #ifdef SIGPOLL | |
| 1873 handle_signal (SIGPOLL); /* XPG5 */ | |
| 1874 #endif | |
| 1875 #ifdef SIGPROF | |
| 1876 handle_signal (SIGPROF); /* XPG5 */ | |
| 1877 #endif | |
| 1878 #ifdef SIGSYS | |
| 1879 handle_signal (SIGSYS); /* XPG5 */ | |
| 1880 #endif | |
| 1881 #ifdef SIGURG | |
| 1882 handle_signal (SIGURG); /* XPG5 */ | |
| 1883 #endif | |
| 1884 #ifdef SIGXCPU | |
| 1885 handle_signal (SIGXCPU); /* XPG5 */ | |
| 1886 #endif | |
| 1887 #ifdef SIGXFSZ | |
| 1888 handle_signal (SIGXFSZ); /* XPG5 */ | |
| 1889 #endif | |
| 1890 #ifdef SIGVTALRM | |
| 1891 handle_signal (SIGVTALRM); /* XPG5 */ | |
| 1892 #endif | |
| 1893 | |
| 1894 #ifdef SIGIO | |
| 1895 handle_signal (SIGIO); /* BSD 4.2 */ | |
| 1896 #endif | |
| 1897 #ifdef SIGWINCH | |
| 1898 handle_signal (SIGWINCH); /* BSD 4.3 */ | |
| 1899 #endif | |
| 1900 | |
| 1901 #ifdef SIGEMT | |
| 1902 handle_signal (SIGEMT); | |
| 1903 #endif | |
| 1904 #ifdef SIGINFO | |
| 1905 handle_signal (SIGINFO); | |
| 1906 #endif | |
| 1907 #ifdef SIGHWE | |
| 1908 handle_signal (SIGHWE); | |
| 1909 #endif | |
| 1910 #ifdef SIGPRE | |
| 1911 handle_signal (SIGPRE); | |
| 1912 #endif | |
| 1913 #ifdef SIGUME | |
| 1914 handle_signal (SIGUME); | |
| 1915 #endif | |
| 1916 #ifdef SIGDLK | |
| 1917 handle_signal (SIGDLK); | |
| 1918 #endif | |
| 1919 #ifdef SIGCPULIM | |
| 1920 handle_signal (SIGCPULIM); | |
| 1921 #endif | |
| 1922 #ifdef SIGIOT | |
| 1923 handle_signal (SIGIOT); | |
| 1924 #endif | |
| 1925 #ifdef SIGLOST | |
| 1926 handle_signal (SIGLOST); | |
| 1927 #endif | |
| 1928 #ifdef SIGSTKFLT | |
| 1929 handle_signal (SIGSTKFLT); | |
| 1930 #endif | |
| 1931 #ifdef SIGUNUSED | |
| 1932 handle_signal (SIGUNUSED); | |
| 1933 #endif | |
| 1934 #ifdef SIGDANGER | |
| 1935 handle_signal (SIGDANGER); /* AIX */ | |
| 1936 #endif | |
| 1937 #ifdef SIGMSG | |
| 1938 handle_signal (SIGMSG); | |
| 1939 #endif | |
| 1940 #ifdef SIGSOUND | |
| 1941 handle_signal (SIGSOUND); | |
| 1942 #endif | |
| 1943 #ifdef SIGRETRACT | |
| 1944 handle_signal (SIGRETRACT); | |
| 1945 #endif | |
| 1946 #ifdef SIGGRANT | |
| 1947 handle_signal (SIGGRANT); | |
| 1948 #endif | |
| 1949 #ifdef SIGPWR | |
| 1950 handle_signal (SIGPWR); | |
| 1951 #endif | |
| 1952 | |
| 1953 #undef handle_signal | |
| 1954 | |
| 563 | 1955 invalid_constant ("Undefined signal name", signal_); |
| 1204 | 1956 RETURN_NOT_REACHED (0); |
| 442 | 1957 } |
| 1958 } | |
| 1959 | |
| 1960 /* Send signal number SIGNO to PROCESS. | |
| 1961 CURRENT-GROUP non-nil means send signal to the current | |
| 1962 foreground process group of the process's controlling terminal rather | |
| 1963 than to the process's own process group. | |
| 1964 This is used for various commands in shell mode. | |
| 1965 If NOMSG is zero, insert signal-announcements into process's buffers | |
| 1966 right away. | |
| 1967 | |
| 1968 If we can, we try to signal PROCESS by sending control characters | |
| 1969 down the pty. This allows us to signal inferiors who have changed | |
| 1970 their uid, for which kill() would return an EPERM error, or to | |
| 1971 processes running on another computer through a remote login. */ | |
| 1972 | |
| 1973 static void | |
| 1974 process_send_signal (Lisp_Object process, int signo, | |
| 1975 int current_group, int nomsg) | |
| 1976 { | |
| 1977 /* This function can GC */ | |
| 444 | 1978 process = get_process (process); |
| 442 | 1979 |
| 444 | 1980 if (network_connection_p (process)) |
| 563 | 1981 invalid_operation ("Network connection is not a subprocess", process); |
| 444 | 1982 CHECK_LIVE_PROCESS (process); |
| 442 | 1983 |
| 444 | 1984 MAYBE_PROCMETH (kill_child_process, (process, signo, current_group, nomsg)); |
| 442 | 1985 } |
| 1986 | |
| 1987 DEFUN ("process-send-signal", Fprocess_send_signal, 1, 3, 0, /* | |
| 1988 Send signal SIGNAL to process PROCESS. | |
| 1989 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
| 1990 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
| 1991 nil, indicating the current buffer's process. | |
| 1992 Third arg CURRENT-GROUP non-nil means send signal to the current | |
| 1993 foreground process group of the process's controlling terminal rather | |
| 1994 than to the process's own process group. | |
| 1995 If the process is a shell that supports job control, this means | |
| 1996 send the signal to the current subjob rather than the shell. | |
| 1997 */ | |
| 1998 (signal_, process, current_group)) | |
| 1999 { | |
| 2000 /* This function can GC */ | |
| 2001 process_send_signal (process, decode_signal (signal_), | |
| 2002 !NILP (current_group), 0); | |
| 2003 return process; | |
| 2004 } | |
| 2005 | |
| 2006 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* | |
| 2007 Interrupt process PROCESS. | |
| 2008 See function `process-send-signal' for more details on usage. | |
| 2009 */ | |
| 2010 (process, current_group)) | |
| 2011 { | |
| 2012 /* This function can GC */ | |
| 2013 process_send_signal (process, SIGINT, !NILP (current_group), 0); | |
| 2014 return process; | |
| 2015 } | |
| 2016 | |
| 2017 DEFUN ("kill-process", Fkill_process, 0, 2, 0, /* | |
| 2018 Kill process PROCESS. | |
| 2019 See function `process-send-signal' for more details on usage. | |
| 2020 */ | |
| 2021 (process, current_group)) | |
| 2022 { | |
| 2023 /* This function can GC */ | |
| 2024 #ifdef SIGKILL | |
| 2025 process_send_signal (process, SIGKILL, !NILP (current_group), 0); | |
| 2026 #else | |
| 563 | 2027 signal_error (Qunimplemented, |
| 2028 "kill-process: Not supported on this system", | |
| 2029 Qunbound); | |
| 442 | 2030 #endif |
| 2031 return process; | |
| 2032 } | |
| 2033 | |
| 2034 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* | |
| 2035 Send QUIT signal to process PROCESS. | |
| 2036 See function `process-send-signal' for more details on usage. | |
| 2037 */ | |
| 2038 (process, current_group)) | |
| 2039 { | |
| 2040 /* This function can GC */ | |
| 2041 #ifdef SIGQUIT | |
| 2042 process_send_signal (process, SIGQUIT, !NILP (current_group), 0); | |
| 2043 #else | |
| 563 | 2044 signal_error (Qunimplemented, |
| 2045 "quit-process: Not supported on this system", | |
| 2046 Qunbound); | |
| 442 | 2047 #endif |
| 2048 return process; | |
| 2049 } | |
| 2050 | |
| 2051 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* | |
| 2052 Stop process PROCESS. | |
| 2053 See function `process-send-signal' for more details on usage. | |
| 2054 */ | |
| 2055 (process, current_group)) | |
| 2056 { | |
| 2057 /* This function can GC */ | |
| 2058 #ifdef SIGTSTP | |
| 2059 process_send_signal (process, SIGTSTP, !NILP (current_group), 0); | |
| 2060 #else | |
| 563 | 2061 signal_error (Qunimplemented, |
| 2062 "stop-process: Not supported on this system", | |
| 2063 Qunbound); | |
| 442 | 2064 #endif |
| 2065 return process; | |
| 2066 } | |
| 2067 | |
| 2068 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* | |
| 2069 Continue process PROCESS. | |
| 2070 See function `process-send-signal' for more details on usage. | |
| 2071 */ | |
| 2072 (process, current_group)) | |
| 2073 { | |
| 2074 /* This function can GC */ | |
| 2075 #ifdef SIGCONT | |
| 2076 process_send_signal (process, SIGCONT, !NILP (current_group), 0); | |
| 2077 #else | |
| 563 | 2078 signal_error (Qunimplemented, |
| 2079 "continue-process: Not supported on this system", | |
| 2080 Qunbound); | |
| 442 | 2081 #endif |
| 2082 return process; | |
| 2083 } | |
| 2084 | |
| 2085 DEFUN ("signal-process", Fsignal_process, 2, 2, | |
| 2086 "nProcess number: \nnSignal code: ", /* | |
| 2087 Send the process with process id PID the signal with code SIGNAL. | |
| 2088 PID must be an integer. The process need not be a child of this Emacs. | |
| 2089 SIGNAL may be an integer, or a symbol naming a signal, like `SIGSEGV'. | |
| 2090 */ | |
| 2091 (pid, signal_)) | |
| 2092 { | |
| 2093 CHECK_INT (pid); | |
| 2094 | |
| 428 | 2095 return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid, |
| 442 | 2096 (XINT (pid), decode_signal (signal_)), |
| 2097 -1)); | |
| 428 | 2098 } |
| 2099 | |
| 2100 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* | |
| 2101 Make PROCESS see end-of-file in its input. | |
| 2102 PROCESS may be a process, a buffer, the name of a process or buffer, or | |
| 2103 nil, indicating the current buffer's process. | |
| 2104 If PROCESS is a network connection, or is a process communicating | |
| 2105 through a pipe (as opposed to a pty), then you cannot send any more | |
| 2106 text to PROCESS after you call this function. | |
| 2107 */ | |
| 2108 (process)) | |
| 2109 { | |
| 2110 /* This function can GC */ | |
| 444 | 2111 process = get_process (process); |
| 428 | 2112 |
| 2113 /* Make sure the process is really alive. */ | |
| 444 | 2114 if (! EQ (XPROCESS (process)->status_symbol, Qrun)) |
| 563 | 2115 invalid_operation ("Process not running", process); |
| 428 | 2116 |
| 444 | 2117 if (!MAYBE_INT_PROCMETH (process_send_eof, (process))) |
| 428 | 2118 { |
| 444 | 2119 if (!NILP (DATA_OUTSTREAM (XPROCESS (process)))) |
| 428 | 2120 { |
| 853 | 2121 USID humpty, dumpty; |
| 444 | 2122 Lstream_close (XLSTREAM (DATA_OUTSTREAM (XPROCESS (process)))); |
| 853 | 2123 event_stream_delete_io_streams (Qnil, |
| 2124 XPROCESS (process)->pipe_outstream, | |
| 2125 Qnil, &humpty, &dumpty); | |
| 444 | 2126 XPROCESS (process)->pipe_outstream = Qnil; |
| 2127 XPROCESS (process)->coding_outstream = Qnil; | |
| 428 | 2128 } |
| 2129 } | |
| 2130 | |
| 2131 return process; | |
| 2132 } | |
| 2133 | |
| 2134 | |
| 2135 /************************************************************************/ | |
| 2136 /* deleting a process */ | |
| 2137 /************************************************************************/ | |
| 2138 | |
| 2139 void | |
| 444 | 2140 deactivate_process (Lisp_Object process) |
| 428 | 2141 { |
| 444 | 2142 Lisp_Process *p = XPROCESS (process); |
| 853 | 2143 USID in_usid, err_usid; |
| 428 | 2144 |
| 2145 /* It's possible that we got as far in the process-creation | |
| 2146 process as creating the descriptors but didn't get so | |
| 2147 far as selecting the process for input. In this | |
| 2148 case, p->pid is nil: p->pid is set at the same time that | |
| 2149 the process is selected for input. */ | |
| 2150 /* #### The comment does not look correct. event_stream_unselect_process | |
| 853 | 2151 is guarded by process->*_selected, so this is not a problem. - kkm*/ |
| 428 | 2152 /* Must call this before setting the streams to nil */ |
| 853 | 2153 event_stream_unselect_process (p, 1, 1); |
| 428 | 2154 |
| 2155 if (!NILP (DATA_OUTSTREAM (p))) | |
| 2156 Lstream_close (XLSTREAM (DATA_OUTSTREAM (p))); | |
| 2157 if (!NILP (DATA_INSTREAM (p))) | |
| 2158 Lstream_close (XLSTREAM (DATA_INSTREAM (p))); | |
| 853 | 2159 if (!NILP (DATA_ERRSTREAM (p))) |
| 2160 Lstream_close (XLSTREAM (DATA_ERRSTREAM (p))); | |
| 428 | 2161 |
| 2162 /* Provide minimal implementation for deactivate_process | |
| 2163 if there's no process-specific one */ | |
| 2164 if (HAS_PROCMETH_P (deactivate_process)) | |
| 853 | 2165 PROCMETH (deactivate_process, (p, &in_usid, &err_usid)); |
| 428 | 2166 else |
| 853 | 2167 event_stream_delete_io_streams (p->pipe_instream, |
| 2168 p->pipe_outstream, | |
| 2169 p->pipe_errstream, | |
| 2170 &in_usid, &err_usid); | |
| 428 | 2171 |
| 853 | 2172 if (in_usid != USID_DONTHASH) |
| 2367 | 2173 remhash ((const void *) in_usid, usid_to_process); |
| 853 | 2174 if (err_usid != USID_DONTHASH) |
| 2367 | 2175 remhash ((const void *) err_usid, usid_to_process); |
| 428 | 2176 |
| 2177 p->pipe_instream = Qnil; | |
| 2178 p->pipe_outstream = Qnil; | |
| 853 | 2179 p->pipe_errstream = Qnil; |
| 428 | 2180 p->coding_instream = Qnil; |
| 2181 p->coding_outstream = Qnil; | |
| 853 | 2182 p->coding_errstream = Qnil; |
| 428 | 2183 } |
| 2184 | |
| 2185 static void | |
| 444 | 2186 remove_process (Lisp_Object process) |
| 428 | 2187 { |
| 444 | 2188 Vprocess_list = delq_no_quit (process, Vprocess_list); |
| 428 | 2189 |
| 444 | 2190 deactivate_process (process); |
| 428 | 2191 } |
| 2192 | |
| 2193 DEFUN ("delete-process", Fdelete_process, 1, 1, 0, /* | |
| 2194 Delete PROCESS: kill it and forget about it immediately. | |
| 2195 PROCESS may be a process or the name of one, or a buffer name. | |
| 2196 */ | |
| 444 | 2197 (process)) |
| 428 | 2198 { |
| 2199 /* This function can GC */ | |
| 440 | 2200 Lisp_Process *p; |
| 444 | 2201 process = get_process (process); |
| 2202 p = XPROCESS (process); | |
| 2203 if (network_connection_p (process)) | |
| 428 | 2204 { |
| 2205 p->status_symbol = Qexit; | |
| 2206 p->exit_code = 0; | |
| 2207 p->core_dumped = 0; | |
| 2208 p->tick++; | |
| 2209 process_tick++; | |
| 2210 } | |
| 440 | 2211 else if (PROCESS_LIVE_P (p)) |
| 428 | 2212 { |
| 444 | 2213 Fkill_process (process, Qnil); |
| 428 | 2214 /* Do this now, since remove_process will make sigchld_handler do nothing. */ |
| 2215 p->status_symbol = Qsignal; | |
| 2216 p->exit_code = SIGKILL; | |
| 2217 p->core_dumped = 0; | |
| 2218 p->tick++; | |
| 2219 process_tick++; | |
| 2220 status_notify (); | |
| 2221 } | |
| 444 | 2222 remove_process (process); |
| 428 | 2223 return Qnil; |
| 2224 } | |
| 2225 | |
| 2226 /* Kill all processes associated with `buffer'. | |
| 2227 If `buffer' is nil, kill all processes */ | |
| 2228 | |
| 2229 void | |
| 2230 kill_buffer_processes (Lisp_Object buffer) | |
| 2231 { | |
| 444 | 2232 LIST_LOOP_2 (process, Vprocess_list) |
| 2233 if ((NILP (buffer) || EQ (XPROCESS (process)->buffer, buffer))) | |
| 2234 { | |
| 2235 if (network_connection_p (process)) | |
| 2236 Fdelete_process (process); | |
| 2237 else if (PROCESS_LIVE_P (XPROCESS (process))) | |
| 2238 process_send_signal (process, SIGHUP, 0, 1); | |
| 2239 } | |
| 428 | 2240 } |
| 2241 | |
| 2242 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* | |
| 2243 Say no query needed if PROCESS is running when Emacs is exited. | |
| 2244 Optional second argument if non-nil says to require a query. | |
| 2245 Value is t if a query was formerly required. | |
| 2246 */ | |
| 444 | 2247 (process, require_query_p)) |
| 428 | 2248 { |
| 2249 int tem; | |
| 2250 | |
| 444 | 2251 CHECK_PROCESS (process); |
| 2252 tem = XPROCESS (process)->kill_without_query; | |
| 2253 XPROCESS (process)->kill_without_query = NILP (require_query_p); | |
| 428 | 2254 |
| 2255 return tem ? Qnil : Qt; | |
| 2256 } | |
| 2257 | |
| 2258 DEFUN ("process-kill-without-query-p", Fprocess_kill_without_query_p, 1, 1, 0, /* | |
| 444 | 2259 Return t if PROCESS will be killed without query when emacs is exited. |
| 428 | 2260 */ |
| 444 | 2261 (process)) |
| 428 | 2262 { |
| 444 | 2263 CHECK_PROCESS (process); |
| 2264 return XPROCESS (process)->kill_without_query ? Qt : Qnil; | |
| 428 | 2265 } |
| 2266 | |
| 2267 | |
| 2268 #if 0 | |
| 2269 | |
| 826 | 2270 DEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* |
| 428 | 2271 Return the connection type of `PROCESS'. This can be nil (pipe), |
| 2272 t or pty (pty) or stream (socket connection). | |
| 2273 */ | |
| 2274 (process)) | |
| 2275 { | |
| 2276 return XPROCESS (process)->type; | |
| 2277 } | |
| 2278 | |
| 2279 #endif /* 0 */ | |
| 2280 | |
| 814 | 2281 |
| 2282 static int | |
| 867 | 2283 getenv_internal (const Ibyte *var, |
| 814 | 2284 Bytecount varlen, |
| 867 | 2285 Ibyte **value, |
| 814 | 2286 Bytecount *valuelen) |
| 2287 { | |
| 2288 Lisp_Object scan; | |
| 2289 | |
| 2290 assert (env_initted); | |
| 2291 | |
| 2292 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
| 2293 { | |
| 2294 Lisp_Object entry = XCAR (scan); | |
| 2295 | |
| 2296 if (STRINGP (entry) | |
| 2297 && XSTRING_LENGTH (entry) > varlen | |
| 826 | 2298 && string_byte (entry, varlen) == '=' |
| 814 | 2299 #ifdef WIN32_NATIVE |
| 2300 /* NT environment variables are case insensitive. */ | |
| 2301 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
| 2302 #else /* not WIN32_NATIVE */ | |
| 2303 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
| 2304 #endif /* not WIN32_NATIVE */ | |
| 2305 ) | |
| 2306 { | |
| 2307 *value = XSTRING_DATA (entry) + (varlen + 1); | |
| 2308 *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); | |
| 2309 return 1; | |
| 2310 } | |
| 2311 } | |
| 2312 | |
| 2313 return 0; | |
| 2314 } | |
| 2315 | |
| 2316 static void | |
| 867 | 2317 putenv_internal (const Ibyte *var, |
| 814 | 2318 Bytecount varlen, |
| 867 | 2319 const Ibyte *value, |
| 814 | 2320 Bytecount valuelen) |
| 2321 { | |
| 2322 Lisp_Object scan; | |
| 2323 | |
| 2324 assert (env_initted); | |
| 2325 | |
| 2326 for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) | |
| 2327 { | |
| 2328 Lisp_Object entry = XCAR (scan); | |
| 2329 | |
| 2330 if (STRINGP (entry) | |
| 2331 && XSTRING_LENGTH (entry) > varlen | |
| 826 | 2332 && string_byte (entry, varlen) == '=' |
| 814 | 2333 #ifdef WIN32_NATIVE |
| 2334 /* NT environment variables are case insensitive. */ | |
| 2335 && ! memicmp (XSTRING_DATA (entry), var, varlen) | |
| 2336 #else /* not WIN32_NATIVE */ | |
| 2337 && ! memcmp (XSTRING_DATA (entry), var, varlen) | |
| 2338 #endif /* not WIN32_NATIVE */ | |
| 2339 ) | |
| 2340 { | |
| 2341 XCAR (scan) = concat3 (make_string (var, varlen), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2342 build_ascstring ("="), |
| 814 | 2343 make_string (value, valuelen)); |
| 2344 return; | |
| 2345 } | |
| 2346 } | |
| 2347 | |
| 2348 Vprocess_environment = Fcons (concat3 (make_string (var, varlen), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2349 build_ascstring ("="), |
| 814 | 2350 make_string (value, valuelen)), |
| 2351 Vprocess_environment); | |
| 2352 } | |
| 2353 | |
| 2354 /* NOTE: | |
| 2355 | |
| 2356 FSF has this as a Lisp function, as follows. Generally moving things | |
| 2357 out of C and into Lisp is a good idea, but in this case the Lisp | |
| 2358 function is used so early in the startup sequence that it would be ugly | |
| 2359 to rearrange the early dumped code to accommodate this. | |
| 854 | 2360 |
| 814 | 2361 (defun getenv (variable) |
| 2362 "Get the value of environment variable VARIABLE. | |
| 2363 VARIABLE should be a string. Value is nil if VARIABLE is undefined in | |
| 2364 the environment. Otherwise, value is a string. | |
| 2365 | |
| 2366 This function consults the variable `process-environment' | |
| 2367 for its value." | |
| 2368 (interactive (list (read-envvar-name "Get environment variable: " t))) | |
| 2369 (let ((value (getenv-internal variable))) | |
| 2370 (when (interactive-p) | |
| 2371 (message "%s" (if value value "Not set"))) | |
| 2372 value)) | |
| 2373 */ | |
| 2374 | |
| 2375 DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /* | |
| 2376 Return the value of environment variable VAR, as a string. | |
| 2377 VAR is a string, the name of the variable. | |
| 2378 When invoked interactively, prints the value in the echo area. | |
| 2379 */ | |
| 2380 (var, interactivep)) | |
| 2381 { | |
| 4932 | 2382 Ibyte *value = NULL; |
| 814 | 2383 Bytecount valuelen; |
| 2384 Lisp_Object v = Qnil; | |
| 2385 struct gcpro gcpro1; | |
| 2386 | |
| 2387 CHECK_STRING (var); | |
| 2388 GCPRO1 (v); | |
| 2389 if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var), | |
| 2390 &value, &valuelen)) | |
| 2391 v = make_string (value, valuelen); | |
| 2392 if (!NILP (interactivep)) | |
| 2393 { | |
| 2394 if (NILP (v)) | |
| 2395 message ("%s not defined in environment", XSTRING_DATA (var)); | |
| 2396 else | |
| 2397 /* #### Should use Fprin1_to_string or Fprin1 to handle string | |
| 2398 containing quotes correctly. */ | |
| 2399 message ("\"%s\"", value); | |
| 2400 } | |
| 2401 RETURN_UNGCPRO (v); | |
| 2402 } | |
| 2403 | |
| 2404 /* A version of getenv that consults Vprocess_environment, easily | |
| 2405 callable from C. | |
| 2406 | |
| 2407 (At init time, Vprocess_environment is initialized from the | |
| 2408 environment, stored in the global variable environ. [Note that | |
| 2409 at startup time, `environ' should be the same as the envp parameter | |
| 2410 passed to main(); however, later calls to putenv() may change | |
| 2411 `environ', making the envp parameter inaccurate.] Calls to getenv() | |
| 2412 and putenv() consult and modify `environ'. However, once | |
| 2413 Vprocess_environment is initted, XEmacs C code should *NEVER* call | |
| 2414 getenv() or putenv() directly, because (1) Lisp code that modifies | |
| 2415 the environment only modifies Vprocess_environment, not `environ'; | |
| 2416 and (2) Vprocess_environment is in internal format but `environ' | |
| 2417 is in some external format, and getenv()/putenv() are not Mule- | |
| 2418 encapsulated. | |
| 2419 | |
| 2420 WARNING: This value points into Lisp string data and thus will become | |
| 2421 invalid after a GC. */ | |
| 2422 | |
| 867 | 2423 Ibyte * |
| 2424 egetenv (const CIbyte *var) | |
| 814 | 2425 { |
| 2426 /* This cannot GC -- 7-28-00 ben */ | |
| 867 | 2427 Ibyte *value; |
| 814 | 2428 Bytecount valuelen; |
| 2429 | |
| 867 | 2430 if (getenv_internal ((const Ibyte *) var, strlen (var), &value, &valuelen)) |
| 814 | 2431 return value; |
| 2432 else | |
| 2433 return 0; | |
| 2434 } | |
| 2435 | |
| 2436 void | |
| 867 | 2437 eputenv (const CIbyte *var, const CIbyte *value) |
| 814 | 2438 { |
| 867 | 2439 putenv_internal ((Ibyte *) var, strlen (var), (Ibyte *) value, |
| 814 | 2440 strlen (value)); |
| 2441 } | |
| 2442 | |
| 2443 | |
|
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2444 void |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2445 reinit_process_early (void) |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2446 { |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2447 OBJECT_HAS_METHOD (process, getprop); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2448 OBJECT_HAS_METHOD (process, putprop); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2449 OBJECT_HAS_METHOD (process, remprop); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2450 OBJECT_HAS_METHOD (process, plist); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2451 OBJECT_HAS_METHOD (process, setplist); |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2452 } |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2453 |
| 814 | 2454 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ |
| 2455 void | |
| 2456 init_xemacs_process (void) | |
| 2457 { | |
| 2458 /* This function can GC */ | |
| 2459 | |
| 2460 MAYBE_PROCMETH (init_process, ()); | |
| 2461 | |
| 2462 Vprocess_list = Qnil; | |
| 2463 | |
| 2464 if (usid_to_process) | |
| 2465 clrhash (usid_to_process); | |
| 2466 else | |
| 2467 usid_to_process = make_hash_table (32); | |
| 854 | 2468 |
| 814 | 2469 { |
| 2470 /* jwz: always initialize Vprocess_environment, so that egetenv() | |
| 2471 works in temacs. */ | |
| 2367 | 2472 Extbyte **envp; |
| 814 | 2473 Vprocess_environment = Qnil; |
| 2367 | 2474 #ifdef WIN32_NATIVE |
| 2475 _wgetenv (L""); /* force initialization of _wenviron */ | |
| 2476 for (envp = (Extbyte **) _wenviron; envp && *envp; envp++) | |
| 2477 Vprocess_environment = | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2478 Fcons (build_extstring (*envp, Qmswindows_unicode), |
| 2367 | 2479 Vprocess_environment); |
| 2480 #else | |
| 814 | 2481 for (envp = environ; envp && *envp; envp++) |
| 2482 Vprocess_environment = | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2483 Fcons (build_extstring (*envp, Qenvironment_variable_encoding), |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2484 Vprocess_environment); |
| 2367 | 2485 #endif |
| 814 | 2486 /* This gets set back to 0 in disksave_object_finalization() */ |
| 2487 env_initted = 1; | |
| 2488 } | |
| 2489 | |
| 2490 { | |
| 2491 /* Initialize shell-file-name from environment variables or best guess. */ | |
| 2492 #ifdef WIN32_NATIVE | |
| 867 | 2493 const Ibyte *shell = egetenv ("SHELL"); |
| 814 | 2494 if (!shell) shell = egetenv ("COMSPEC"); |
| 2495 /* Should never happen! */ | |
| 2496 if (!shell) shell = | |
| 867 | 2497 (Ibyte *) (GetVersion () & 0x80000000 ? "command" : "cmd"); |
| 814 | 2498 #else /* not WIN32_NATIVE */ |
| 867 | 2499 const Ibyte *shell = egetenv ("SHELL"); |
| 2500 if (!shell) shell = (Ibyte *) "/bin/sh"; | |
| 814 | 2501 #endif |
| 2502 | |
| 2503 #if 0 /* defined (WIN32_NATIVE) */ | |
| 2504 /* BAD BAD BAD. We do not wanting to be passing an XEmacs-created | |
| 2505 SHELL var down to some inferior Cygwin process, which might get | |
| 2506 screwed up. | |
| 854 | 2507 |
| 814 | 2508 There are a few broken apps (eterm/term.el, eterm/tshell.el, |
| 2509 os-utils/terminal.el, texinfo/tex-mode.el) where this will | |
| 2510 cause problems. Those broken apps don't look at | |
| 2511 shell-file-name, instead just at explicit-shell-file-name, | |
| 2512 ESHELL and SHELL. They are apparently attempting to borrow | |
| 2513 what `M-x shell' uses, but that latter also looks at | |
| 2514 shell-file-name. What we want is for all of these apps to look | |
| 2515 at shell-file-name, so that the user can change the value of | |
| 2516 shell-file-name and everything will work out hunky-dorey. | |
| 2517 */ | |
| 854 | 2518 |
| 814 | 2519 if (!egetenv ("SHELL")) |
| 2520 { | |
| 2367 | 2521 Ibyte *faux_var = alloca_ibytes (7 + qxestrlen (shell)); |
| 814 | 2522 qxesprintf (faux_var, "SHELL=%s", shell); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2523 Vprocess_environment = Fcons (build_istring (faux_var), |
| 814 | 2524 Vprocess_environment); |
| 2525 } | |
| 2526 #endif /* 0 */ | |
| 2527 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2528 Vshell_file_name = build_istring (shell); |
| 814 | 2529 } |
|
5255
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2530 |
|
b5611afbcc76
Support process plists, for greater GNU compatibility.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
2531 reinit_process_early (); |
| 814 | 2532 } |
| 2533 | |
| 428 | 2534 void |
| 2535 syms_of_process (void) | |
| 2536 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
2537 INIT_LISP_OBJECT (process); |
| 442 | 2538 |
| 563 | 2539 DEFSYMBOL (Qprocessp); |
| 2540 DEFSYMBOL (Qprocess_live_p); | |
| 2541 DEFSYMBOL (Qrun); | |
| 2542 DEFSYMBOL (Qstop); | |
| 2543 DEFSYMBOL (Qopen); | |
| 2544 DEFSYMBOL (Qclosed); | |
| 863 | 2545 #if 0 |
| 2546 /* see comment at Fprocess_readable_p */ | |
| 2547 DEFSYMBOL (&Qprocess_readable_p); | |
| 2548 #endif | |
| 563 | 2549 DEFSYMBOL (Qtcp); |
| 2550 DEFSYMBOL (Qudp); | |
| 428 | 2551 |
| 2552 #ifdef HAVE_MULTICAST | |
| 563 | 2553 DEFSYMBOL (Qmulticast); /* Used for occasional warnings */ |
| 428 | 2554 #endif |
| 2555 | |
| 563 | 2556 DEFERROR_STANDARD (Qprocess_error, Qio_error); |
| 2557 DEFERROR_STANDARD (Qnetwork_error, Qio_error); | |
| 2558 | |
| 428 | 2559 DEFSUBR (Fprocessp); |
| 440 | 2560 DEFSUBR (Fprocess_live_p); |
| 863 | 2561 #if 0 |
| 2562 /* see comment at Fprocess_readable_p */ | |
| 2563 DEFSUBR (Fprocess_readable_p); | |
| 2564 #endif | |
| 428 | 2565 DEFSUBR (Fget_process); |
| 2566 DEFSUBR (Fget_buffer_process); | |
| 2567 DEFSUBR (Fdelete_process); | |
| 2568 DEFSUBR (Fprocess_status); | |
| 2569 DEFSUBR (Fprocess_exit_status); | |
| 2570 DEFSUBR (Fprocess_id); | |
| 2571 DEFSUBR (Fprocess_name); | |
| 2572 DEFSUBR (Fprocess_tty_name); | |
| 2573 DEFSUBR (Fprocess_command); | |
| 859 | 2574 DEFSUBR (Fprocess_has_separate_stderr_p); |
| 428 | 2575 DEFSUBR (Fset_process_buffer); |
| 853 | 2576 DEFSUBR (Fset_process_stderr_buffer); |
| 428 | 2577 DEFSUBR (Fprocess_buffer); |
| 2578 DEFSUBR (Fprocess_mark); | |
| 853 | 2579 DEFSUBR (Fprocess_stderr_buffer); |
| 2580 DEFSUBR (Fprocess_stderr_mark); | |
| 428 | 2581 DEFSUBR (Fset_process_filter); |
| 2582 DEFSUBR (Fprocess_filter); | |
| 853 | 2583 DEFSUBR (Fset_process_stderr_filter); |
| 2584 DEFSUBR (Fprocess_stderr_filter); | |
| 428 | 2585 DEFSUBR (Fset_process_window_size); |
| 2586 DEFSUBR (Fset_process_sentinel); | |
| 2587 DEFSUBR (Fprocess_sentinel); | |
| 2588 DEFSUBR (Fprocess_kill_without_query); | |
| 2589 DEFSUBR (Fprocess_kill_without_query_p); | |
| 2590 DEFSUBR (Fprocess_list); | |
| 2591 DEFSUBR (Fstart_process_internal); | |
| 2592 #ifdef HAVE_SOCKETS | |
| 2593 DEFSUBR (Fopen_network_stream_internal); | |
| 2594 #ifdef HAVE_MULTICAST | |
| 2595 DEFSUBR (Fopen_multicast_group_internal); | |
| 2596 #endif /* HAVE_MULTICAST */ | |
| 2597 #endif /* HAVE_SOCKETS */ | |
| 2598 DEFSUBR (Fprocess_send_region); | |
| 2599 DEFSUBR (Fprocess_send_string); | |
| 442 | 2600 DEFSUBR (Fprocess_send_signal); |
| 428 | 2601 DEFSUBR (Finterrupt_process); |
| 2602 DEFSUBR (Fkill_process); | |
| 2603 DEFSUBR (Fquit_process); | |
| 2604 DEFSUBR (Fstop_process); | |
| 2605 DEFSUBR (Fcontinue_process); | |
| 2606 DEFSUBR (Fprocess_send_eof); | |
| 2607 DEFSUBR (Fsignal_process); | |
| 2608 /* DEFSUBR (Fprocess_connection); */ | |
| 2609 DEFSUBR (Fprocess_input_coding_system); | |
| 2610 DEFSUBR (Fprocess_output_coding_system); | |
| 2611 DEFSUBR (Fset_process_input_coding_system); | |
| 2612 DEFSUBR (Fset_process_output_coding_system); | |
| 2613 DEFSUBR (Fprocess_coding_system); | |
| 2614 DEFSUBR (Fset_process_coding_system); | |
| 814 | 2615 DEFSUBR (Fgetenv); |
| 428 | 2616 } |
| 2617 | |
| 2618 void | |
| 2619 vars_of_process (void) | |
| 2620 { | |
| 2621 Fprovide (intern ("subprocesses")); | |
| 2622 #ifdef HAVE_SOCKETS | |
| 2623 Fprovide (intern ("network-streams")); | |
| 2624 #ifdef HAVE_MULTICAST | |
| 2625 Fprovide (intern ("multicast")); | |
| 2626 #endif /* HAVE_MULTICAST */ | |
| 2627 #endif /* HAVE_SOCKETS */ | |
| 2628 staticpro (&Vprocess_list); | |
| 2629 | |
| 2630 DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes /* | |
| 2631 *Non-nil means delete processes immediately when they exit. | |
| 2632 nil means don't delete them until `list-processes' is run. | |
| 2633 */ ); | |
| 2634 | |
| 2635 delete_exited_processes = 1; | |
| 2636 | |
| 442 | 2637 DEFVAR_CONST_LISP ("null-device", &Vnull_device /* |
| 2638 Name of the null device, which differs from system to system. | |
| 2639 The null device is a filename that acts as a sink for arbitrary amounts of | |
| 2640 data, which is discarded, or as a source for a zero-length file. | |
| 2641 It is available on all the systems that we currently support, but with | |
| 2642 different names (typically either `/dev/null' or `nul'). | |
| 2643 | |
| 2644 Note that there is also a /dev/zero on most modern Unix versions (including | |
| 2645 Cygwin), which acts like /dev/null when used as a sink, but as a source | |
| 2646 it sends a non-ending stream of zero bytes. It's used most often along | |
| 2647 with memory-mapping. We don't provide a Lisp variable for this because | |
| 2648 the operations needing this are lower level than what ELisp programs | |
| 2649 typically do, and in any case no equivalent exists under native MS Windows. | |
| 2650 */ ); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2651 Vnull_device = build_ascstring (NULL_DEVICE); |
| 442 | 2652 |
| 428 | 2653 DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type /* |
| 2654 Control type of device used to communicate with subprocesses. | |
| 2655 Values are nil to use a pipe, or t or `pty' to use a pty. | |
| 2656 The value has no effect if the system has no ptys or if all ptys are busy: | |
| 2657 then a pipe is used in any case. | |
| 2658 The value takes effect when `start-process' is called. | |
| 2659 */ ); | |
| 2660 Vprocess_connection_type = Qt; | |
| 2661 | |
| 2662 DEFVAR_BOOL ("windowed-process-io", &windowed_process_io /* | |
| 2663 Enables input/output on standard handles of a windowed process. | |
| 2664 When this variable is nil (the default), XEmacs does not attempt to read | |
| 2665 standard output handle of a windowed process. Instead, the process is | |
| 2666 immediately marked as exited immediately upon successful launching. This is | |
| 2667 done because normal windowed processes do not use standard I/O, as they are | |
| 2668 not connected to any console. | |
| 2669 | |
| 2670 When launching a specially crafted windowed process, which expects to be | |
| 2671 launched by XEmacs, or by other program which pipes its standard input and | |
| 2672 output, this variable must be set to non-nil, in which case XEmacs will | |
| 2673 treat this process just like a console process. | |
| 2674 | |
| 2675 NOTE: You should never set this variable, only bind it. | |
| 2676 | |
| 2677 Only Windows processes can be "windowed" or "console". This variable has no | |
| 2678 effect on UNIX processes, because all UNIX processes are "console". | |
| 2679 */ ); | |
| 2680 windowed_process_io = 0; | |
| 2681 | |
| 771 | 2682 DEFVAR_INT ("debug-process-io", &debug_process_io /* |
| 2683 If non-zero, display data sent to or received from a process. | |
| 2684 */ ); | |
| 2685 debug_process_io = 0; | |
| 2686 | |
| 2687 DEFVAR_LISP ("default-process-coding-system", | |
| 2688 &Vdefault_process_coding_system /* | |
| 2689 Cons of coding systems used for process I/O by default. | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2690 May also be nil, interpreted as (nil . nil). |
| 771 | 2691 The car part is used for reading (decoding) data from a process, and |
| 2692 the cdr part is used for writing (encoding) data to a process. | |
| 2693 */ ); | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2694 /* Better, system-dependent defaults are set in code-init.el. */ |
| 771 | 2695 Vdefault_process_coding_system = Fcons (Qundecided, Qnil); |
| 2696 | |
| 853 | 2697 DEFVAR_LISP ("default-network-coding-system", |
| 2698 &Vdefault_network_coding_system /* | |
| 2699 Cons of coding systems used for network I/O by default. | |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2700 May also be nil, interpreted as (nil . nil). |
| 853 | 2701 The car part is used for reading (decoding) data from a process, and |
| 2702 the cdr part is used for writing (encoding) data to a process. | |
| 2703 */ ); | |
| 2704 Vdefault_network_coding_system = Fcons (Qundecided, Qnil); | |
| 2705 | |
| 428 | 2706 #ifdef PROCESS_IO_BLOCKING |
| 2707 DEFVAR_LISP ("network-stream-blocking-port-list", &network_stream_blocking_port_list /* | |
| 2708 List of port numbers or port names to set a blocking I/O mode with connection. | |
| 862 | 2709 Nil value means to set a default (non-blocking) I/O mode. |
| 428 | 2710 The value takes effect when `open-network-stream-internal' is called. |
| 2711 */ ); | |
| 2712 network_stream_blocking_port_list = Qnil; | |
| 2713 #endif /* PROCESS_IO_BLOCKING */ | |
| 814 | 2714 |
| 2715 /* This function can GC */ | |
| 2716 DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* | |
| 2717 *File name to load inferior shells from. | |
| 2718 Initialized from the SHELL environment variable. | |
| 2719 */ ); | |
| 428 | 2720 |
|
4729
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2721 /* ben? thinks the format of this variable is "semi-bogus". |
|
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2722 sjt doesn't agree, since it captures a restriction that is |
|
428d7c571110
Fix issue145: accept nil in default-process-coding-system.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4693
diff
changeset
|
2723 present in POSIX shells, after all. */ |
| 814 | 2724 DEFVAR_LISP ("process-environment", &Vprocess_environment /* |
| 2725 List of environment variables for subprocesses to inherit. | |
| 2726 Each element should be a string of the form ENVVARNAME=VALUE. | |
| 2727 The environment which Emacs inherits is placed in this variable | |
| 2728 when Emacs starts. | |
| 2729 */ ); | |
| 2730 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
2731 Vlisp_EXEC_SUFFIXES = build_ascstring (EXEC_SUFFIXES); |
| 814 | 2732 staticpro (&Vlisp_EXEC_SUFFIXES); |
| 2733 } |