changeset: 5396:8608eadee6ba user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Fri Jan 14 23:35:29 2011 +0000 files: lisp/ChangeLog lisp/cl-macs.el lisp/subr.el lisp/update-elc.el src/ChangeLog src/device-msw.c src/fns.c src/lisp.h src/select.c src/symbols.c description: Move #'delq, #'delete to Lisp, adding support for sequences. src/ChangeLog addition: 2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * device-msw.c (Fmswindows_printer_list): Remove a Fdelete () call here, remove the necessity for it. * fns.c (Fdelete, Fdelq): * lisp.h: Move #'delete, #'delq to Lisp, implemented in terms of #'delete* * select.c (Fown_selection_internal): * select.c (handle_selection_clear): Use delq_no_quit() in these functions, don't reimplement it or use Fdelq(), which is now gone. lisp/ChangeLog addition: 2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/ChangeLog --- a/lisp/ChangeLog Fri Jan 14 23:23:30 2011 +0000 +++ b/lisp/ChangeLog Fri Jan 14 23:35:29 2011 +0000 ＠＠ -1,3 +1,14 ＠＠ +2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * dialog.el (make-dialog-box): Correct a misplaced parenthesis diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/cl-macs.el --- a/lisp/cl-macs.el Fri Jan 14 23:23:30 2011 +0000 +++ b/lisp/cl-macs.el Fri Jan 14 23:35:29 2011 +0000 ＠＠ -3342,12 +3342,44 ＠＠ (list 'if (list* 'member* a list keys) list (list 'cons a list)) form)) -(define-compiler-macro remove (item sequence) - `(remove* ,item ,sequence :test #'equal)) +(define-compiler-macro delete (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val) + (characterp cl-const-expr-val))) + (cons 'delete* (cdr form)) + `(delete* ,＠(cdr form) :test #'equal))))) -(define-compiler-macro remq (item sequence) - `(remove* ,item ,sequence :test #'eq)) +(define-compiler-macro delq (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (not (cl-non-fixnum-number-p cl-const-expr-val))) + (cons 'delete* (cdr form)) + `(delete* ,＠(cdr form) :test #'eq))))) +(define-compiler-macro remove (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val) + (characterp cl-const-expr-val))) + (cons 'remove* (cdr form)) + `(remove* ,＠(cdr form) :test #'equal))))) + +(define-compiler-macro remq (&whole form &rest args) + (symbol-macrolet + ((not-constant '#:not-constant)) + (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant))) + (if (and (cdr form) (not (eq not-constant cl-const-expr-val)) + (not (cl-non-fixnum-number-p cl-const-expr-val))) + (cons 'remove* (cdr form)) + `(remove* ,＠(cdr form) :test #'eq))))) + (macrolet ((define-foo-if-compiler-macros (&rest alist) "Avoid the funcall, variable binding and keyword parsing overhead diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/subr.el --- a/lisp/subr.el Fri Jan 14 23:23:30 2011 +0000 +++ b/lisp/subr.el Fri Jan 14 23:35:29 2011 +0000 ＠＠ -148,6 +148,40 ＠＠ (define-function ,＠args)))  +(defun delete (item sequence) + "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. + +The modified SEQUENCE is returned. Comparison is done with `equal'. + +If the first member of a list SEQUENCE is ITEM, there is no way to remove it +by side effect; therefore, write `(setq foo (delete element foo))' to be +sure of changing the value of `foo'. Also see: `remove'." + (delete* item sequence :test #'equal)) + +(defun delq (item sequence) + "Delete by side effect any occurrences of ITEM as a member of SEQUENCE. + +The modified SEQUENCE is returned. Comparison is done with `eq'. If +SEQUENCE is a list and its first member is ITEM, there is no way to remove +it by side effect; therefore, write `(setq foo (delq element foo))' to be +sure of changing the value of `foo'." + (delete* item sequence :test #'eq)) + +(defun remove (item sequence) + "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'. + +This is a non-destructive function; it makes a copy of SEQUENCE if necessary +to avoid corrupting the original SEQUENCE. +Also see: `remove*', `delete', `delete*'" + (remove* item sequence :test #'equal)) + +(defun remq (item sequence) + "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'. + +This is a non-destructive function; it makes a copy of SEQUENCE to avoid +corrupting the original SEQUENCE. See also the more general `remove*'." + (remove* item sequence :test #'eq)) + (defun assoc-default (key alist &optional test default) "Find object KEY in a pseudo-alist ALIST. ALIST is a list of conses or objects. Each element (or the element's car, diff -r 906ccc7dcd70 -r 8608eadee6ba lisp/update-elc.el --- a/lisp/update-elc.el Fri Jan 14 23:23:30 2011 +0000 +++ b/lisp/update-elc.el Fri Jan 14 23:35:29 2011 +0000 ＠＠ -383,7 +383,10 ＠＠ (mapc #'(lambda (arg) (setq update-elc-files-to-compile - (delete arg update-elc-files-to-compile))) + (delete* arg update-elc-files-to-compile + :test (if default-file-system-ignore-case + #'equalp + #'equal)))) (append bc-bootstrap bootstrap-other)) (setq command-line-args (append diff -r 906ccc7dcd70 -r 8608eadee6ba src/ChangeLog --- a/src/ChangeLog Fri Jan 14 23:23:30 2011 +0000 +++ b/src/ChangeLog Fri Jan 14 23:35:29 2011 +0000 ＠＠ -9,6 +9,18 ＠＠ * fns.c (Ffind): Use the correct subr information here, pass in the DEFAULT keyword argument value correctly. + +2011-01-11 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * device-msw.c (Fmswindows_printer_list): Remove a Fdelete () + call here, remove the necessity for it. + * fns.c (Fdelete, Fdelq): + * lisp.h: + Move #'delete, #'delq to Lisp, implemented in terms of #'delete* + * select.c (Fown_selection_internal): + * select.c (handle_selection_clear): + Use delq_no_quit() in these functions, don't reimplement it or use + Fdelq(), which is now gone. 2011-01-10 Aidan Kehoe <kehoea(a)parhasard.net&gt; diff -r 906ccc7dcd70 -r 8608eadee6ba src/device-msw.c --- a/src/device-msw.c Fri Jan 14 23:23:30 2011 +0000 +++ b/src/device-msw.c Fri Jan 14 23:35:29 2011 +0000 ＠＠ -1329,9 +1329,12 ＠＠ GCPRO2 (result, def_printer); + def_printer = msprinter_default_printer (); + while (num_printers--) { Extbyte *printer_name; + Lisp_Object printer_name_lisp; if (have_nt) { PRINTER_INFO_4 *info = (PRINTER_INFO_4 *) data_buf; ＠＠ -1343,12 +1346,15 ＠＠ printer_name = (Extbyte *) info->pPrinterName; } data_buf += enum_entry_size; - - result = Fcons (build_tstr_string (printer_name), result); + + printer_name_lisp = build_tstr_string (printer_name); + if (0 != qxestrcasecmp (XSTRING_DATA (def_printer), + XSTRING_DATA (printer_name_lisp))) + { + result = Fcons (printer_name_lisp, result); + } } - def_printer = msprinter_default_printer (); - result = Fdelete (def_printer, result); result = Fcons (def_printer, result); RETURN_UNGCPRO (result); diff -r 906ccc7dcd70 -r 8608eadee6ba src/fns.c --- a/src/fns.c Fri Jan 14 23:23:30 2011 +0000 +++ b/src/fns.c Fri Jan 14 23:35:29 2011 +0000 ＠＠ -3137,21 +3137,6 ＠＠ return object; }  -DEFUN ("delete", Fdelete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delete element foo))' to be sure -of changing the value of `foo'. -Also see: `remove'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_equal (elt, list_elt, 0))); - return list; -} - DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* Delete by side effect any occurrences of ELT as a member of LIST. The modified LIST is returned. Comparison is done with `old-equal'. ＠＠ -3163,20 +3148,6 ＠＠ { EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, (internal_old_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("delq", Fdelq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); return list; } ＠＠ -11790,9 +11761,7 ＠＠ DEFSUBR (Fposition); DEFSUBR (Ffind); - DEFSUBR (Fdelete); DEFSUBR (Fold_delete); - DEFSUBR (Fdelq); DEFSUBR (Fold_delq); DEFSUBR (FdeleteX); DEFSUBR (FremoveX); diff -r 906ccc7dcd70 -r 8608eadee6ba src/lisp.h --- a/src/lisp.h Fri Jan 14 23:23:30 2011 +0000 +++ b/src/lisp.h Fri Jan 14 23:35:29 2011 +0000 ＠＠ -5209,8 +5209,6 ＠＠ EXFUN (Fcopy_list, 1); EXFUN (Fcopy_sequence, 1); EXFUN (Fcopy_tree, 2); -EXFUN (Fdelete, 2); -EXFUN (Fdelq, 2); EXFUN (Fdestructive_alist_to_plist, 1); EXFUN (Felt, 2); MODULE_API EXFUN (Fequal, 2); diff -r 906ccc7dcd70 -r 8608eadee6ba src/select.c --- a/src/select.c Fri Jan 14 23:23:30 2011 +0000 +++ b/src/select.c Fri Jan 14 23:35:29 2011 +0000 ＠＠ -183,19 +183,8 ＠＠ if (!NILP (local_selection_data)) { owned_p = 1; - /* Don't use Fdelq() as that may QUIT;. */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } + Vselection_alist + = delq_no_quit (local_selection_data, Vselection_alist); } } else ＠＠ -412,21 +401,8 ＠＠ /* Well, we already believe that we don't own it, so that's just fine. */ if (NILP (local_selection_data)) return; - /* Otherwise, we're really honest and truly being told to drop it. - Don't use Fdelq() as that may QUIT;. - */ - if (EQ (local_selection_data, Fcar (Vselection_alist))) - Vselection_alist = Fcdr (Vselection_alist); - else - { - Lisp_Object rest; - for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) - if (EQ (local_selection_data, Fcar (XCDR (rest)))) - { - XCDR (rest) = Fcdr (XCDR (rest)); - break; - } - } + /* Otherwise, we're really honest and truly being told to drop it. */ + Vselection_alist = delq_no_quit (local_selection_data, Vselection_alist); /* Let random lisp code notice that the selection has been stolen. */ diff -r 906ccc7dcd70 -r 8608eadee6ba src/symbols.c --- a/src/symbols.c Fri Jan 14 23:23:30 2011 +0000 +++ b/src/symbols.c Fri Jan 14 23:35:29 2011 +0000 ＠＠ -2546,7 +2546,8 ＠＠ = buffer_local_alist_element (current_buffer, variable, bfwd); if (!NILP (alist_element)) - current_buffer->local_var_alist = Fdelq (alist_element, alist); + current_buffer->local_var_alist = delq_no_quit (alist_element, + alist); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value */ _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches