changeset 4607:517f6887fbc0

Remove duplicate functions, chiefly #'delete-duplicates reimplementations. lisp/ChangeLog addition: 2009-02-08 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-duplicates): Add a new compiler macro, inlining this function if it's called with a literal #'eq or #'equal test arguments and no other keywords. * font-lock.el (font-lock-unique): Remove this function. * font-lock.el (font-lock-prepend-text-property): (font-lock-append-text-property): Use #'delete-duplicates instead of #'font-lock-unique. * font.el (font-unique): Remove this function. * font.el (font-combine-fonts-internal): (x-font-families-for-device): (xft-font-families-for-device): (ns-font-families-for-device): Use #'delete-duplicates instead of #'font-unique. * fontconfig.el (fc-delete-duplicates): * fontconfig.el (fc-filter): Remove these functions. * fontconfig.el (fc-find-available-font-families): Replace #'fc-delete-duplicates with #'delete-duplicates, #'fc-filter with #'delete-if-not. * format.el (format-make-relatively-unique): Document that this is equivalent to #'nset-exclusive-or with a test of #'equal.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 08 Feb 2009 18:45:22 +0000
parents 88ba7d18dc23
children 1e3cf11fa27d
files lisp/ChangeLog lisp/cl-macs.el lisp/font-lock.el lisp/font.el lisp/fontconfig.el lisp/format.el
diffstat 6 files changed, 71 insertions(+), 65 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/ChangeLog	Sun Feb 08 18:45:22 2009 +0000
@@ -1,3 +1,31 @@
+2009-02-08  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (delete-duplicates): 
+	Add a new compiler macro, inlining this function if it's called
+	with a literal #'eq or #'equal test arguments and no other
+	keywords.
+	* font-lock.el (font-lock-unique): 
+	Remove this function. 
+	* font-lock.el (font-lock-prepend-text-property): 
+	(font-lock-append-text-property): 
+	Use #'delete-duplicates instead of #'font-lock-unique.
+	* font.el (font-unique):
+	Remove this function.
+	* font.el (font-combine-fonts-internal): 
+	(x-font-families-for-device): 
+	(xft-font-families-for-device): 
+	(ns-font-families-for-device): 
+	Use #'delete-duplicates instead of #'font-unique.
+	* fontconfig.el (fc-delete-duplicates): 
+	* fontconfig.el (fc-filter): 
+	Remove these functions. 	
+	* fontconfig.el (fc-find-available-font-families): 
+	Replace #'fc-delete-duplicates with #'delete-duplicates,
+	#'fc-filter with #'delete-if-not.
+	* format.el (format-make-relatively-unique): 
+	Document that this is equivalent to #'nset-exclusive-or with a
+	test of #'equal.
+
 2009-02-07  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* descr-text.el (describe-text-sexp):
--- a/lisp/cl-macs.el	Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/cl-macs.el	Sun Feb 08 18:45:22 2009 +0000
@@ -3169,6 +3169,30 @@
 	    (list 'let (list (list temp val)) (subst temp val res)))))
     form))
 
+;; XEmacs; inline delete-duplicates if it's called with a literal
+;; #'equal or #'eq and no other keywords, we want the speed in
+;; font-lock.el.
+(define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
+  (cond ((and (= 4 (length form))
+              (eq :test (third form))
+              (or (equal '(quote eq) (fourth form))
+                  (equal '(function eq) (fourth form))))
+         `(let* ((begin ,cl-seq)
+                 (cl-seq begin))
+           (while cl-seq
+             (setq cl-seq (setcdr cl-seq (delq (car cl-seq) (cdr cl-seq)))))
+           begin))
+        ((and (= 4 (length form))
+              (eq :test (third form))
+              (or (equal '(quote equal) (fourth form))
+                  (equal '(function equal) (fourth form))))
+         `(let* ((begin ,cl-seq)
+                 (cl-seq begin))
+           (while cl-seq
+             (setq cl-seq (setcdr cl-seq (delete (car cl-seq) (cdr cl-seq)))))
+           begin))
+        (t
+         form)))
 
 (mapc
  #'(lambda (y)
--- a/lisp/font-lock.el	Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/font-lock.el	Sun Feb 08 18:45:22 2009 +0000
@@ -1636,27 +1636,6 @@
       (put-nonduplicable-text-property start next markprop value object)
       (setq start (text-property-any next end markprop nil object)))))
 
-;; This function (from simon's unique.el) is rewritten and inlined for speed.
-;(defun unique (list function)
-;  "Uniquify LIST, deleting elements using FUNCTION.
-;Return the list with subsequent duplicate items removed by side effects.
-;FUNCTION is called with an element of LIST and a list of elements from LIST,
-;and should return the list of elements with occurrences of the element removed,
-;i.e., a function such as `delete' or `delq'.
-;This function will work even if LIST is unsorted.  See also `uniq'."
-;  (let ((list list))
-;    (while list
-;      (setq list (setcdr list (funcall function (car list) (cdr list))))))
-;  list)
-
-(defsubst font-lock-unique (list)
-  "Uniquify LIST, deleting elements using `delq'.
-Return the list with subsequent duplicate items removed by side effects."
-  (let ((list list))
-    (while list
-      (setq list (setcdr list (delq (car list) (cdr list))))))
-  list)
-
 ;; A generalisation of `facemenu-add-face' for any property, but without the
 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
 ;; treatment of `default'.  Uses `unique' to remove duplicate property values.
@@ -1671,7 +1650,8 @@
 	    prev (get-text-property start prop object))
       (put-text-property
        start next prop
-       (font-lock-unique (append val (if (listp prev) prev (list prev))))
+       (delete-duplicates (append val (if (listp prev) prev (list prev)))
+                          :test #'eq)
        object)
       (setq start next))))
 
@@ -1686,7 +1666,8 @@
 	    prev (get-text-property start prop object))
       (put-text-property
        start next prop
-       (font-lock-unique (append (if (listp prev) prev (list prev)) val))
+       (delete-duplicates (append (if (listp prev) prev (list prev)) val)
+                          :test #'eq)
        object)
       (setq start next))))
 
--- a/lisp/font.el	Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/font.el	Sun Feb 08 18:45:22 2009 +0000
@@ -295,18 +295,6 @@
 ; 	  (setq retval (cons type retval))))
 ;     retval))
 
-;; #### only used in this file; maybe there's a cl.el function?
-(defun font-unique (list)
-  (let ((retval)
-	(cur))
-    (while list
-      (setq cur (car list)
-	    list (cdr list))
-      (if (member cur retval)
-	  nil
-	(setq retval (cons cur retval))))
-    (nreverse retval)))
-
 (defun font-higher-weight (w1 w2)
   (let ((index1 (length (memq w1 font-possible-weights)))
 	(index2 (length (memq w2 font-possible-weights))))
@@ -424,8 +412,10 @@
 		     (font-spatial-to-canonical (font-size fontobj-2)))))
     (set-font-weight retval (font-higher-weight (font-weight fontobj-1)
 						(font-weight fontobj-2)))
-    (set-font-family retval (font-unique (append (font-family fontobj-1)
-						 (font-family fontobj-2))))
+    (set-font-family retval
+                     (delete-duplicates (append (font-family fontobj-1)
+                                                (font-family fontobj-2)))
+                     :test #'equal)
     (set-font-style retval (logior (font-style fontobj-1)
 				   (font-style fontobj-2)))
     (set-font-registry retval (or (font-registry fontobj-1)
@@ -651,7 +641,8 @@
 				(aref menu 0)))
 		(normal (mapcar #'(lambda (x) (if x (aref x 0)))
 				(aref menu 1))))
-	    (sort (font-unique (nconc scaled normal)) 'string-lessp))))
+	    (sort (delete-duplicates (nconc scaled normal) :test 'equal)
+                  'string-lessp))))
     (cons "monospace" (mapcar 'car font-x-family-mappings))))
 
 (defun x-font-create-name (fontobj &optional device)
@@ -842,7 +833,8 @@
 				(aref menu 0)))
 		(normal (mapcar #'(lambda (x) (if x (aref x 0)))
 				(aref menu 1))))
-	    (sort (font-unique (nconc scaled normal)) 'string-lessp))))
+	    (sort (delete-duplicates (nconc scaled normal) :test #'equal)
+                  'string-lessp))))
 	  ;; #### FIXME clearly bogus for Xft
     (cons "monospace" (mapcar 'car font-xft-family-mappings))))
 
@@ -872,7 +864,8 @@
 				(aref menu 0)))
 		(normal (mapcar #'(lambda (x) (if x (aref x 0)))
 				(aref menu 1))))
-	    (sort (font-unique (nconc scaled normal)) 'string-lessp))))))
+	    (sort (delete-duplicates (nconc scaled normal) :test #'equal)
+                  'string-lessp))))))
 
 (defun ns-font-create-name (fontobj &optional device)
   "Return a font name constructed from FONTOBJ, appropriate for NextSTEP devices."
--- a/lisp/fontconfig.el	Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/fontconfig.el	Sun Feb 08 18:45:22 2009 +0000
@@ -494,13 +494,13 @@
 	(objectset '("family" "style")))
     (let* ((all-fonts
 	    (fc-list-fonts-pattern-objects device pattern objectset)))
-      (fc-delete-duplicates
+      (delete-duplicates
        (mapcar
 	#'(lambda (pattern)
             (fc-pattern-get-family pattern 0))
 	(if filter-fun
-	    (fc-filter all-fonts filter-fun)
-	  all-fonts))))))
+	    (delete-if-not filter-fun all-fonts)
+	  all-fonts)) :test #'equal))))
 
 (defun fc-find-available-weights-for-family (family &optional style device)
   "Find available weights for font FAMILY."
@@ -534,28 +534,6 @@
        (not (equal result 'fc-result-no-id))
        (not (equal result 'fc-internal-error))))
 
-;;; DELETE-DUPLICATES and REMOVE-DUPLICATES from cl-seq.el do not
-;;; seem to work on list of strings...
-;;; #### Presumably just use :test 'equal!
-(defun fc-delete-duplicates (l)
-  (let ((res nil)
-	(in l))
-    (while (not (null in))
-      (if (not (member (car in) res))
-	  (setq res (append res (list (car in)))))
-      (setq in (cdr in)))
-    res))
-
-;; #### Use delete-if with :test 'equal.
-(defun fc-filter (l fun)
-  (let ((res nil)
-	(in l))
-    (while (not (null in))
-      (if (funcall fun (car in))
-	  (setq res (append res (list (car in)))))
-      (setq in (cdr in)))
-    res))
-
 (provide 'fontconfig)
 
 ;;; fontconfig.el ends here
--- a/lisp/format.el	Sat Feb 07 21:55:13 2009 +0100
+++ b/lisp/format.el	Sun Feb 08 18:45:22 2009 +0000
@@ -454,6 +454,8 @@
       (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'."