Mercurial > hg > xemacs-beta
changeset 5255:b5611afbcc76
Support process plists, for greater GNU compatibility.
src/ChangeLog addition:
2010-09-02 Aidan Kehoe <kehoea@parhasard.net>
* process.c (process_getprop, process_putprop, process_remprop)
(process_plist, process_setplist, reinit_process_early):
Add functions to modify a process's property list.
* process-slots.h (MARKED_SLOT): Add a plist slot.
* fns.c (Fobject_setplist): New function, analogous to #'setplist,
but more general.
Update the documentation in the other plist functions to reflect
that processes now have property lists.
* emacs.c (main_1): Call reinit_process_early(), now processes have
plist methods that need to be initialised.
* symbols.c (reinit_symbol_objects_early): Fsetplist is the named
setplist method for symbols.
lisp/ChangeLog addition:
2010-09-02 Aidan Kehoe <kehoea@parhasard.net>
* obsolete.el (process-get):
Make #'process-get, #'process-put, #'process-plist,
#'set-process-plist available as aliases to the more general
functions #'get, #'put, #'object-plist, #'object-setplist, for GNU
compatibility.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Thu, 02 Sep 2010 12:23:11 +0100 |
parents | 1537701f08a1 |
children | 6c8f5574d4a1 |
files | lisp/ChangeLog lisp/obsolete.el src/ChangeLog src/emacs.c src/fns.c src/lrecord.h src/process-slots.h src/process.c src/symbols.c |
diffstat | 9 files changed, 109 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Sep 02 12:00:06 2010 +0100 +++ b/lisp/ChangeLog Thu Sep 02 12:23:11 2010 +0100 @@ -1,3 +1,11 @@ +2010-09-02 Aidan Kehoe <kehoea@parhasard.net> + + * obsolete.el (process-get): + Make #'process-get, #'process-put, #'process-plist, + #'set-process-plist available as aliases to the more general + functions #'get, #'put, #'object-plist, #'object-setplist, for GNU + compatibility. + 2010-08-20 Mike Sperber <mike@xemacs.org> * files.el (save-some-buffers-action-alist): Add.
--- a/lisp/obsolete.el Thu Sep 02 12:00:06 2010 +0100 +++ b/lisp/obsolete.el Thu Sep 02 12:23:11 2010 +0100 @@ -428,5 +428,10 @@ (define-function 'purecopy 'identity) (make-obsolete 'purecopy "purespace is not available in XEmacs.") +(define-compatible-function-alias 'process-get 'get) +(define-compatible-function-alias 'process-put 'put) +(define-compatible-function-alias 'process-plist 'object-plist) +(define-compatible-function-alias 'set-process-plist 'object-setplist) + (provide 'obsolete) ;;; obsolete.el ends here
--- a/src/ChangeLog Thu Sep 02 12:00:06 2010 +0100 +++ b/src/ChangeLog Thu Sep 02 12:23:11 2010 +0100 @@ -39,6 +39,22 @@ (Fmaplist, Fmapl, Fmapcon): Call maplist() with its new arguments. +2010-09-02 Aidan Kehoe <kehoea@parhasard.net> + + * process.c (process_getprop, process_putprop, process_remprop) + (process_plist, process_setplist, reinit_process_early): + Add functions to modify a process's property list. + * process-slots.h (MARKED_SLOT): Add a plist slot. + + * fns.c (Fobject_setplist): New function, analogous to #'setplist, + but more general. + Update the documentation in the other plist functions to reflect + that processes now have property lists. + * emacs.c (main_1): Call reinit_process_early(), now processes have + plist methods that need to be initialised. + * symbols.c (reinit_symbol_objects_early): Fsetplist is the named + setplist method for symbols. + 2010-08-30 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (ceiling_one_mundane_arg, floor_one_mundane_arg)
--- a/src/emacs.c Thu Sep 02 12:00:06 2010 +0100 +++ b/src/emacs.c Thu Sep 02 12:23:11 2010 +0100 @@ -1468,6 +1468,7 @@ reinit_alloc_early (); reinit_gc_early (); reinit_symbols_early (); + reinit_process_early (); #ifndef NEW_GC reinit_opaque_early (); #endif /* not NEW_GC */
--- a/src/fns.c Thu Sep 02 12:00:06 2010 +0100 +++ b/src/fns.c Thu Sep 02 12:23:11 2010 +0100 @@ -3545,7 +3545,8 @@ This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'. If there is no such property, return optional third arg DEFAULT \(which defaults to `nil'). OBJECT can be a symbol, string, extent, -face, or glyph. See also `put', `remprop', and `object-plist'. +face, glyph, or process. See also `put', `remprop', `object-plist', and +`object-setplist'. */ (object, property, default_)) { @@ -3589,9 +3590,10 @@ DEFUN ("remprop", Fremprop, 2, 2, 0, /* Remove, from OBJECT's property list, PROPERTY and its corresponding value. -OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil -if the property list was actually modified (i.e. if PROPERTY was present -in the property list). See also `get', `put', and `object-plist'. +OBJECT can be a symbol, string, extent, face, glyph, or process. +Return non-nil if the property list was actually modified (i.e. if PROPERTY +was present in the property list). See also `get', `put', `object-plist', +and `object-setplist'. */ (object, property)) { @@ -3628,6 +3630,26 @@ return Qnil; } +DEFUN ("object-setplist", Fobject_setplist, 2, 2, 0, /* +Set OBJECT's property list to NEWPLIST, and return NEWPLIST. +For a symbol, this is equivalent to `setplist'. + +OBJECT can be a symbol or a process, other objects with visible plists do +not allow their modification with `object-setplist'. +*/ + (object, newplist)) +{ + if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->setplist) + { + return XRECORD_LHEADER_IMPLEMENTATION (object)->setplist (object, + newplist); + } + + invalid_operation ("Not possible to set object's plist", object); + return Qnil; +} + + static Lisp_Object tweaked_internal_equal (Lisp_Object obj1, Lisp_Object obj2, @@ -6015,6 +6037,7 @@ DEFSUBR (Fput); DEFSUBR (Fremprop); DEFSUBR (Fobject_plist); + DEFSUBR (Fobject_setplist); DEFSUBR (Fequal); DEFSUBR (Fequalp); DEFSUBR (Fold_equal);
--- a/src/lrecord.h Thu Sep 02 12:00:06 2010 +0100 +++ b/src/lrecord.h Thu Sep 02 12:23:11 2010 +0100 @@ -525,6 +525,7 @@ int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); int (*remprop) (Lisp_Object obj, Lisp_Object prop); Lisp_Object (*plist) (Lisp_Object obj); + Lisp_Object (*setplist) (Lisp_Object obj, Lisp_Object newplist); /* `disksave' is called at dump time. It is used for objects that contain pointers or handles to objects created in external libraries,
--- a/src/process-slots.h Thu Sep 02 12:00:06 2010 +0100 +++ b/src/process-slots.h Thu Sep 02 12:23:11 2010 +0100 @@ -68,4 +68,6 @@ all of the Lisp objects, including in process-type-specific data. */ MARKED_SLOT (tty_name) + MARKED_SLOT (plist) + #undef MARKED_SLOT
--- a/src/process.c Thu Sep 02 12:00:06 2010 +0100 +++ b/src/process.c Thu Sep 02 12:23:11 2010 +0100 @@ -170,6 +170,42 @@ write_ascstring (printcharfun, ">"); } } +/* Process plists are directly accessible, so we need to protect against + invalid property list structure */ + +static Lisp_Object +process_getprop (Lisp_Object process, Lisp_Object property) +{ + return external_plist_get (&XPROCESS (process)->plist, property, 0, + ERROR_ME); +} + +static int +process_putprop (Lisp_Object process, Lisp_Object property, Lisp_Object value) +{ + external_plist_put (&XPROCESS (process)->plist, property, value, 0, + ERROR_ME); + return 1; +} + +static int +process_remprop (Lisp_Object process, Lisp_Object property) +{ + return external_remprop (&XPROCESS (process)->plist, property, 0, ERROR_ME); +} + +static Lisp_Object +process_plist (Lisp_Object process) +{ + return XPROCESS (process)->plist; +} + +static Lisp_Object +process_setplist (Lisp_Object process, Lisp_Object newplist) +{ + XPROCESS (process)->plist = newplist; + return newplist; +} #ifdef HAVE_WINDOW_SYSTEM extern void debug_process_finalization (Lisp_Process *p); @@ -2405,6 +2441,16 @@ } +void +reinit_process_early (void) +{ + OBJECT_HAS_METHOD (process, getprop); + OBJECT_HAS_METHOD (process, putprop); + OBJECT_HAS_METHOD (process, remprop); + OBJECT_HAS_METHOD (process, plist); + OBJECT_HAS_METHOD (process, setplist); +} + /* This is not named init_process in order to avoid a conflict with NS 3.3 */ void init_xemacs_process (void) @@ -2481,6 +2527,8 @@ Vshell_file_name = build_istring (shell); } + + reinit_process_early (); } void
--- a/src/symbols.c Thu Sep 02 12:00:06 2010 +0100 +++ b/src/symbols.c Thu Sep 02 12:23:11 2010 +0100 @@ -3530,6 +3530,7 @@ OBJECT_HAS_METHOD (symbol, putprop); OBJECT_HAS_METHOD (symbol, remprop); OBJECT_HAS_NAMED_METHOD (symbol, plist, Fsymbol_plist); + OBJECT_HAS_NAMED_METHOD (symbol, setplist, Fsetplist); } void