12:01 a.m.
SUPERSEDES 19756.55048.665411.506867(a)parhasard.net
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1295048129 0
# Node ID 8608eadee6bab31ac0bbd166b55457ab69cd8f54
# Parent 906ccc7dcd7001e28c65e63ebf91c8a53751addf
Move #'delq, #'delete to Lisp, adding support for sequences.
src/ChangeLog addition:
2011-01-11 Aidan Kehoe <kehoea(a)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(a)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.
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>
+
+ * 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>
* 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
＠＠ -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(a)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(a)parhasard.net>
* mc-alloc.c (get_used_list_index):
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'.
＠＠ -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);
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 */
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches