Mercurial > emacs
view lisp/net/eudcb-ldap.el @ 60092:04686828d0da
2004-11-08 Benjamin Riefenstahl <Benjamin.Riefenstahl@epost.de>
* w32select.c: Summary: Thorough rework to implement Unicode
clipboard operations and delayed rendering.
Drop last_clipboard_text and related code, keep track of
ownership via clipboard_owner instead. Drop old #if0
sections.
(DEFAULT_LCID, ANSICP, OEMCP, QUNICODE, QANSICP, QOEMCP)
(clipboard_owner, modifying_clipboard, cfg_coding_system)
(cfg_codepage, cfg_lcid, cfg_clipboard_type, current_text)
(current_coding_system, current_requires_encoding)
(current_num_nls, current_clipboard_type, current_lcid): New
static variables.
(convert_to_handle_as_ascii, convert_to_handle_as_coded)
(render, render_all, run_protected, lisp_error_handler)
(owner_callback, create_owner, setup_config)
(enum_locale_callback, cp_from_locale, coding_from_cp): New
local functions.
(term_w32select, globals_of_w32select): New global functions.
(Fw32_set_clipboard_data): Ignore parameter FRAME, use
clipboard_owner instead. Use delayed rendering and provide
all text formats. Provide CF_LOCALE if necessary.
(Fw32_get_clipboard_data): Handle CF_UNICODETEXT and
CF_LOCALE. Fall back to CF_TEXT, if CF_UNICODETEXT is not
available. Force DOS line-ends for decoding.
(Fx_selection_exists_p): Handle CF_UNICODETEXT.
(syms_of_w32select): Init and register new variables.
* w32.h: Add prototypes for globals_of_w32select and
term_w32select. Make the neighboring K&R declarations into
prototypes, too.
* emacs.c: Include w32.h to get function prototypes.
(main): Call globals_of_w32select.
* w32.c (term_ntproc): Call term_w32select.
* mule-cmds.el (set-locale-environment): Remove call to
set-selection-coding-system on Windows.
* s/ms-w32.h: Guard MSC-specific #pragmas with an #ifdef.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Tue, 15 Feb 2005 23:19:26 +0000 |
parents | 695cf19ef79e |
children | 18a818a2ee7c 375f2633d815 |
line wrap: on
line source
;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This library provides specific LDAP protocol support for the ;; Emacs Unified Directory Client package ;;; Installation: ;; Install EUDC first. See EUDC documentation. ;;; Code: (require 'eudc) (require 'ldap) ;;{{{ Internal cooking (eval-and-compile (if (fboundp 'ldap-get-host-parameter) (fset 'eudc-ldap-get-host-parameter 'ldap-get-host-parameter) (defun eudc-ldap-get-host-parameter (host parameter) "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." (plist-get (cdr (assoc host ldap-host-parameters-alist)) parameter)))) (defvar eudc-ldap-attributes-translation-alist '((name . sn) (firstname . givenname) (email . mail) (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) ("mail" . eudc-display-mail) ("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)) (cdr field) (car (cdr field)))))) record)) (defun eudc-filter-$ (string) (mapconcat 'identity (split-string string "\\$") "\n")) ;; Cleanup a LDAP record to make it suitable for EUDC: ;; Make the record a cons-cell instead of a list if it is 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))) (if (memq name '(postaladdress registeredaddress)) (setq value (mapcar 'eudc-filter-$ value))) (cons name (if (cdr value) value (car value)))))) record)) (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 (if (listp return-attrs) (mapcar 'symbol-name return-attrs)))) 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))) (if (and eudc-strict-return-matches return-attrs (not (eq 'all return-attrs))) (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)) final-result)) (defun eudc-ldap-get-field-list (dummy &optional objectclass) "Return a list of valid attribute names for the current server. OBJECTCLASS is the LDAP object class for which the valid attribute names are returned. Default to `person'" (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-simple (ldap-search (eudc-ldap-format-query-as-rfc1558 (list (cons "objectclass" (or objectclass "person")))) eudc-server nil t)))) (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") (char-to-string ?\0) "\\00")) (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) (defun eudc-ldap-customize () "Customize the EUDC LDAP support." (interactive) (customize-group 'eudc-ldap)) (defun eudc-ldap-check-base () "Check if the current LDAP server has a configured search base." (unless (or (eudc-ldap-get-host-parameter eudc-server 'base) ldap-default-base (null (y-or-n-p "No search base defined. Configure it now ?"))) ;; 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) (provide 'eudcb-ldap) ;;; arch-tag: 0f254dc0-7378-4fd4-ae26-18666184e96b ;;; eudcb-ldap.el ends here