* wl/wl-summary.el (wl-summary-mode): Check with fboundp before calling `make-local...

[elisp/wanderlust.git] / elmo / pldap.el

diff --git a/elmo/pldap.el b/elmo/pldap.el
index 5d90138..bc8fc2e 100644 (file)
--- a/elmo/pldap.el
+++ b/elmo/pldap.el
@@ -42,7 +42,7 @@
   "`if' expression but COND is evaluated at compile-time."
   (if (eval cond)
       then
-    (` (progn  (,@ else)))))
+    `(progn ,@else)))
 
 (ldap-static-if (and (not (featurep 'pldap))
                     (fboundp 'ldap-open))
@@ -78,10 +78,10 @@
   (concat "\n" ldap-ldif-field-name-regexp ":")
   "A Regexp for next field head.")
 
-(defmacro ldap/ldif-safe-string-p (string)
+(defun ldap/ldif-safe-string-p (string)
   "Return t if STRING is a safe-string for LDIF."
   ;; Need better implentation.
-  (` (string-match ldap-ldif-safe-string-regexp (, string))))
+  (string-match ldap-ldif-safe-string-regexp string))
 
 (defgroup ldap nil
   "Lightweight Directory Access Protocol"
@@ -509,17 +509,17 @@ DN is the distinguished name of the entry to delete."
                       nil (current-buffer) t
                       (append arglist
                               (list dn))))
-      (if (integerp ret)
-         (if (not (zerop ret))
-             (error (car (split-string (buffer-string) "\n"))))
-       (if (and (setq ret (buffer-string)); Nemacs
-                (string-match "ldap_delete:" ret))
-           (error (car (split-string ret "\n"))))))))
+      (cond ((integerp ret)
+            (or (zerop ret)
+                (error "%s" (car (split-string (buffer-string) "\n")))))
+           ((and (setq ret (buffer-string)); Nemacs
+                 (string-match "ldap_delete:" ret))
+            (error "%s" (car (split-string ret "\n"))))))))
 
 (defmacro ldap/ldif-insert-field (attr value)
-  (` (if (not (ldap/ldif-safe-string-p (, value)))
-        (insert (, attr) ":: " (base64-encode-string (, value)) "\n")
-       (insert (, attr) ": " (, value) "\n"))))
+  `(if (not (ldap/ldif-safe-string-p ,value))
+       (insert ,attr ":: " (base64-encode-string ,value) "\n")
+     (insert ,attr ": " ,value "\n")))
 
 (defun ldap-modify (ldap dn mods)
   "Add an entry to an LDAP directory.
@@ -567,12 +567,12 @@ or `replace'.  ATTR is the LDAP attribute type to modify."
                       ldap-modify-program
                       t t nil
                       arglist))
-      (if (integerp ret)
-         (if (not (zerop ret))
-             (error (car (split-string (buffer-string) "\n"))))
-       (if (and (setq ret (buffer-string)); Nemacs
-                (string-match "ldap_modify:" ret))
-           (error (car (split-string ret "\n"))))))))
+      (cond ((integerp ret)
+            (or (zerop ret)
+                (error "%s" (car (split-string (buffer-string) "\n")))))
+           ((and (setq ret (buffer-string)); Nemacs
+                 (string-match "ldap_modify:" ret))
+            (error "%s" (car (split-string ret "\n"))))))))
 
 (defun ldap-add (ldap dn entry)
   "Add an entry to an LDAP directory.
@@ -607,12 +607,12 @@ containing attribute/value string pairs."
                       ldap-add-program
                       t t nil
                       arglist))
-      (if (integerp ret)
-         (if (not (zerop ret))
-             (error (car (split-string (buffer-string) "\n"))))
-       (if (and (setq ret (buffer-string)) ; Nemacs
-                (string-match "ldap_add:" ret))
-           (error (car (split-string ret "\n"))))))))
+      (cond ((integerp ret)
+            (or (zerop ret)
+                (error "%s" (car (split-string (buffer-string) "\n")))))
+           ((and (setq ret (buffer-string)) ; Nemacs
+                 (string-match "ldap_add:" ret))
+            (error "%s" (car (split-string ret "\n"))))))))
 
 (defun ldap-search-basic (ldap filter base scope
                               &optional attrs attrsonly withdn verbose)
@@ -691,7 +691,10 @@ entry according to the value of WITHDN."
               (not (zerop ret))
               ;; When openldap's `ldapsearch' exceeds response size limit,
               ;; it's exit status becomes `4'.
-               (/= ret 4))
+               (/= ret 4)
+              ;; When openldap's `ldapsearch' uses referral,
+              ;; it's exit status becomes `32'.
+              (/= ret 32))
          (error "LDAP error: \"No such object\""))
       (goto-char (point-min))
       (setq start (point))
@@ -927,10 +930,10 @@ entry according to the value of WITHDN."
       (set-buffer-multibyte nil)
       (if ldap-ignore-attribute-codings
          result
-       (mapcar (function
-                (lambda (record)
-                  (mapcar 'ldap-decode-attribute record)))
-               result)))))
+       (mapcar
+        (lambda (record)
+          (mapcar 'ldap-decode-attribute record))
+        result)))))
 
 (defun ldap-add-entries (entries &optional host binddn passwd)
   "Add entries to an LDAP directory.
@@ -958,22 +961,22 @@ PASSWD is the corresponding password"
     (setq ldap (ldap-open host host-plist))
     (if ldap-verbose
        (message "Adding LDAP entries..."))
-    (mapcar (lambda (thisentry)
-             (setcdr thisentry
-                     (mapcar
-                      (lambda (add-spec)
-                        (setq add-spec (ldap-encode-attribute
-                                        (list (car add-spec)
-                                              (cdr add-spec))))
-                        (cons (nth 0 add-spec)
-                              (nth 1 add-spec)))
-                      (cdr thisentry)))
-             (setq thisentry (ldap-encode-attribute thisentry))
-             (ldap-add ldap (car thisentry) (cdr thisentry))
-             (if ldap-verbose
-                 (message "%d added" i))
-             (setq i (1+ i)))
-           entries)
+    (mapc (lambda (thisentry)
+           (setcdr thisentry
+                   (mapcar
+                    (lambda (add-spec)
+                      (setq add-spec (ldap-encode-attribute
+                                      (list (car add-spec)
+                                            (cdr add-spec))))
+                      (cons (nth 0 add-spec)
+                            (nth 1 add-spec)))
+                    (cdr thisentry)))
+           (setq thisentry (ldap-encode-attribute thisentry))
+           (ldap-add ldap (car thisentry) (cdr thisentry))
+           (if ldap-verbose
+               (message "%d added" i))
+           (setq i (1+ i)))
+         entries)
     (ldap-close ldap)))
 
 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
@@ -1006,21 +1009,22 @@ PASSWD is the corresponding password"
     (setq ldap (ldap-open host host-plist))
     (if ldap-verbose
        (message "Modifying LDAP entries..."))
-    (mapcar (lambda (thisentry)
-             (setcdr thisentry
-                     (mapcar
-                      (lambda (mod-spec)
-                        (if (or (eq (car mod-spec) 'add)
-                                (eq (car mod-spec) 'replace))
-                            (append (list (nth 0 mod-spec))
-                                    (ldap-encode-attribute
-                                     (cdr mod-spec)))))
-                      (cdr thisentry)))
-             (ldap-modify ldap (car thisentry) (cdr thisentry))
-             (if ldap-verbose
-                 (message "%d modified" i))
-             (setq i (1+ i)))
-           entry-mods)
+    (mapc
+     (lambda (thisentry)
+       (setcdr thisentry
+              (mapcar
+               (lambda (mod-spec)
+                 (if (or (eq (car mod-spec) 'add)
+                         (eq (car mod-spec) 'replace))
+                     (append (list (nth 0 mod-spec))
+                             (ldap-encode-attribute
+                              (cdr mod-spec)))))
+               (cdr thisentry)))
+       (ldap-modify ldap (car thisentry) (cdr thisentry))
+       (if ldap-verbose
+          (message "%d modified" i))
+       (setq i (1+ i)))
+     entry-mods)
     (ldap-close ldap)))
 
 (defun ldap-delete-entries (dn &optional host binddn passwd)
@@ -1048,13 +1052,13 @@ PASSWD is the corresponding password."
        (let ((i 1))
          (if ldap-verbose
              (message "Deleting LDAP entries..."))
-         (mapcar (function
-                  (lambda (thisdn)
-                    (ldap-delete ldap thisdn)
-                    (if ldap-verbose
-                        (message "%d deleted" i))
-                    (setq i (1+ i))))
-                 dn))
+         (mapc
+          (lambda (thisdn)
+            (ldap-delete ldap thisdn)
+            (if ldap-verbose
+                (message "%d deleted" i))
+            (setq i (1+ i)))
+          dn))
       (if ldap-verbose
          (message "Deleting LDAP entry..."))
       (ldap-delete ldap dn))