cl functions in gnus-registry.el

cl functions in gnus-registry.el

[Katsumi Yamaoka]

[-- Attachment #1: Type: text/plain, Size: 814 bytes --]

Hi,

When performing `make bootstrap' on Emacs head, the byte compiler
warns about cl functions used in gnus-registry.el:

gnus-registry.el:MMM:NN:Warning: function `mapcan' from cl package
 called at runtime
gnus-registry.el:985:58:Warning: function `delete*' from cl package
 called at runtime

As for this, how about the attached patch?

In addition, I got the following when compiling registry.el:

registry.el:439:1:Warning: the following functions are not known to be
    defined: registry-lookup-secondary, registry-lookup-secondary-value,
    registry-size, registry-delete, registry-insert, registry-lookup,
    registry-lookup-breaks-before-lexbind, registry-search, registry-prune

I guess surrounding all the defmethod forms with `eval-and-compile'
may be a solution (see the second patch).

Regards,


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus-registry_el-eliminate-cl-fns.patch --]
[-- Type: text/x-patch, Size: 4521 bytes --]

--- gnus-registry.el~	2011-04-17 21:54:48.718750000 +0000
+++ gnus-registry.el	2011-04-18 06:50:37.640625000 +0000
@@ -303,15 +303,9 @@
 (defun gnus-registry-action (action data-header from &optional to method)
   (let* ((id (mail-header-id data-header))
          (subject (mail-header-subject data-header))
-         (recipients (sort (mapcan 'gnus-registry-extract-addresses
-                                   (list
-                                    (or (ignore-errors
-                                          (mail-header "Cc" data-header))
-                                        "")
-                                    (or (ignore-errors
-                                          (mail-header "To" data-header))
-                                        "")))
-                           'string-lessp))
+         (recipients (gnus-registry-sort-addresses
+		      (or (ignore-errors (mail-header "Cc" data-header)) "")
+		      (or (ignore-errors (mail-header "To" data-header)) "")))
          (sender (nth 0 (gnus-registry-extract-addresses
                          (mail-header-from data-header))))
          (from (gnus-group-guess-full-name-from-command-method from))
@@ -329,11 +323,9 @@
 (defun gnus-registry-spool-action (id group &optional subject sender recipients)
   (let ((to (gnus-group-guess-full-name-from-command-method group))
         (recipients (or recipients
-                        (sort (mapcan 'gnus-registry-extract-addresses
-                                      (list
-                                       (or (message-fetch-field "cc") "")
-                                       (or (message-fetch-field "to") "")))
-                              'string-lessp)))
+			(gnus-registry-sort-addresses
+			 (or (message-fetch-field "cc") "")
+			 (or (message-fetch-field "to") ""))))
         (subject (or subject (message-fetch-field "subject")))
         (sender (or sender (message-fetch-field "from"))))
     (when (and (stringp id) (string-match "\r$" id))
@@ -409,11 +401,9 @@
          ;; these may not be used, but the code is cleaner having them up here
          (sender (gnus-string-remove-all-properties
                   (message-fetch-field "from")))
-         (recipients (sort (mapcan 'gnus-registry-extract-addresses
-                                   (list
-                                    (or (message-fetch-field "cc") "")
-                                    (or (message-fetch-field "to") "")))
-                           'string-lessp))
+         (recipients (gnus-registry-sort-addresses
+		      (or (message-fetch-field "cc") "")
+		      (or (message-fetch-field "to") "")))
          (subject (gnus-string-remove-all-properties
                    (gnus-registry-simplify-subject
                     (message-fetch-field "subject"))))
@@ -719,6 +709,11 @@
                (format "%s <%s>" name addr))))
           (mail-extract-address-components text t)))
 
+(defun gnus-registry-sort-addresses (&rest addresses)
+  "Return a normalized and sorted list of ADDRESSES."
+  (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
+	'string-lessp))
+
 (defun gnus-registry-simplify-subject (subject)
   (if (stringp subject)
       (gnus-simplify-subject subject)
@@ -738,15 +733,9 @@
   (gnus-registry-fetch-header-fast "from" article))
 
 (defun gnus-registry-fetch-recipients-fast (article)
-  (sort (mapcan 'gnus-registry-extract-addresses
-                (list
-                 (or (ignore-errors
-                       (gnus-registry-fetch-header-fast "Cc" article))
-                     "")
-                 (or (ignore-errors
-                       (gnus-registry-fetch-header-fast "To" article))
-                     "")))
-        'string-lessp))
+  (gnus-registry-sort-addresses
+   (or (ignore-errors (gnus-registry-fetch-header-fast "Cc" article)) "")
+   (or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
 
 (defun gnus-registry-fetch-header-fast (article header)
   "Fetch the HEADER quickly, using the internal gnus-data-list function"
@@ -982,7 +971,8 @@
                              collect p))
                extra-cell key val)
           ;; remove all the strings from the entry
-          (delete* nil rest :test (lambda (a b) (stringp b)))
+          (dolist (elem rest)
+	    (if (stringp elem) (setq rest (delq elem rest))))
           (gnus-registry-set-id-key id 'group groups)
           ;; just use the first extra element
           (setq rest (car-safe rest))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: registry_el+eval-and-compil.patch --]
[-- Type: text/x-patch, Size: 577 bytes --]

--- registry.el~	2011-04-17 21:54:50.765625000 +0000
+++ registry.el	2011-04-18 06:50:37.642625000 +0000
@@ -131,6 +131,7 @@
          :type hash-table
          :documentation "The data hashtable.")))
 
+(eval-and-compile
 (defmethod initialize-instance :AFTER ((this registry-db) slots)
   "Set value of data slot of THIS after initialization."
   (with-slots (data tracker) this
@@ -327,6 +328,7 @@
       (setq candidates (cdr candidates)))
 
     (registry-delete db candidates nil)))
+)
 
 (ert-deftest registry-instantiation-test ()
   (should (registry-db "Testing")))

Re: cl functions in gnus-registry.el

[Ted Zlatanov]

On Mon, 18 Apr 2011 16:02:18 +0900 Katsumi Yamaoka <yamaoka@jpl.org> wrote: 

KY> When performing `make bootstrap' on Emacs head, the byte compiler
KY> warns about cl functions used in gnus-registry.el:

KY> gnus-registry.el:MMM:NN:Warning: function `mapcan' from cl package
KY>  called at runtime
KY> gnus-registry.el:985:58:Warning: function `delete*' from cl package
KY>  called at runtime

Argh.  I always forget not to use those!  They are so convenient!  Sorry.

KY> As for this, how about the attached patch?
...
KY> In addition, I got the following when compiling registry.el:

KY> registry.el:439:1:Warning: the following functions are not known to be
KY>     defined: registry-lookup-secondary, registry-lookup-secondary-value,
KY>     registry-size, registry-delete, registry-insert, registry-lookup,
KY>     registry-lookup-breaks-before-lexbind, registry-search, registry-prune

KY> I guess surrounding all the defmethod forms with `eval-and-compile'
KY> may be a solution (see the second patch).

I agree with both patches, feel free to push them.

Thanks!
Ted