Mercurial > hg > xemacs-beta
changeset 5338:8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
src/ChangeLog addition:
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* 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@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.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Fri, 14 Jan 2011 23:35:29 +0000 |
parents | 906ccc7dcd70 |
children | ba62563ec7c7 |
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 |
diffstat | 10 files changed, 115 insertions(+), 73 deletions(-) [+] |
line wrap: on
line diff
--- 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@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
--- 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 remq (item sequence) - `(remove* ,item ,sequence :test #'eq)) - +(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 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
--- 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,
--- 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
--- a/src/ChangeLog Fri Jan 14 23:23:30 2011 +0000 +++ b/src/ChangeLog Fri Jan 14 23:35:29 2011 +0000 @@ -10,6 +10,18 @@ * fns.c (Ffind): Use the correct subr information here, pass in the DEFAULT keyword argument value correctly. +2011-01-11 Aidan Kehoe <kehoea@parhasard.net> + + * 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@parhasard.net> * mc-alloc.c (get_used_list_index):
--- 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);
--- 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'. @@ -3166,20 +3151,6 @@ 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; -} - DEFUN ("old-delq", Fold_delq, 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-eq'. @@ -11790,9 +11761,7 @@ DEFSUBR (Fposition); DEFSUBR (Ffind); - DEFSUBR (Fdelete); DEFSUBR (Fold_delete); - DEFSUBR (Fdelq); DEFSUBR (Fold_delq); DEFSUBR (FdeleteX); DEFSUBR (FremoveX);
--- 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);
--- 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. */
--- 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 */