/[emacs]/emacs/lisp/net/eudcb-ph.el
ViewVC logotype

Diff of /emacs/lisp/net/eudcb-ph.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by pj, Tue Jan 8 06:58:13 2002 UTC revision 1.5 by pj, Wed Jan 16 08:16:01 2002 UTC
# Line 24  Line 24 
24  ;; Boston, MA 02111-1307, USA.  ;; Boston, MA 02111-1307, USA.
25    
26  ;;; Commentary:  ;;; Commentary:
27    
28  ;;    This library provides specific CCSO PH/QI protocol support for the  ;;    This library provides specific CCSO PH/QI protocol support for the
29  ;;    Emacs Unified Directory Client package  ;;    Emacs Unified Directory Client package.
30    
31  ;;; Code:  ;;; Code:
32    
33  (require 'eudc)  (require 'eudc)
34    
   
35  ;;{{{      Internal cooking  ;;{{{      Internal cooking
36    
37  (eudc-protocol-set 'eudc-bbdb-conversion-alist 'eudc-ph-bbdb-conversion-alist 'ph)  (eudc-protocol-set 'eudc-bbdb-conversion-alist 'eudc-ph-bbdb-conversion-alist 'ph)
# Line 45  Line 45 
45  (defconst eudc-ph-default-server-port 105  (defconst eudc-ph-default-server-port 105
46    "Default TCP port for CCSO PH/QI directory services.")    "Default TCP port for CCSO PH/QI directory services.")
47    
   
   
   
48  (defun eudc-ph-query-internal (query &optional return-fields)  (defun eudc-ph-query-internal (query &optional return-fields)
49    "Query the PH/QI server with QUERY.    "Query the PH/QI server with QUERY.
50  QUERY can be a string NAME or a list made of strings NAME  QUERY can be a string NAME or a list made of strings NAME
# Line 86  are returned" Line 83  are returned"
83        (eudc-ph-parse-query-result)        (eudc-ph-parse-query-result)
84      (mapcar 'eudc-caar (eudc-ph-parse-query-result))))      (mapcar 'eudc-caar (eudc-ph-parse-query-result))))
85    
   
86  (defun eudc-ph-parse-query-result (&optional fields)  (defun eudc-ph-parse-query-result (&optional fields)
87    "Return a list of alists of key/values from in `eudc-ph-process-buffer'.    "Return a list of alists of key/values from in `eudc-ph-process-buffer'.
88  Fields not in FIELDS are discarded."  Fields not in FIELDS are discarded."
# Line 140  Fields not in FIELDS are discarded." Line 136  Fields not in FIELDS are discarded."
136               (setq record (if (not (eq 'list eudc-duplicate-attribute-handling-method))               (setq record (if (not (eq 'list eudc-duplicate-attribute-handling-method))
137                                (eudc-filter-duplicate-attributes record)                                (eudc-filter-duplicate-attributes record)
138                              (list record)))                              (list record)))
139               (setq records (append record records))))               (setq records (append record records)))))
       )  
140      (message "Done")      (message "Done")
141      records)      records))
   )  
142    
143  (defun eudc-ph-do-request (request)  (defun eudc-ph-do-request (request)
144    "Send REQUEST to the server.    "Send REQUEST to the server.
# Line 192  SERVER is either a string naming the ser Line 186  SERVER is either a string naming the ser
186        (process-kill-without-query process)        (process-kill-without-query process)
187        process)))        process)))
188    
   
189  (defun eudc-ph-close-session (process)  (defun eudc-ph-close-session (process)
190    (save-excursion    (save-excursion
191      (set-buffer (process-buffer process))      (set-buffer (process-buffer process))
192      (eudc-ph-send-command process "quit")      (eudc-ph-send-command process "quit")
193      (eudc-ph-read-response process)      (eudc-ph-read-response process)
194      (if (fboundp 'add-async-timeout)      (run-at-time 2 nil 'delete-process process)))
         (add-async-timeout 10 'delete-process process)  
       (run-at-time 2 nil 'delete-process process))))  
195    
196  (defun eudc-ph-send-command (process command)  (defun eudc-ph-send-command (process command)
197    (goto-char (point-max))    (goto-char (point-max))
# Line 249  depending on RETURN-RESPONSE." Line 240  depending on RETURN-RESPONSE."
240    
241  ;;}}}  ;;}}}
242    
   
243  (eudc-register-protocol 'ph)  (eudc-register-protocol 'ph)
244    
245  (provide 'eudcb-ph)  (provide 'eudcb-ph)

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26