[Emacs-diffs] Changes to emacs/lisp/net/eudcb-ldap.el

[Pavel Janík]

Index: emacs/lisp/net/eudcb-ldap.el
diff -c emacs/lisp/net/eudcb-ldap.el:1.2 emacs/lisp/net/eudcb-ldap.el:1.3
*** emacs/lisp/net/eudcb-ldap.el:1.2    Sat Jan  5 18:36:20 2002
--- emacs/lisp/net/eudcb-ldap.el        Sun Jan  6 10:07:49 2002
***************
*** 24,30 ****
  ;; Boston, MA 02111-1307, USA.
  
  ;;; Commentary:
! ;;    This library provides specific LDAP protocol support for the 
  ;;    Emacs Unified Directory Client package
  
  ;;; Installation:
--- 24,30 ----
  ;; Boston, MA 02111-1307, USA.
  
  ;;; Commentary:
! ;;    This library provides specific LDAP protocol support for the
  ;;    Emacs Unified Directory Client package
  
  ;;; Installation:
***************
*** 53,83 ****
      (phone . telephonenumber))
    "Alist mapping EUDC attribute names to LDAP names.")
  
! (eudc-protocol-set 'eudc-query-function 'eudc-ldap-simple-query-internal 
                   'ldap)
  (eudc-protocol-set 'eudc-list-attributes-function 'eudc-ldap-get-field-list
                   'ldap)
! (eudc-protocol-set 'eudc-protocol-attributes-translation-alist 
                   'eudc-ldap-attributes-translation-alist 'ldap)
! (eudc-protocol-set 'eudc-bbdb-conversion-alist 
!                  'eudc-ldap-bbdb-conversion-alist 
                   'ldap)
  (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'ldap)
! (eudc-protocol-set 'eudc-attribute-display-method-alist 
                   '(("jpegphoto" . eudc-display-jpeg-inline)
                     ("labeledurl" . eudc-display-url)
                     ("audio" . eudc-display-sound)
                     ("labeleduri" . eudc-display-url)
!                    ("url" . eudc-display-url)) 
                   'ldap)
! (eudc-protocol-set 'eudc-switch-to-server-hook 
!                  '(eudc-ldap-check-base) 
                   'ldap)
  
  (defun eudc-ldap-cleanup-record-simple (record)
    "Do some cleanup in a RECORD to make it suitable for EUDC."
!   (mapcar 
!    (function 
      (lambda (field)
        (cons (intern (car field))
            (if (cdr (cdr field))
--- 53,83 ----
      (phone . telephonenumber))
    "Alist mapping EUDC attribute names to LDAP names.")
  
! (eudc-protocol-set 'eudc-query-function 'eudc-ldap-simple-query-internal
                   'ldap)
  (eudc-protocol-set 'eudc-list-attributes-function 'eudc-ldap-get-field-list
                   'ldap)
! (eudc-protocol-set 'eudc-protocol-attributes-translation-alist
                   'eudc-ldap-attributes-translation-alist 'ldap)
! (eudc-protocol-set 'eudc-bbdb-conversion-alist
!                  'eudc-ldap-bbdb-conversion-alist
                   'ldap)
  (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'ldap)
! (eudc-protocol-set 'eudc-attribute-display-method-alist
                   '(("jpegphoto" . eudc-display-jpeg-inline)
                     ("labeledurl" . eudc-display-url)
                     ("audio" . eudc-display-sound)
                     ("labeleduri" . eudc-display-url)
!                    ("url" . eudc-display-url))
                   'ldap)
! (eudc-protocol-set 'eudc-switch-to-server-hook
!                  '(eudc-ldap-check-base)
                   'ldap)
  
  (defun eudc-ldap-cleanup-record-simple (record)
    "Do some cleanup in a RECORD to make it suitable for EUDC."
!   (mapcar
!    (function
      (lambda (field)
        (cons (intern (car field))
            (if (cdr (cdr field))
***************
*** 92,99 ****
  ;;   Make the record a cons-cell instead of a list if the it's single-valued
  ;;   Filter the $ character in addresses into \n if not done by the LDAP lib
  (defun eudc-ldap-cleanup-record-filtering-addresses (record)
!   (mapcar 
!    (function 
      (lambda (field)
        (let ((name (intern (car field)))
            (value (cdr field)))
--- 92,99 ----
  ;;   Make the record a cons-cell instead of a list if the it's single-valued
  ;;   Filter the $ character in addresses into \n if not done by the LDAP lib
  (defun eudc-ldap-cleanup-record-filtering-addresses (record)
!   (mapcar
!    (function
      (lambda (field)
        (let ((name (intern (car field)))
            (value (cdr field)))
***************
*** 107,115 ****
  
  (defun eudc-ldap-simple-query-internal (query &optional return-attrs)
    "Query the LDAP server with QUERY.
! QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid 
! LDAP attribute names.  
! RETURN-ATTRS is a list of attributes to return, defaulting to 
  `eudc-default-return-attributes'."
    (let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
                             eudc-server
--- 107,115 ----
  
  (defun eudc-ldap-simple-query-internal (query &optional return-attrs)
    "Query the LDAP server with QUERY.
! QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
! LDAP attribute names.
! RETURN-ATTRS is a list of attributes to return, defaulting to
  `eudc-default-return-attributes'."
    (let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
                             eudc-server
***************
*** 118,124 ****
        final-result)
      (if (or (not (boundp 'ldap-ignore-attribute-codings))
            ldap-ignore-attribute-codings)
!       (setq result 
              (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
        (setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
  
--- 118,124 ----
        final-result)
      (if (or (not (boundp 'ldap-ignore-attribute-codings))
            ldap-ignore-attribute-codings)
!       (setq result
              (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
        (setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
  
***************
*** 128,136 ****
        (setq result (eudc-filter-partial-records result return-attrs)))
      ;; Apply eudc-duplicate-attribute-handling-method
      (if (not (eq 'list eudc-duplicate-attribute-handling-method))
!       (mapcar 
         (function (lambda (record)
!                    (setq final-result 
                           (append (eudc-filter-duplicate-attributes record)
                                   final-result))))
         result))
--- 128,136 ----
        (setq result (eudc-filter-partial-records result return-attrs)))
      ;; Apply eudc-duplicate-attribute-handling-method
      (if (not (eq 'list eudc-duplicate-attribute-handling-method))
!       (mapcar
         (function (lambda (record)
!                    (setq final-result
                           (append (eudc-filter-duplicate-attributes record)
                                   final-result))))
         result))
***************
*** 143,154 ****
    (interactive)
    (or eudc-server
        (call-interactively 'eudc-set-server))
!   (let ((ldap-host-parameters-alist 
         (list (cons eudc-server
                     '(scope subtree sizelimit 1)))))
      (mapcar 'eudc-ldap-cleanup-record
!           (ldap-search 
!            (eudc-ldap-format-query-as-rfc1558 
              (list (cons "objectclass"
                          (or objectclass
                              "person"))))
--- 143,154 ----
    (interactive)
    (or eudc-server
        (call-interactively 'eudc-set-server))
!   (let ((ldap-host-parameters-alist
         (list (cons eudc-server
                     '(scope subtree sizelimit 1)))))
      (mapcar 'eudc-ldap-cleanup-record
!           (ldap-search
!            (eudc-ldap-format-query-as-rfc1558
              (list (cons "objectclass"
                          (or objectclass
                              "person"))))
***************
*** 156,168 ****
  
  (defun eudc-ldap-escape-query-special-chars (string)
    "Value is STRING with characters forbidden in LDAP queries escaped."
! ;; Note that * should also be escaped but in most situations I suppose 
  ;; the user doesn't want this
    (eudc-replace-in-string
     (eudc-replace-in-string
      (eudc-replace-in-string
!       (eudc-replace-in-string 
!        string 
         "\\\\" "\\5c")
        "(" "\\28")
       ")" "\\29")
--- 156,168 ----
  
  (defun eudc-ldap-escape-query-special-chars (string)
    "Value is STRING with characters forbidden in LDAP queries escaped."
! ;; Note that * should also be escaped but in most situations I suppose
  ;; the user doesn't want this
    (eudc-replace-in-string
     (eudc-replace-in-string
      (eudc-replace-in-string
!       (eudc-replace-in-string
!        string
         "\\\\" "\\5c")
        "(" "\\28")
       ")" "\\29")
***************
*** 170,185 ****
  
  (defun eudc-ldap-format-query-as-rfc1558 (query)
    "Format the EUDC QUERY list as a RFC1558 LDAP search filter."
!   (format "(&%s)" 
!         (apply 'concat 
                 (mapcar '(lambda (item)
!                           (format "(%s=%s)" 
!                                   (car item) 
                                    (eudc-ldap-escape-query-special-chars (cdr 
item))))
                         query))))
  
  
! ;;}}}        
  
  ;;{{{      High-level interfaces (interactive functions)
  
--- 170,185 ----
  
  (defun eudc-ldap-format-query-as-rfc1558 (query)
    "Format the EUDC QUERY list as a RFC1558 LDAP search filter."
!   (format "(&%s)"
!         (apply 'concat
                 (mapcar '(lambda (item)
!                           (format "(%s=%s)"
!                                   (car item)
                                    (eudc-ldap-escape-query-special-chars (cdr 
item))))
                         query))))
  
  
! ;;}}}
  
  ;;{{{      High-level interfaces (interactive functions)
  
***************
*** 196,206 ****
      ;; If the server is not in ldap-host-parameters-alist we add it for the
      ;; user
      (if (null (assoc eudc-server ldap-host-parameters-alist))
!       (setq ldap-host-parameters-alist 
              (cons (list eudc-server) ldap-host-parameters-alist)))
      (customize-variable 'ldap-host-parameters-alist)))
  
! ;;;}}}
  
  
  (eudc-register-protocol 'ldap)
--- 196,206 ----
      ;; If the server is not in ldap-host-parameters-alist we add it for the
      ;; user
      (if (null (assoc eudc-server ldap-host-parameters-alist))
!       (setq ldap-host-parameters-alist
              (cons (list eudc-server) ldap-host-parameters-alist)))
      (customize-variable 'ldap-host-parameters-alist)))
  
! ;;}}}
  
  
  (eudc-register-protocol 'ldap)