changeset 5583:10f179710250

Deprecate #'remassoc, #'remassq, #'remrassoc, #'remrassq. src/ChangeLog addition: 2011-10-09 Aidan Kehoe <kehoea@parhasard.net> * fns.c (remassoc_no_quit): * fns.c (remrassq_no_quit): * fns.c (syms_of_fns): * fontcolor-tty.c (Fregister_tty_color): * fontcolor-tty.c (Funregister_tty_color): * fontcolor-tty.c (Ffind_tty_color): * lisp.h: Remove Fremassq, Fremrassq, Fremassoc, Fremrassoc, they're XEmacs-specific functions and Lisp callers should use (delete* ... :key #'car) anyway. Keep the non-Lisp-visible _no_quit versions, calling FdeleteX from C with the appropriate arguments is ungainly. lisp/ChangeLog addition: 2011-10-09 Aidan Kehoe <kehoea@parhasard.net> * obsolete.el: * obsolete.el (assq-delete-all): * packages.el (package-provide): * packages.el (package-suppress): * mule/cyrillic.el ("Cyrillic-KOI8"): * mule/cyrillic.el (koi8-u): * mule/general-late.el (posix-charset-to-coding-system-hash): * mule/latin.el: * mule/latin.el (for): * cl-extra.el: * cl-extra.el (cl-extra): * loadup.el (load-history): Change any uses of #'remassq, #'remassoc and friends to calling #'delete* with an appropriate key argument. Provide compatibility implementations, mark them obsolete. man/ChangeLog addition: 2011-10-09 Aidan Kehoe <kehoea@parhasard.net> * lispref/lists.texi (Association Lists): Don't document #'remassoc, #'remassq and friends in detail; they're XEmacs-specific and (delete* ... :key #'car) is preferable.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 09 Oct 2011 12:55:51 +0100
parents 873d7425c1ad
children d469c668462e
files lisp/ChangeLog lisp/cl-extra.el lisp/loadup.el lisp/mule/cyrillic.el lisp/mule/general-late.el lisp/mule/latin.el lisp/obsolete.el lisp/packages.el man/ChangeLog man/lispref/lists.texi src/ChangeLog src/fns.c src/fontcolor-tty.c src/lisp.h
diffstat 14 files changed, 100 insertions(+), 131 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/ChangeLog	Sun Oct 09 12:55:51 2011 +0100
@@ -1,3 +1,21 @@
+2011-10-09  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* obsolete.el:
+	* obsolete.el (assq-delete-all):
+	* packages.el (package-provide):
+	* packages.el (package-suppress):
+	* mule/cyrillic.el ("Cyrillic-KOI8"):
+	* mule/cyrillic.el (koi8-u):
+	* mule/general-late.el (posix-charset-to-coding-system-hash):
+	* mule/latin.el:
+	* mule/latin.el (for):
+	* cl-extra.el:
+	* cl-extra.el (cl-extra):
+	* loadup.el (load-history):
+	Change any uses of #'remassq, #'remassoc and friends to calling
+	#'delete* with an appropriate key argument. Provide compatibility
+	implementations, mark them obsolete.
+
 2011-10-08  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el:
--- a/lisp/cl-extra.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/cl-extra.el	Sun Oct 09 12:55:51 2011 +0100
@@ -874,6 +874,30 @@
     (-1 (1- (length (format "%b" (- integer)))))
     (1 (length (format "%b" integer)))))
 
+;; These are here because labels and symbol-macrolet are not available in
+;; obsolete.el. They are, however, all marked as obsolete in that file.
+(symbol-macrolet ((not-nil '#:not-nil))
+  (labels ((car-or-not-nil (object)
+             (if (consp object) (car object) not-nil))
+           (cdr-or-not-nil (object)
+             (if (consp object) (cdr object) not-nil)))
+    (defalias 'remassoc
+      #'(lambda (key alist)
+         (delete* key alist :test #'equal
+                  :key (if key #'car-safe #'car-or-not-nil))))
+    (defalias 'remrassoc
+      #'(lambda (key alist)
+         (delete* key alist :test #'equal
+                  :key (if key #'cdr-safe #'cdr-or-not-nil))))
+    (defalias 'remrassq
+      #'(lambda (key alist)
+         (delete* key alist :test #'eq
+                  :key (if key #'cdr-safe #'cdr-or-not-nil))))
+    (defalias 'remassq
+      #'(lambda (key alist)
+         (delete* key alist :test #'eq
+                  :key (if key #'car-safe #'car-or-not-nil))))))
+
 (run-hooks 'cl-extra-load-hook)
 
 ;; XEmacs addition
--- a/lisp/loadup.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/loadup.el	Sun Oct 09 12:55:51 2011 +0100
@@ -225,7 +225,7 @@
                          (delete*
                           nil
                           (mapc #'(lambda (element)
-                                    (remassq 'defun element)
+                                    (delete* 'defun element :key #'car-safe)
                                     (delete-if
                                      #'(lambda (elt)
                                          (and
--- a/lisp/mule/cyrillic.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/mule/cyrillic.el	Sun Oct 09 12:55:51 2011 +0100
@@ -418,7 +418,7 @@
 
 (set-language-info-alist
  "Cyrillic-KOI8"
- (remassq 'locale (copy-list (cdr (assoc "Russian" language-info-alist))))
+ (remove* 'locale (cdr (assoc "Russian" language-info-alist)) :key #'car)
  '("Cyrillic"))
 
 ;; KOI8-U, for Ukrainian.
--- a/lisp/mule/general-late.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/mule/general-late.el	Sun Oct 09 12:55:51 2011 +0100
@@ -46,13 +46,13 @@
       ;; fraction faster for those languages.
       language-info-alist
       (cons (assoc "Japanese" language-info-alist)
-	    (remassoc "Japanese" language-info-alist))
+	    (delete* "Japanese" language-info-alist :test #'equal :key #'car))
       language-info-alist 
       (cons (assoc "German" language-info-alist)
-	    (remassoc "German" language-info-alist))
+	    (delete* "German" language-info-alist :test #'equal :key #'car))
       language-info-alist
       (cons (assoc "English" language-info-alist)
-	    (remassoc "English" language-info-alist))
+	    (delete* "English" language-info-alist :test #'equal :key #'car))
 
       ;; Make Installation-string actually reflect the environment at
       ;; byte-compile time. (We can't necessarily decode it when version.el
--- a/lisp/mule/latin.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/mule/latin.el	Sun Oct 09 12:55:51 2011 +0100
@@ -2056,6 +2056,6 @@
   (setcar assocked
           (upcase (symbol-name coding-system)))
   (setcdr assocked
-          (remassq 'locale (cdr assocked))))
+          (delete* 'locale (cdr assocked) :key #'car)))
 
 ;;; latin.el ends here
--- a/lisp/obsolete.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/obsolete.el	Sun Oct 09 12:55:51 2011 +0100
@@ -263,8 +263,8 @@
 
 (define-compatible-function-alias 'interactive-form 
   'function-interactive) ;GNU 21.1
-(define-compatible-function-alias 'assq-delete-all
-  'remassq) ;GNU 21.1
+(define-function 'assq-delete-all 'remassq) ;GNU 21.1
+(make-compatible 'assq-delete-all "use (delete* ITEM SEQUENCE :key #'car)")
 
 (defun makehash (&optional test)
   "Create a new hash table.
@@ -452,5 +452,15 @@
 (define-obsolete-variable-alias 'cl-macro-environment
   'byte-compile-macro-environment)
 
+;; Actual implementations of these functions are in cl-extra.el, after
+;; cl-macs is loaded, since those implementations use #'labels and
+;; #'symbol-macrolet. These APIs were always XEmacs-specific, were never
+;; widely used, and it was always more readable and more compatible to use
+;; the CL functions.
+(make-obsolete 'remassoc "use delete* with :test #'equal, :key #'car")
+(make-obsolete 'remassq "use delete* with :test #'eq, :key #'car")
+(make-obsolete 'remrassoc "use delete* with :test #'equal, :key #'cdr")
+(make-obsolete 'remrassq "use delete* with :test #'eq, :key #'cdr")
+
 (provide 'obsolete)
 ;;; obsolete.el ends here
--- a/lisp/packages.el	Sun Oct 09 10:39:09 2011 +0100
+++ b/lisp/packages.el	Sun Oct 09 12:55:51 2011 +0100
@@ -111,7 +111,8 @@
 		  (list :version (car attributes))
 		attributes)))
     (setq packages-package-list
-	  (cons (cons name info) (remassq name packages-package-list)))))
+	  (cons (cons name info) (delete* name packages-package-list
+                                          :test #'eq :key #'car)))))
 
 (defun package-suppress (package file form)
   "Set up a package-suppress condition FORM for FILE in PACKAGE.
--- a/man/ChangeLog	Sun Oct 09 10:39:09 2011 +0100
+++ b/man/ChangeLog	Sun Oct 09 12:55:51 2011 +0100
@@ -1,3 +1,10 @@
+2011-10-09  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lispref/lists.texi (Association Lists):
+	Don't document #'remassoc, #'remassq and friends in detail;
+	they're XEmacs-specific and (delete* ... :key #'car) is
+	preferable.
+
 2011-10-09  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* internals/internals.texi (Top):
--- a/man/lispref/lists.texi	Sun Oct 09 10:39:09 2011 +0100
+++ b/man/lispref/lists.texi	Sun Oct 09 12:55:51 2011 +0100
@@ -1451,7 +1451,8 @@
   In XEmacs Lisp, it is @emph{not} an error if an element of an
 association list is not a cons cell.  The alist search functions simply
 ignore such elements.  Many other versions of Lisp signal errors in such
-cases.
+cases, and it is good practice to avoid adding non-cons-cells to association
+lists.
 
   Note that property lists are similar to association lists in several
 respects.  A property list behaves like an association list in which
@@ -1569,57 +1570,6 @@
 @end smallexample
 @end defun
 
-@defun remassoc key alist
-This function deletes by side effect any associations with key @var{key}
-in @var{alist}---i.e. it removes any elements from @var{alist} whose
-@code{car} is @code{equal} to @var{key}.  The modified @var{alist} is
-returned.
-
-If the first member of @var{alist} has a @code{car} that is @code{equal}
-to @var{key}, there is no way to remove it by side effect; therefore,
-write @code{(setq foo (remassoc key foo))} to be sure of changing the
-value of @code{foo}.
-@end defun
-
-@defun remassq key alist
-This function deletes by side effect any associations with key @var{key}
-in @var{alist}---i.e. it removes any elements from @var{alist} whose
-@code{car} is @code{eq} to @var{key}.  The modified @var{alist} is
-returned.
-
-This function is exactly like @code{remassoc}, but comparisons between
-@var{key} and keys in @var{alist} are done using @code{eq} instead of
-@code{equal}.
-@end defun
-
-@defun remrassoc value alist
-This function deletes by side effect any associations with value @var{value}
-in @var{alist}---i.e. it removes any elements from @var{alist} whose
-@code{cdr} is @code{equal} to @var{value}.  The modified @var{alist} is
-returned.
-
-If the first member of @var{alist} has a @code{car} that is @code{equal}
-to @var{value}, there is no way to remove it by side effect; therefore,
-write @code{(setq foo (remassoc value foo))} to be sure of changing the
-value of @code{foo}.
-
-@code{remrassoc} is like @code{remassoc} except that it compares the
-@sc{cdr} of each @var{alist} association instead of the @sc{car}.  You
-can think of this as ``reverse @code{remassoc}'', removing an association
-based on its value instead of its key.
-@end defun
-
-@defun remrassq value alist
-This function deletes by side effect any associations with value @var{value}
-in @var{alist}---i.e. it removes any elements from @var{alist} whose
-@code{cdr} is @code{eq} to @var{value}.  The modified @var{alist} is
-returned.
-
-This function is exactly like @code{remrassoc}, but comparisons between
-@var{value} and values in @var{alist} are done using @code{eq} instead of
-@code{equal}.
-@end defun
-
 @defun copy-alist alist
 @cindex copying alists
 This function returns a two-level deep copy of @var{alist}: it creates a
@@ -1671,6 +1621,14 @@
 @end smallexample
 @end defun
 
+For removing elements from alists, use @code{remove*} or @code{delete*} with
+appropriate @code{:key} arguments.  If it is necessary that XEmacs not error
+on encountering a non-cons in such a list, there are XEmacs-specific functions
+@code{remassq}, @code{remrassq}, @code{remassoc}, and @code{remrassoc} with
+this behavior, but they are neither available under GNU Emacs nor Common Lisp.
+They are marked as obsolete, and it is preferable to fix your code to avoid
+adding non-cons objects to alists.
+
 @node Property Lists
 @section Property Lists
 @cindex property list
--- a/src/ChangeLog	Sun Oct 09 10:39:09 2011 +0100
+++ b/src/ChangeLog	Sun Oct 09 12:55:51 2011 +0100
@@ -1,3 +1,18 @@
+2011-10-09  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (remassoc_no_quit):
+	* fns.c (remrassq_no_quit):
+	* fns.c (syms_of_fns):
+	* fontcolor-tty.c (Fregister_tty_color):
+	* fontcolor-tty.c (Funregister_tty_color):
+	* fontcolor-tty.c (Ffind_tty_color):
+	* lisp.h:
+	Remove Fremassq, Fremrassq, Fremassoc, Fremrassoc, they're
+	XEmacs-specific functions and Lisp callers should use (delete*
+	... :key #'car) anyway. Keep the non-Lisp-visible _no_quit
+	versions, calling FdeleteX from C with the appropriate arguments
+	is ungainly.
+
 2011-10-09  Aidan Kehoe  <kehoea@parhasard.net>
 
 	Do a couple of non-mechanical things that would otherwise have
--- a/src/fns.c	Sun Oct 09 10:39:09 2011 +0100
+++ b/src/fns.c	Sun Oct 09 12:55:51 2011 +0100
@@ -3642,41 +3642,12 @@
   return sequence;
 }
 
-DEFUN ("remassoc", Fremassoc, 2, 2, 0, /*
-Delete by side effect any elements of ALIST whose car is `equal' to KEY.
-The modified ALIST is returned.  If the first member of ALIST has a car
-that is `equal' to KEY, there is no way to remove it by side effect;
-therefore, write `(setq foo (remassoc key foo))' to be sure of changing
-the value of `foo'.
-*/
-       (key, alist))
-{
-  EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
-				(CONSP (elt) &&
-				 internal_equal (key, XCAR (elt), 0)));
-  return alist;
-}
-
 Lisp_Object
 remassoc_no_quit (Lisp_Object key, Lisp_Object alist)
 {
-  int speccount = specpdl_depth ();
-  specbind (Qinhibit_quit, Qt);
-  return unbind_to_1 (speccount, Fremassoc (key, alist));
-}
-
-DEFUN ("remassq", Fremassq, 2, 2, 0, /*
-Delete by side effect any elements of ALIST whose car is `eq' to KEY.
-The modified ALIST is returned.  If the first member of ALIST has a car
-that is `eq' to KEY, there is no way to remove it by side effect;
-therefore, write `(setq foo (remassq key foo))' to be sure of changing
-the value of `foo'.
-*/
-       (key, alist))
-{
-  EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
-				(CONSP (elt) &&
-				 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
+  LIST_LOOP_DELETE_IF (elt, alist,
+		       (CONSP (elt) &&
+                        internal_equal (key, XCAR (elt), 0)));
   return alist;
 }
 
@@ -3691,36 +3662,6 @@
   return alist;
 }
 
-DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /*
-Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE.
-The modified ALIST is returned.  If the first member of ALIST has a car
-that is `equal' to VALUE, there is no way to remove it by side effect;
-therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
-the value of `foo'.
-*/
-       (value, alist))
-{
-  EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
-				(CONSP (elt) &&
-				 internal_equal (value, XCDR (elt), 0)));
-  return alist;
-}
-
-DEFUN ("remrassq", Fremrassq, 2, 2, 0, /*
-Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE.
-The modified ALIST is returned.  If the first member of ALIST has a car
-that is `eq' to VALUE, there is no way to remove it by side effect;
-therefore, write `(setq foo (remrassq value foo))' to be sure of changing
-the value of `foo'.
-*/
-       (value, alist))
-{
-  EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist,
-				(CONSP (elt) &&
-				 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
-  return alist;
-}
-
 /* Like Fremrassq, fast and unsafe; be careful */
 Lisp_Object
 remrassq_no_quit (Lisp_Object value, Lisp_Object alist)
@@ -11771,10 +11712,6 @@
 
   DEFSUBR (FdeleteX);
   DEFSUBR (FremoveX);
-  DEFSUBR (Fremassoc);
-  DEFSUBR (Fremassq);
-  DEFSUBR (Fremrassoc);
-  DEFSUBR (Fremrassq);
   DEFSUBR (Fdelete_duplicates);
   DEFSUBR (Fremove_duplicates);
   DEFSUBR (Fnreverse);
--- a/src/fontcolor-tty.c	Sun Oct 09 10:39:09 2011 +0100
+++ b/src/fontcolor-tty.c	Sun Oct 09 12:55:51 2011 +0100
@@ -80,7 +80,7 @@
   CHECK_STRING (bg_string);
 
   color = Fintern (color, Qnil);
-  Vtty_color_alist = Fremassq (color, Vtty_color_alist);
+  Vtty_color_alist = remassq_no_quit (color, Vtty_color_alist);
   Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)),
 			    Vtty_color_alist);
 
@@ -95,7 +95,7 @@
   CHECK_STRING (color);
 
   color = Fintern (color, Qnil);
-  Vtty_color_alist = Fremassq (color, Vtty_color_alist);
+  Vtty_color_alist = remassq_no_quit (color, Vtty_color_alist);
   return Qnil;
 }
 
@@ -111,7 +111,7 @@
 
   CHECK_STRING (color);
 
-  result = Fassq (Fintern (color, Qnil), Vtty_color_alist);
+  result = assq_no_quit (Fintern (color, Qnil), Vtty_color_alist);
   if (!NILP (result))
     return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result)));
   else
--- a/src/lisp.h	Sun Oct 09 10:39:09 2011 +0100
+++ b/src/lisp.h	Sun Oct 09 12:55:51 2011 +0100
@@ -5286,7 +5286,6 @@
 MODULE_API EXFUN (Fprovide, 1);
 MODULE_API EXFUN (Fput, 3);
 EXFUN (Frassq, 2);
-EXFUN (Fremassq, 2);
 EXFUN (Freplace_list, 2);
 MODULE_API EXFUN (Freverse, 1);
 EXFUN (Fsafe_length, 1);