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 */