;ELC ;;; Compiled by pot@pot.cnuce.cnr.it on Tue Mar 18 15:48:44 2003 ;;; from file /home/pot/gnu/emacs-pretest.new/lisp/net/eudcb-ph.el ;;; in Emacs version 21.3 ;;; with bytecomp version 2.85.4.1 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. (if (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`eudcb-ph.el' was compiled for Emacs 19.29 or later")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (byte-code "\302\303!\210\304\305\306\307#\210\304\310\311\307#\210\304\312\313\307#\210\304\314\315\307#\210\301B\316\301!\204(\317\320B\317\207" [current-load-list eudc-ph-process-buffer require eudc eudc-protocol-set eudc-bbdb-conversion-alist eudc-ph-bbdb-conversion-alist ph eudc-query-function eudc-ph-query-internal eudc-list-attributes-function eudc-ph-get-field-list eudc-protocol-has-default-query-attributes t boundp nil eudc-ph-read-point] 4) #@53 Default TCP port for CCSO PH/QI directory services. (defconst eudc-ph-default-server-port 105 (#$ . 1083)) #@368 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'. (defalias 'eudc-ph-query-internal #[(query &optional return-fields) "\304 \204\n \305=\203\306\307 ;\203 \202\310\311 \312# \205*\313\310\314 \312#PQ\211G\315V\205<\316!\205<\317 !)\207" [request return-fields eudc-default-return-attributes query nil all (all) "query " mapconcat #[(elt) ";\203\210\301\302@A#\207" [elt format "%s=%s"] 4] " " " return " symbol-name 6 eudc-ph-do-request eudc-ph-parse-query-result] 8 (#$ . 1197)]) #@142 Return a list of valid field names for the current server. If FULL-RECORDS is non-nil, full records including field description are returned (defalias 'eudc-ph-get-field-list #[(full-records) "\301\302!\210\203 \303 \207\304\305\303 \"\207" [full-records eudc-ph-do-request "fields" eudc-ph-parse-query-result mapcar eudc-caar] 3 (#$ . 2024) nil]) #@110 Return a list of alists of key/values from in `eudc-ph-process-buffer'. Fields not in FIELDS are discarded. (defalias 'eudc-ph-parse-query-result #[(&optional fields) "\306\211\211\211\211\211\211\212\307\310!\210q\210eb\210\311\312\306\313#\203`\300\314\215\210\204\203@\315=\204@\237\211\203\316=\204N\317!\202QC\211\203\320 \"\202)\307\321!\210 .\207" [ignore value key current-key line-regexp records nil message "Parsing results..." re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" t (byte-code "\304\305\306!\307Q\310 \210\311\311\311\312\311\313#\203\314\315\215\210\202\311\207" [line-regexp record ignore current-key "^\\(-[0-9]+\\):" match-string 2 ":[ ]*\\([-a-zA-Z_]*\\)?:[ ]*\\(.*\\)$" beginning-of-line nil re-search-forward t skip-line (byte-code "\306\307!\310\230\203#\204\311\312\313\"\210\202#\314 \315\313#\204\313\311\302\313\"\210\306\316!\317\230?\2051\320\306\316!!\306\321! \203E =\203E\315\202G \203Z\322=\204Z >\203\207 \203i \fBB\202\207@\323!<\203\324\323!\fC\"\202\205\323!\fD\241\210\315\207" [eudc-strict-return-matches line-regexp ignore key value current-key match-string 1 "-508" throw skip-line t re-search-forward nil 2 "" intern 3 all eudc-cdar append fields record] 4)] 4) all list eudc-filter-duplicate-attributes append "Done" record eudc-ph-process-buffer fields eudc-duplicate-attribute-handling-method] 7 (#$ . 2381)]) #@84 Send REQUEST to the server. Wait for response and return the buffer containing it. (defalias 'eudc-ph-do-request #[(request) "\303\211\304\216\305\306!\210\307 \211\203'\212\310 !\211q\210\311 \n\"\210\305\312!\210\313 !\210))*\207" [buffer process request nil ((byte-code "\203\301!\210\301\207" [process eudc-ph-close-session] 2)) message "Contacting server..." eudc-ph-open-session process-buffer eudc-ph-send-command "Request sent, waiting for reply..." eudc-ph-read-response] 4 (#$ . 3849)]) #@115 Open a connection to the given CCSO/QI SERVER. SERVER is either a string naming the server or a list (NAME PORT). (defalias 'eudc-ph-open-session #[(&optional server) "\303\211\211\304\305\215+\207" [port host process nil done (byte-code "\204\f \206 \306\307!\310\311\"\210\312\313\"\312\314\"\206 \315\316\317\n\"!\212 q\210\320 \210`\203:\321\322\323\"\210)\324\325 \n\f$\211\204L\326\327\330\"\210\331!\210\207" [server eudc-server host eudc-ph-default-server-port port eudc-ph-process-buffer call-interactively eudc-ph-set-server string-match "\\(.*\\)\\(:\\(.*\\)\\)?" match-string 1 3 get-buffer-create format " *PH-%s*" erase-buffer set-buffer-file-coding-system binary t open-network-stream "ph" throw done nil process-kill-without-query eudc-ph-read-point eudc-xemacs-mule-p process] 6)] 3 (#$ . 4363)]) (defalias 'eudc-ph-close-session #[(process) "\212\301!q\210\302\303\"\210\304!\210\305\306!\203\306\307\310#\202#\311\312\313\310$)\207" [process process-buffer eudc-ph-send-command "quit" eudc-ph-read-response fboundp add-async-timeout 10 delete-process run-at-time 2 nil] 5]) (defalias 'eudc-ph-send-command #[(process command) "db\210\302 \"\210\302\303\"\207" [process command process-send-string " \n"] 3]) #@218 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 response itself is returned depending on RETURN-RESPONSE. (defalias 'eudc-ph-read-response #[(process &optional return-response) "\306\211\211 b\210\307\310\306\311#\204\312\f!\210 b\210\202 ` b\210\313\314!\211\203>\315 !\211\203>\316 !\317Y\203>\306\202K \203J`{\202K +\207" [match-end return-code case-fold-search eudc-ph-read-point process return-response nil re-search-forward "^\\(^[2-5].*\\):.*\n" t accept-process-output match-string 1 string-to-number abs 300] 4 (#$ . 5634)]) #@32 Customize the EUDC PH support. (defalias 'eudc-ph-customize #[nil "\300\301!\207" [customize-group eudc-ph] 2 (#$ . 6305) nil]) #@30 Set the PH server to SERVER. (defalias 'eudc-ph-set-server #[(server) "\301\302\"\210\303\304\"\207" [server message "Selected PH/QI server is now %s" eudc-set-server ph] 3 (#$ . 6439) "sNew PH/QI Server: "]) (byte-code "\300\301!\210\302\303!\207" [eudc-register-protocol ph provide eudcb-ph] 2)