changeset: 5255:b5611afbcc76 tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Thu Sep 02 12:23:11 2010 +0100 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 description: Support process plists, for greater GNU compatibility. src/ChangeLog addition: 2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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. diff -r 1537701f08a1 -r b5611afbcc76 lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)xemacs.org&gt; * files.el (save-some-buffers-action-alist): Add. diff -r 1537701f08a1 -r b5611afbcc76 lisp/obsolete.el --- 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 diff -r 1537701f08a1 -r b5611afbcc76 src/ChangeLog --- a/src/ChangeLog Thu Sep 02 12:00:06 2010 +0100 +++ b/src/ChangeLog Thu Sep 02 12:23:11 2010 +0100 ＠＠ -38,6 +38,22 ＠＠ case, despite what the comments said. (Fmaplist, Fmapl, Fmapcon): Call maplist() with its new arguments. + +2010-09-02 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; diff -r 1537701f08a1 -r b5611afbcc76 src/emacs.c --- 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 */ diff -r 1537701f08a1 -r b5611afbcc76 src/fns.c --- 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)) { ＠＠ -3627,6 +3629,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 ＠＠ -6015,6 +6037,7 ＠＠ DEFSUBR (Fput); DEFSUBR (Fremprop); DEFSUBR (Fobject_plist); + DEFSUBR (Fobject_setplist); DEFSUBR (Fequal); DEFSUBR (Fequalp); DEFSUBR (Fold_equal); diff -r 1537701f08a1 -r b5611afbcc76 src/lrecord.h --- 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, diff -r 1537701f08a1 -r b5611afbcc76 src/process-slots.h --- 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 diff -r 1537701f08a1 -r b5611afbcc76 src/process.c --- a/src/process.c Thu Sep 02 12:00:06 2010 +0100 +++ b/src/process.c Thu Sep 02 12:23:11 2010 +0100 ＠＠ -169,6 +169,42 ＠＠ MAYBE_PROCMETH (print_process_data, (process, printcharfun)); 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 ＠＠ -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 diff -r 1537701f08a1 -r b5611afbcc76 src/symbols.c --- 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 _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/mailman/listinfo/xemacs-patches