changeset 5365:dbae25a8949d

Remove redundant functions, format.el, use functions from cl*.el instead. 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * format.el (format-delq-cons): Removed. * format.el (format-make-relatively-unique): Removed. * format.el (format-common-tail): Removed. * format.el (format-reorder): Removed. * format.el (format-annotate-region): * format.el (format-annotate-single-property-change): * format.el (format-annotate-atomic-property-change): Remove various functions from this file that re-implemented Common Lisp functions that we have built-in.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 22:32:49 +0000
parents 0f9aa4eb4bec
children f00192e1cd49
files lisp/ChangeLog lisp/format.el
diffstat 2 files changed, 23 insertions(+), 66 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Mar 08 21:00:36 2011 +0000
+++ b/lisp/ChangeLog	Tue Mar 08 22:32:49 2011 +0000
@@ -1,3 +1,15 @@
+2011-03-08  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* format.el (format-delq-cons): Removed.
+	* format.el (format-make-relatively-unique): Removed.
+	* format.el (format-common-tail): Removed.
+	* format.el (format-reorder): Removed.
+	* format.el (format-annotate-region):
+	* format.el (format-annotate-single-property-change):
+	* format.el (format-annotate-atomic-property-change):
+	Remove various functions from this file that re-implemented Common
+	Lisp functions that we have built-in.
+
 2011-03-08  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* select.el (selection-preferred-types):
--- a/lisp/format.el	Tue Mar 08 21:00:36 2011 +0000
+++ b/lisp/format.el	Tue Mar 08 22:32:49 2011 +0000
@@ -437,68 +437,6 @@
 						 (match-beginning 0)))))
 	  (setq alist (cdr alist)))))))
 
-;;; Some list-manipulation functions that we need.
-
-(defun format-delq-cons (cons list)
-  "Remove the given CONS from LIST by side effect,
-and return the new LIST.  Since CONS could be the first element
-of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of
-changing the value of `foo'."
-  (if (eq cons list)
-      (cdr list)
-    (let ((p list))
-      (while (not (eq (cdr p) cons))
-	(if (null p) (error "format-delq-cons: not an element."))
-	(setq p (cdr p)))
-      ;; Now (cdr p) is the cons to delete
-      (setcdr p (cdr cons))
-      list)))
-
-;; XEmacs: this is #'nset-exclusive-or with a :test of #'equal, though we
-;; probably don't want to replace it right now.
-(defun format-make-relatively-unique (a b)
-  "Delete common elements of lists A and B, return as pair.
-Compares using `equal'."
-  (let* ((acopy (copy-sequence a))
-	 (bcopy (copy-sequence b))
-	 (tail acopy))
-    (while tail
-      (let ((dup (member (car tail) bcopy))
-	    (next (cdr tail)))
-	(if dup (setq acopy (format-delq-cons tail acopy)
-		      bcopy (format-delq-cons dup  bcopy)))
-	(setq tail next)))
-    (cons acopy bcopy)))
-
-(defun format-common-tail (a b)
-  "Given two lists that have a common tail, return it.
-Compares with `equal', and returns the part of A that is equal to the
-equivalent part of B.  If even the last items of the two are not equal,
-returns nil."
-  (let ((la (length a))
-	(lb (length b)))
-    ;; Make sure they are the same length
-    (if (> la lb)
-	(setq a (nthcdr (- la lb) a))
-      (setq b (nthcdr (- lb la) b))))
-  (while (not (equal a b))
-    (setq a (cdr a)
-	  b (cdr b)))
-  a)
-
-(defun format-reorder (items order)
-  "Arrange ITEMS to following partial ORDER.
-Elements of ITEMS equal to elements of ORDER will be rearranged to follow the
-ORDER.  Unmatched items will go last."
-  (if order
-      (let ((item (member (car order) items)))
-	(if item
-	    (cons (car item)
-		  (format-reorder (format-delq-cons item items)
-			   (cdr order)))
-	  (format-reorder items (cdr order))))
-    items))
-
 (put 'face 'format-list-valued t)	; These text-properties take values
 (put 'unknown 'format-list-valued t)	; that are lists, the elements of which
 					; should be considered separately.
@@ -820,7 +758,11 @@
 		    (< loc to)))
       (or loc (setq loc from))
       (let* ((ans (format-annotate-location loc (= loc from) ignore trans))
-	     (neg-ans (format-reorder (aref ans 0) open-ans))
+	     (neg-ans (sort* (aref ans 0) '<
+                             :key #'(lambda (object)
+                                      (or
+                                       (position object open-ans :test 'equal)
+                                       most-positive-fixnum))))
 	     (pos-ans (aref ans 1))
 	     (ignored (aref ans 2)))
 	(setq not-found (append ignored not-found)
@@ -929,7 +871,6 @@
       (if (or (consp old) (consp new))
 	  (let* ((old (if (listp old) old (list old)))
 		 (new (if (listp new) new (list new)))
-		 ;; (tail (format-common-tail old new))
 		 close open)
 	    (while old
 	      (setq close
@@ -943,7 +884,9 @@
 				  prop-alist nil (car new)))
 			    open)
 		    new (cdr new)))
-	    (format-make-relatively-unique close open))
+            (cons
+             (set-difference close open :stable t)
+             (set-difference open close :stable t)))
 	(format-annotate-atomic-property-change prop-alist old new)))))
 
 (defun format-annotate-atomic-property-change (prop-alist old new)
@@ -980,7 +923,9 @@
       (let ((close (and old (cdr (assoc old prop-alist))))
 	    (open  (and new (cdr (assoc new prop-alist)))))
 	(if (or close open)
-	    (format-make-relatively-unique close open)
+            (cons
+             (set-difference close open :stable t)
+             (set-difference open close :stable t))
 	  ;; Call "Default" function, if any
 	  (let ((default (assq nil prop-alist)))
 	    (if default