changeset: 4607:517f6887fbc0255ca386afb68f87444f7e93840e tag: tip user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sun Feb 08 18:45:22 2009 +0000 files: lisp/ChangeLog lisp/cl-macs.el lisp/font-lock.el lisp/font.el lisp/fontconfig.el lisp/format.el description: Remove duplicate functions, chiefly #'delete-duplicates reimplementations. lisp/ChangeLog addition: 2009-02-08 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r 88ba7d18dc23a2420806492cf296b6dcddad422d -r 517f6887fbc0255ca386afb68f87444f7e93840e lisp/ChangeLog --- 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-07 Aidan Kehoe <kehoea＠parhasa +2009-02-08 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * descr-text.el (describe-text-sexp): diff -r 88ba7d18dc23a2420806492cf296b6dcddad422d -r 517f6887fbc0255ca386afb68f87444f7e93840e lisp/cl-macs.el --- 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 ＠＠ surrounded by (block NAME ...)." (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) diff -r 88ba7d18dc23a2420806492cf296b6dcddad422d -r 517f6887fbc0255ca386afb68f87444f7e93840e lisp/font-lock.el --- 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 ＠＠ Optional argument OBJECT is the string o (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 ＠＠ Optional argument OBJECT is the string o 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 ＠＠ Optional argument OBJECT is the string o 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))))  diff -r 88ba7d18dc23a2420806492cf296b6dcddad422d -r 517f6887fbc0255ca386afb68f87444f7e93840e lisp/font.el --- a/lisp/font.el Sat Feb 07 21:55:13 2009 +0100 +++ b/lisp/font.el Sun Feb 08 18:45:22 2009 +0000 ＠＠ -294,18 +294,6 ＠＠ for use in the 'weight' field of an X fo ; (if (funcall func fontobj) ; (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))) ＠＠ -424,8 +412,10 ＠＠ 1 in = 2.54 cm = 6 pa = 25.4 mm = 72 pt. (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 ＠＠ 1 in = 2.54 cm = 6 pa = 25.4 mm = 72 pt. (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 ＠＠ Optional DEVICE defaults to `default-x-d (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 ＠＠ Optional DEVICE defaults to `default-x-d (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." diff -r 88ba7d18dc23a2420806492cf296b6dcddad422d -r 517f6887fbc0255ca386afb68f87444f7e93840e lisp/fontconfig.el --- 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 ＠＠ selected device." (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 ＠＠ selected device." (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 diff -r 88ba7d18dc23a2420806492cf296b6dcddad422d -r 517f6887fbc0255ca386afb68f87444f7e93840e lisp/format.el --- 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 ＠＠ changing the value of `foo'." (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'." _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches