Commits

Anonymous committed 48031a0

Renamed to use the uniform back-end prefix `eudc-bck-*'

Comments (0)

Files changed (3)

eudc-bbdb.el

-;;; eudc-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
-
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
-;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
-;; Created: Feb 1998
-;; Version: $Revision$
-;; Keywords: help
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 an interface to use BBDB as a backend of 
-;;    the Emacs Unified Directory Client.
-
-;;; Installation:
-;;    Install EUDC first. See EUDC documentation.
-
-;;    This library runs under XEmacs 20 and under Emacs 19.34 and above
-
-;;; Usage:
-
-;;; Code:
-
-(require 'eudc)
-(require 'bbdb)
-(require 'bbdb-com)
-
-;;{{{      Internal cooking
-
-;; I don't like this but mapcar does not accept a parameter to the function and
-;; I don't want to use mapcar*
-(defvar eudc-bbdb-current-query nil)
-(defvar eudc-bbdb-current-return-attributes nil)
-
-(defvar eudc-bbdb-attributes-translation-alist
-  '((name . lastname)
-    (email . net)
-    (phone . phones))
-  "Alist mapping EUDC attribute names to BBDB names.")
-
-(eudc-protocol-set 'eudc-query-function 'eudc-bbdb-query-internal 'bbdb)
-(eudc-protocol-set 'eudc-list-attributes-function nil 'bbdb)
-(eudc-protocol-set 'eudc-protocol-attributes-translation-alist 
-		   'eudc-bbdb-attributes-translation-alist 'bbdb)
-(eudc-protocol-set 'eudc-bbdb-conversion-alist nil 'bbdb)
-(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'bbdb)
-
-(defun eudc-bbdb-format-query (query)
-  "Format a EUDC query alist into a list suitable to `bbdb-search'."
-  (let* ((firstname (cdr (assq 'firstname query)))
-	 (lastname (cdr (assq 'lastname query)))
-	 (name (or (and firstname lastname
-			(concat firstname " " lastname))
-		   firstname
-		   lastname))
-	(company (cdr (assq 'company query)))
-	(net (cdr (assq 'net query)))
-	(notes (cdr (assq 'notes query)))
-	(phone (cdr (assq 'phone query))))
-    (list name company net notes phone)))
-	
-
-(defun eudc-bbdb-filter-non-matching-record (record)
-  "Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
-  (catch 'unmatch
-    (progn
-      (mapcar 
-       (function 
-	(lambda (condition)
-	  (let ((attr (car condition))
-		(val (cdr condition))
-		bbdb-val)
-	    (or (and (memq attr '(firstname lastname aka company phones addresses net))
-		     (progn 
-		       (setq bbdb-val 
-			     (eval (list (intern (concat "bbdb-record-" 
-							 (symbol-name attr)))
-					 'record)))
-		       (if (listp bbdb-val)
-			   (if eudc-bbdb-enable-substring-matches
-			       (eval `(or ,@(mapcar '(lambda (subval)
-						     (string-match (downcase val)
-								   (downcase subval)))
-						  bbdb-val)))
-			     (member (downcase val)
-				     (mapcar 'downcase bbdb-val)))
-			 (if eudc-bbdb-enable-substring-matches
-			     (string-match (downcase val) bbdb-val)
-			   (equal (downcase val) bbdb-val)))))
-		(throw 'unmatch nil)))))
-       eudc-bbdb-current-query)
-      record)))
-
-(defun eudc-bbdb-extract-phones (record)
-  (mapcar (function
-	   (lambda (phone)
-	     (if eudc-bbdb-use-locations-as-attribute-names
-		 (cons (intern (bbdb-phone-location phone))
-		       (bbdb-phone-string phone))
-	       (cons 'phones (format "%s: %s" 
-				     (bbdb-phone-location phone)
-				     (bbdb-phone-string phone))))))
-	  (bbdb-record-phones record)))
-
-(defun eudc-bbdb-extract-addresses (record)
-  (let (s c val)
-    (mapcar (function
-	     (lambda (address)
-	       (setq val (concat (unless (= 0 (length (setq s (bbdb-address-street1 address))))
-				   (concat s "\n"))
-				 (unless (= 0 (length (setq s (bbdb-address-street2 address))))
-				   (concat s "\n"))
-				 (unless (= 0 (length (setq s (bbdb-address-street3 address))))
-				   (concat s "\n"))
-				 (progn 
-				   (setq c (bbdb-address-city address))
-				   (setq s (bbdb-address-state address))
-				   (if (and (> (length c) 0) (> (length s) 0))
-				       (concat c ", " s " ")
-				     (concat c " ")))
-				 (bbdb-address-zip-string address)))
-	       (if eudc-bbdb-use-locations-as-attribute-names
-		   (cons (intern (bbdb-address-location address)) val)
-		 (cons 'addresses (concat (bbdb-address-location address) "\n" val)))))
-	    (bbdb-record-addresses record))))
-
-(defun eudc-bbdb-format-record-as-result (record)
-  "Format the BBDB RECORD as a EUDC query result record.
-The record is filtered according to `eudc-bbdb-current-return-attributes'"
-  (let ((attrs (or eudc-bbdb-current-return-attributes
-		   '(firstname lastname aka company phones addresses net notes)))
-	attr
-	eudc-rec
-	val)
-    (while (prog1 
-	       (setq attr (car attrs))
-	     (setq attrs (cdr attrs)))
-      (cond
-       ((eq attr 'phones)
-	(setq val (eudc-bbdb-extract-phones record)))
-       ((eq attr 'addresses)
-	(setq val (eudc-bbdb-extract-addresses record)))
-       ((memq attr '(firstname lastname aka company net notes))
-	(setq val (eval 
-		   (list (intern 
-			  (concat "bbdb-record-" 
-				  (symbol-name attr)))
-			 'record))))
-       (t
-	(setq val "Unknown BBDB attribute")))
-      (if val
-	(cond 
-	 ((memq attr '(phones addresses))
-	  (setq eudc-rec (append val eudc-rec)))
-	 ((and (listp val)
-	  (= 1 (length val)))
-	  (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
-	 ((> (length val) 0)
-	  (setq eudc-rec (cons (cons attr val) eudc-rec)))
-	 (t
-	  (error "Unexpected attribute value")))))
-    (nreverse eudc-rec)))
-	
-
-
-(defun eudc-bbdb-query-internal (query &optional return-attrs)
-  "Query BBDB  with QUERY.
-QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid 
-BBDB attribute names.  
-RETURN-ATTRS is a list of attributes to return, defaulting to 
-`eudc-default-return-attributes'."
-
-  (let ((eudc-bbdb-current-query query)
-	(eudc-bbdb-current-return-attributes return-attrs)
-	(query-attrs (eudc-bbdb-format-query query))
-	bbdb-attrs
-	(records (bbdb-records))
-	result
-	filtered)
-    ;; BBDB ORs its query attributes while EUDC ANDs them, hence we need to
-    ;; call bbdb-search iteratively on the returned records for each of the
-    ;; requested attributes
-    (while (and records (> (length query-attrs) 0))
-      (setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
-      (if (car query-attrs)
-	  (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
-      (setq query-attrs (cdr query-attrs)))
-    (mapcar (function
-	     (lambda (record)
-	       (setq filtered (eudc-filter-duplicate-attributes record))
-	       ;; If there were duplicate attributes reverse the order of the
-	       ;; record so the unique attributes appear first
-	       (if (> (length filtered) 1)
-		   (setq filtered (mapcar (function 
-					   (lambda (rec)
-					     (reverse rec)))
-					  filtered)))
-	       (setq result (append result filtered))))
-	    (mapcar 'eudc-bbdb-format-record-as-result 
-		    (delq nil (mapcar 'eudc-bbdb-filter-non-matching-record records))))
-    result))
-
-;;}}}        
-
-;;{{{      High-level interfaces (interactive functions)
-
-(defun eudc-bbdb-set-server (dummy)
-  "Set the EUDC server to BBDB."
-  (interactive)
-  (eudc-set-server dummy 'bbdb)
-  (message "BBDB server selected"))
-
-;;;}}}
-
-
-(eudc-register-protocol 'bbdb)
-
-(provide 'eudc-bbdb)
-
-;;; eudc-bbdb.el ends here

eudc-ldap.el

-;;; eudc-ldap.el --- Emacs Unified Directory Client - LDAP Backend
-
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
-;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
-;; Created: Feb 1998
-;; Version: $Revision$
-;; Keywords: help
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 library.
-
-;;; Installation:
-;;    Install EUDC first. See EUDC documentation.
-
-;;    This library runs under XEmacs 20 and under Emacs 19.34 and above
-
-;;; Usage:
-
-;;; Code:
-
-(require 'eudc)
-(require 'ldap)
-
-
-;;{{{      Internal cooking
-
-(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)
-
-(defun eudc-filter-$ (string)
-  (let ((res ""))
-    (while (string-match " \\$ " string)
-      (setq res (concat res 
-			(substring string 0 (match-beginning 0))
-			"\n"))
-      (setq string (substring string (match-end 0))))
-    (setq res (concat res string))))
-
-(defun eudc-ldap-cleanup-record-field (field)
-  "Do some cleanup in a record field to make it suitable for EUDC."
-  ;; Make the field a cons-cell if it's single-valued
-  (if (stringp (car (cdr field)))
-      (cons (intern (car field)) 
-	    (eudc-filter-$ (car (cdr field))))
-    ;; Otherwise simply make the field name a symbol
-    (cons (intern (car field)) (cdr field))))
-
-(defun eudc-ldap-cleanup-record (record)
-  (mapcar 'eudc-ldap-cleanup-record-field
-	  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 (mapcar 'eudc-ldap-cleanup-record
-			(ldap-search (eudc-ldap-format-query-as-rfc1558 query)
-				     eudc-server
-				     (mapcar 'symbol-name return-attrs)))))
-    (if (and eudc-strict-return-matches
-	     return-attrs
-	     (not (eq 'all return-attrs)))
-	(eudc-filter-partial-records result return-attrs)
-      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
-	    (ldap-search 
-	     (eudc-ldap-format-query-as-rfc1558 
-	      (list (cons "objectclass"
-			  (or objectclass
-			      "person"))))
-	     eudc-server nil t))))
-
-(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) (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-set-server (server)
-  "Set the LDAP server to SERVER."
-  (interactive "sNew LDAP Server: ")
-  (eudc-set-server server 'ldap)
-  (message "Selected LDAP server is now %s" server))
-
-;;;}}}
-
-
-(eudc-register-protocol 'ldap)
-
-(provide 'eudc-ldap)
-
-;;; eudc-ldap.el ends here

eudc-ph.el

-;;; eudc-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
-
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
-;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@epfl.ch>
-;; Created: Feb 1998
-;; Version: $Revision$
-;; Keywords: help
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 CCSO PH/QI protocol support for the 
-;;    Emacs Unified Directory Client library.
-
-;;; Installation:
-;;    Install EUDC first. See EUDC documentation.
-
-;;    This library runs under XEmacs 20 and under Emacs 19.34 and above
-
-;;; Usage:
-
-;;; Code:
-
-(require 'eudc)
-
-
-;;{{{      Internal cooking
-
-(eudc-protocol-set 'eudc-bbdb-conversion-alist 'eudc-ph-bbdb-conversion-alist 'ph)
-(eudc-protocol-set 'eudc-query-function 'eudc-ph-query-internal 'ph)
-(eudc-protocol-set 'eudc-list-attributes-function 'eudc-ph-get-field-list 'ph)
-(eudc-protocol-set 'eudc-protocol-has-default-query-attributes t 'ph)
-
-(defvar eudc-ph-process-buffer nil)
-(defvar eudc-ph-read-point)
-
-(defconst eudc-ph-default-server-port 105
-  "Default TCP port for CCSO PH/QI directory services.")
-
-
-
-
-(defun eudc-ph-query-internal (query &optional return-fields)
-  "Query the PH/QI server with QUERY.
-QUERY can be a string NAME or a list made of strings NAME 
-and/or cons cells (KEY . VALUE) where KEYs should be valid 
-CCSO database keys.  NAME is equivalent to (DEFAULT . NAME),
-where DEFAULT is the default key of the database.
-RETURN-FIELDS is a list of database fields to return,
-defaulting to `eudc-default-return-attributes'."
-  (let (request)
-    (if (null return-fields)
-	(setq return-fields eudc-default-return-attributes))
-    (if (eq 'all return-fields)
-	(setq return-fields '(all)))
-    (setq request 
-	  (concat "query "
-		  (if (stringp query)
-		      query
-		    (mapconcat (function (lambda (elt)
-					   (if (stringp elt) elt)
-					   (format "%s=%s" (car elt) (cdr elt))))
-			       query
-			       " "))
-		  (if return-fields
-		      (concat " return " (mapconcat 'symbol-name return-fields " ")))))
-    (and (> (length request) 6)
-	 (eudc-ph-do-request request)
-	 (eudc-ph-parse-query-result return-fields))))
-
-(defun eudc-ph-get-field-list (full-records)
-  "Return a list of valid field names for the current server.
-If FULL-RECORDS is non-nil, full records including field description
-are returned"
-  (interactive)
-  (eudc-ph-do-request "fields")
-  (if full-records
-      (eudc-ph-parse-query-result)
-    (mapcar 'eudc-caar (eudc-ph-parse-query-result))))
-
-
-(defun eudc-ph-parse-query-result (&optional fields)
-  "Return a list of alists of key/values from in `eudc-ph-process-buffer'. 
-Fields not in FIELDS are discarded."
-  (let (record 
-	records
-	line-regexp
-	current-key
-	key
-	value
-	ignore)
-    (save-excursion
-      (message "Parsing results...")
-      (set-buffer eudc-ph-process-buffer)
-      (goto-char (point-min))
-      (while (re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" nil t)
-	(catch 'ignore
-	  (setq line-regexp (concat "^\\(-[0-9]+\\):" (match-string 2) ":[ \t]*\\([-a-zA-Z_]*\\)?:[ \t]*\\(.*\\)$"))
-	  (beginning-of-line)
-	  (setq record nil
-		ignore nil
-		current-key nil)
-	  (while (re-search-forward line-regexp nil t)
-	    (catch 'skip-line
-	      (if (string= "-508" (match-string 1))
-		  ;; A field is missing in this entry.  Skip it or skip the
-		  ;; whole record (see `eudc-strict-return-matches')
-		  (if (not eudc-strict-return-matches)
-		      (throw 'skip-line t)
-		    (while (re-search-forward line-regexp nil t))
-		    (setq ignore t)
-		    (throw 'ignore t)))
-	      (setq key   (and (not (string= (match-string 2) ""))
-			       (intern (match-string 2)))
-		    value (match-string 3))
-	      (if (and current-key
-		       (eq key current-key)) 
-		  (setq key nil)
-		(setq current-key key))
-	      (if (or (null fields)
-		      (eq 'all fields)
-		      (memq current-key fields))
-		  (if key
-		      (setq record (cons (cons key value) record)) ; New key
-		    (setcdr (car record) (if (listp (eudc-cdar record))
-					     (append (eudc-cdar record) (list value))
-					   (list (eudc-cdar record) value))))))))
-	(and (not ignore)
-	     (or (null fields)
-		 (eq 'all fields)
-		 (setq record (nreverse record)))
-	     (setq record (if (not (eq 'list eudc-duplicate-attribute-handling-method))
-			      (eudc-filter-duplicate-attributes record)
-			    (list record)))
-	     (setq records (append record records))))
-      )
-    (message "Done")
-    records)
-  )
-
-(defun eudc-ph-do-request (request)
-  "Send REQUEST to the server.
-Wait for response and return the buffer containing it."
-  (let (process
-	buffer)
-    (unwind-protect
-	(progn
-	  (message "Contacting server...")
-	  (setq process (eudc-ph-open-session))
-	  (if process
-	      (save-excursion 
-		(set-buffer (setq buffer (process-buffer process)))
-		(eudc-ph-send-command process request)
-		(message "Request sent, waiting for reply...")
-		(eudc-ph-read-response process))))
-      (if process
-	  (eudc-ph-close-session process)))
-    buffer))
-        
-(defun eudc-ph-open-session (&optional server)
-  "Open a connection to the given CCSO/QI SERVER.
-SERVER is either a string naming the server or a list (NAME PORT)."
-  (let (process
-	host
-	port)
-    (catch 'done
-      (if (null server)
-	  (setq server (or eudc-server
-			   (call-interactively 'eudc-ph-set-server))))
-      (string-match "\\(.*\\)\\(:\\(.*\\)\\)?" server)
-      (setq host (match-string 1 server))
-      (setq port (or (match-string 3 server)
-		     eudc-ph-default-server-port))
-      (setq eudc-ph-process-buffer (get-buffer-create (format " *PH-%s*" host)))
-      (save-excursion
-	(set-buffer eudc-ph-process-buffer)
-	(erase-buffer)
-	(setq eudc-ph-read-point (point))
-	(and eudc-xemacs-mule-p
-	     (set-buffer-file-coding-system 'binary t)))
-      (setq process (open-network-stream "ph" eudc-ph-process-buffer host port))
-      (if (null process)
-	  (throw 'done nil))
-      (process-kill-without-query process)
-      process)))
-
-
-(defun eudc-ph-close-session (process)
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (eudc-ph-send-command process "quit")
-    (eudc-ph-read-response process)
-    (if (fboundp 'add-async-timeout)
-	(add-async-timeout 10 'delete-process process)
-      (run-at-time 2 nil 'delete-process process))))
-
-(defun eudc-ph-send-command (process command)
-  (goto-char (point-max))
-  (process-send-string process command)
-  (process-send-string process "\r\n")
-  )
-
-(defun eudc-ph-read-response (process &optional return-response)
-  "Read a response from the PH/QI query process PROCESS.
-Returns nil if response starts with an error code.  If the
-response is successful the return code or the reponse itself is returned
-depending on RETURN-RESPONSE."
-  (let ((case-fold-search nil)
-	return-code
-	match-end)
-    (goto-char eudc-ph-read-point)
-    ;; CCSO protocol : response complete if status >= 200
-    (while (not (re-search-forward "^\\(^[2-5].*\\):.*\n" nil t))
-      (accept-process-output process)
-      (goto-char eudc-ph-read-point))
-    (setq match-end (point))
-    (goto-char eudc-ph-read-point)
-    (if (and (setq return-code (match-string 1))
-	     (setq return-code (string-to-number return-code))
-	     (>= (abs return-code) 300))
-	(progn (setq eudc-ph-read-point match-end) nil)
-      (setq eudc-ph-read-point match-end)
-      (if return-response
-	  (buffer-substring (point) match-end)
-	return-code))))
-
-;;}}}        
-
-;;{{{      High-level interfaces (interactive functions)
-
-(defun eudc-ph-customize ()
-  "Customize the EUDC PH support."
-  (interactive)
-  (customize-group 'eudc-ph))
-
-(defun eudc-ph-set-server (server)
-  "Set the PH server to SERVER."
-  (interactive "sNew PH/QI Server: ")
-  (message "Selected PH/QI server is now %s" server)
-  (eudc-set-server server 'ph))
-
-;;}}}
-
-
-(eudc-register-protocol 'ph)
-
-(provide 'eudc-ph)
-
-;;; eudc-ph.el ends here