comparison lisp/ph.el @ 19064:8906a04da073

Many doc strings and messages changed.
author Richard M. Stallman <rms@gnu.org>
date Fri, 01 Aug 1997 01:04:56 +0000
parents ea2fb7cfc3f1
children 4c82de07281c
comparison
equal deleted inserted replaced
19063:35cddfda2ba8 19064:8906a04da073
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 4
5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> 6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch>
7 ;; Created: May 1997 7 ;; Created: May 1997
8 ;; Version: 2.6 8 ;; Version: 2.8
9 ;; Keywords: help 9 ;; Keywords: help
10 10
11 ;; This file is part of GNU Emacs 11 ;; This file is part of GNU Emacs
12 12
13 ;; GNU Emacs is free software; you can redistribute it and/or modify it 13 ;; GNU Emacs is free software; you can redistribute it and/or modify it
27 27
28 ;;; Commentary: 28 ;;; Commentary:
29 ;; This package provides functions to query CCSO PH/QI nameservers 29 ;; This package provides functions to query CCSO PH/QI nameservers
30 ;; through an interactive form or replace inline query strings in 30 ;; through an interactive form or replace inline query strings in
31 ;; buffers with appropriately formatted query results (especially 31 ;; buffers with appropriately formatted query results (especially
32 ;; used to expand email addresses in message buffers). It also 32 ;; used to expand email addresses in message buffers). It also
33 ;; interfaces with the BBDB package to let you register entries of 33 ;; interfaces with the BBDB package to let you register entries of
34 ;; the CCSO PH/QI directory into your own database. The CCSO PH/QI 34 ;; the CCSO PH/QI directory into your own database. The CCSO PH/QI
35 ;; white pages system was developped at UIUC and is in use in more 35 ;; white pages system was developped at UIUC and is in use in more
36 ;; than 300 sites in the world. The distribution can be found at 36 ;; than 300 sites in the world. The distribution can be found at
37 ;; ftp://uiarchive.cso.uiuc.edu/pub/packages/ph Traditionally the 37 ;; ftp://uiarchive.cso.uiuc.edu/pub/packages/ph Traditionally the
38 ;; server is called QI while the client is called PH. 38 ;; server is called QI while the client is called PH.
39 39
40 ;;; Installation: 40 ;;; Installation:
41 ;; This package uses the custom and widget libraries. If they are not already 41 ;; This package uses the custom and widget libraries. If they are not already
42 ;; installed on your system get them from http://www.dina.kvl.dk/~abraham/custom/ 42 ;; installed on your system get them from http://www.dina.kvl.dk/~abraham/custom/
43 ;; Then uncomment and add the following to your .emacs file: 43 ;; Then uncomment and add the following to your .emacs file:
44 ;; (require 'ph) 44 ;; (require 'ph)
45 ;; (eval-after-load "message" 45 ;; (eval-after-load "message"
46 ;; '(define-key message-mode-map [(control ?c) (tab)] 'ph-expand-inline)) 46 ;; '(define-key message-mode-map [(control ?c) (tab)] 'ph-expand-inline))
51 ;; This package runs under XEmacs 19.15 or 20 and under Emacs 19.34 and above 51 ;; This package runs under XEmacs 19.15 or 20 and under Emacs 19.34 and above
52 52
53 ;;; Usage: 53 ;;; Usage:
54 ;; - Provided you did the installation as proposed in the above section, 54 ;; - Provided you did the installation as proposed in the above section,
55 ;; inline expansion will be available when you compose an email 55 ;; inline expansion will be available when you compose an email
56 ;; message. Type the name of somebody recorded in your PH/QI server and hit 56 ;; message. Type the name of somebody recorded in your PH/QI server and hit
57 ;; C-c TAB, this will overwrite the name with the corresponding email 57 ;; C-c TAB, this will overwrite the name with the corresponding email
58 ;; address 58 ;; address
59 ;; - M-x ph-customize to customize inline expansion and other features to 59 ;; - M-x ph-customize to customize inline expansion and other features to
60 ;; your needs. 60 ;; your needs.
61 ;; - Look for the Ph submenu in the Tools menu for more. 61 ;; - Look for the Ph submenu in the Tools menu for more.
83 number to the name of the server." 83 number to the name of the server."
84 :type '(string :tag "Server") 84 :type '(string :tag "Server")
85 :group 'ph) 85 :group 'ph)
86 86
87 (defcustom ph-strict-return-matches t 87 (defcustom ph-strict-return-matches t
88 "*If non-nil, entries that do not contain all the requested return fields are ignored." 88 "*If non-nil, entries not containing all requested return fields are ignored."
89 :type 'boolean 89 :type 'boolean
90 :group 'ph) 90 :group 'ph)
91 91
92 (defcustom ph-default-return-fields nil 92 (defcustom ph-default-return-fields nil
93 "*A list of the default fields to extract from CCSO entries. 93 "*A list of the default fields to extract from CCSO entries.
95 nil means return the default fields as configured in the server." 95 nil means return the default fields as configured in the server."
96 :type '(repeat (symbol :tag "Field name")) 96 :type '(repeat (symbol :tag "Field name"))
97 :group 'ph) 97 :group 'ph)
98 98
99 (defcustom ph-multiple-match-handling-method 'select 99 (defcustom ph-multiple-match-handling-method 'select
100 "*What to do when multiple entries match a query for an inline expansion. 100 "*What to do when multiple entries match an inline expansion query.
101 Possible values are: 101 Possible values are:
102 `first' (equivalent to nil) which means consider the first match. 102 `first' (equivalent to nil) which means consider the first match,
103 `select' pop-up a selection buffer 103 `select' pop-up a selection buffer,
104 `all' use all matches 104 `all' use all matches,
105 `abort' the operation is aborted, an error is signaled" 105 `abort' the operation is aborted, an error is signaled."
106 :type '(choice :menu-tag "Method" 106 :type '(choice :menu-tag "Method"
107 (const :menu-tag "First" first) 107 (const :menu-tag "First" first)
108 (const :menu-tag "Select" select) 108 (const :menu-tag "Select" select)
109 (const :menu-tag "All" all) 109 (const :menu-tag "All" all)
110 (const :menu-tag "Abort" abort) 110 (const :menu-tag "Abort" abort)
115 "*A method to handle entries containing duplicate fields. 115 "*A method to handle entries containing duplicate fields.
116 This is either an alist (FIELD . METHOD) or a symbol METHOD. 116 This is either an alist (FIELD . METHOD) or a symbol METHOD.
117 The alist form of the variable associates a method to an individual field, 117 The alist form of the variable associates a method to an individual field,
118 the second form specifies a method applicable to all fields. 118 the second form specifies a method applicable to all fields.
119 Available methods are: 119 Available methods are:
120 `list' or nil lets the value of the field be a list of values 120 `list' or nil lets the value of the field be a list of values,
121 `first' keeps the first value and discards the others, 121 `first' keeps the first value and discards the others,
122 `concat' concatenates the values into a single multiline string, 122 `concat' concatenates the values into a single multiline string,
123 `duplicate' duplicates the entire entry into as many instances as 123 `duplicate' duplicates the entire entry into as many instances as
124 different values." 124 different values."
125 :type '(choice (const :menu-tag "List" list) 125 :type '(choice (const :menu-tag "List" list)
147 If nil all the words will be mapped onto the default CCSO database key." 147 If nil all the words will be mapped onto the default CCSO database key."
148 :type '(repeat (symbol :tag "Field name")) 148 :type '(repeat (symbol :tag "Field name"))
149 :group 'ph) 149 :group 'ph)
150 150
151 (defcustom ph-expanding-overwrites-query t 151 (defcustom ph-expanding-overwrites-query t
152 "*If non nil, expanding a query overwrites the query string" 152 "*If non nil, expanding a query overwrites the query string."
153 :type 'boolean 153 :type 'boolean
154 :group 'ph) 154 :group 'ph)
155 155
156 (defcustom ph-inline-expansion-format '("%s" email) 156 (defcustom ph-inline-expansion-format '("%s" email)
157 "*A list specifying the format of the expansion of inline queries. 157 "*A list specifying the format of the expansion of inline queries.
158 This variable controls what ph-expand-inline actually inserts in the buffer. 158 This variable controls what `ph-expand-inline' actually inserts in the buffer.
159 First element is a string passed to format. Remaining elements are symbols 159 First element is a string passed to `format'. Remaining elements are symbols
160 indicating CCSO database field names, corresponding field values are passed 160 indicating CCSO database field names, corresponding field values are passed
161 as additional arguments to format." 161 as additional arguments to `format'."
162 :type '(list (string :tag "Format String") 162 :type '(list (string :tag "Format String")
163 (repeat :inline t 163 (repeat :inline t
164 :tag "Field names" 164 :tag "Field names"
165 (symbol :tag ""))) 165 (symbol :tag "")))
166 :group 'ph) 166 :group 'ph)
174 (defcustom ph-fieldname-formstring-alist '((url . "URL") 174 (defcustom ph-fieldname-formstring-alist '((url . "URL")
175 (callsign . "HAM Call Sign") 175 (callsign . "HAM Call Sign")
176 (id . "ID") 176 (id . "ID")
177 (email . "E-Mail") 177 (email . "E-Mail")
178 (firstname . "First Name")) 178 (firstname . "First Name"))
179 "*A mapping of CCSO database field names onto prompt strings used in query/response forms. 179 "*Map CCSO database field names into prompt strings for query/response.
180 Prompt strings for fields that are not in this are derived by splitting the field name 180 Prompt strings for fields that are not listed here
181 are derived by splitting the field name
181 at `_' signs and capitalizing the individual words." 182 at `_' signs and capitalizing the individual words."
182 :tag "Mapping of Field Names onto Prompt Strings" 183 :tag "Mapping of Field Names onto Prompt Strings"
183 :type '(repeat (cons :tag "Field" 184 :type '(repeat (cons :tag "Field"
184 (symbol :tag "Name") 185 (symbol :tag "Name")
185 (string :tag "Prompt string"))) 186 (string :tag "Prompt string")))
194 "*A mapping from BBDB to PH/QI fields. 195 "*A mapping from BBDB to PH/QI fields.
195 This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where 196 This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where
196 BBDB-FIELD is the name of a field that must be defined in your BBDB 197 BBDB-FIELD is the name of a field that must be defined in your BBDB
197 environment (standard field names are `name', `company', `net', `phone', 198 environment (standard field names are `name', `company', `net', `phone',
198 `address' and `notes'). SPEC-OR-LIST is either a single SPEC or a list 199 `address' and `notes'). SPEC-OR-LIST is either a single SPEC or a list
199 of SPECs. Lists of specs are valid only for the `phone' and `address' 200 of SPECs. Lists of specs are valid only for the `phone' and `address'
200 BBDB fields. SPECs are sexps which are evaluated: 201 BBDB fields. SPECs are sexps which are evaluated:
201 a string evaluates to itself 202 a string evaluates to itself,
202 a symbol evaluates to the symbol value. Symbols naming PH/QI fields 203 a symbol evaluates to the symbol value. Symbols naming PH/QI fields
203 present in the record evaluate to the value of the field in the record 204 present in the record evaluate to the value of the field in the record,
204 a form is evaluated as a function. The argument list may contain PH/QI 205 a form is evaluated as a function. The argument list may contain PH/QI
205 field names which eval to the corresponding values in the 206 field names which eval to the corresponding values in the
206 record. The form evaluation should return something appropriate for 207 record. The form evaluation should return something appropriate for
207 the particular BBDB-FIELD (see bbdb-create-internal). 208 the particular BBDB-FIELD (see `bbdb-create-internal').
208 ph-bbdbify-phone and ph-bbdbify-address are provided as convenience 209 `ph-bbdbify-phone' and `ph-bbdbify-address' are provided as convenience
209 functions to parse phones and addresses." 210 functions to parse phones and addresses."
210 :tag "BBDB to CCSO Field Name Mapping" 211 :tag "BBDB to CCSO Field Name Mapping"
211 :type '(repeat (cons :tag "Field Name" 212 :type '(repeat (cons :tag "Field Name"
212 (symbol :tag "BBDB Field") 213 (symbol :tag "BBDB Field")
213 (sexp :tag "Conversion Spec"))) 214 (sexp :tag "Conversion Spec")))
214 :group 'ph) 215 :group 'ph)
215 216
216 (defcustom ph-options-file "~/.ph-options" 217 (defcustom ph-options-file "~/.ph-options"
217 "*A file where the `servers' hotlist is stored." 218 "*A file where the PH `servers' hotlist is stored."
218 :type '(file :Tag "File Name:")) 219 :type '(file :Tag "File Name:"))
219 220
220 (defcustom ph-mode-hook nil 221 (defcustom ph-mode-hook nil
221 "*Normal hook run on entry to ph-mode." 222 "*Normal hook run on entry to PH mode."
222 :type '(repeat (sexp :tag "Hook"))) 223 :type '(repeat (sexp :tag "Hook")))
223 224
224 ;;}}} 225 ;;}}}
225 226
226 227
235 (featurep 'mule))) 236 (featurep 'mule)))
236 237
237 (defvar ph-server-hotlist nil) 238 (defvar ph-server-hotlist nil)
238 239
239 (defconst ph-default-server-port 105 240 (defconst ph-default-server-port 105
240 "Default TCP port for CCSO directory services") 241 "Default TCP port for CCSO directory services.")
241 242
242 (defvar ph-form-widget-list nil) 243 (defvar ph-form-widget-list nil)
243 (defvar ph-process-buffer nil) 244 (defvar ph-process-buffer nil)
244 (defvar ph-read-point) 245 (defvar ph-read-point)
245 246
258 (defun ph-mode () 259 (defun ph-mode ()
259 "Major mode used in buffers displaying the results of PH queries. 260 "Major mode used in buffers displaying the results of PH queries.
260 There is no sense in calling this command from a buffer other than 261 There is no sense in calling this command from a buffer other than
261 one containing the results of a PH query. 262 one containing the results of a PH query.
262 263
263 Available bindings: 264 These are the special commands of PH mode:
264 \\{ph-mode-map}" 265 q -- kill this buffer.
266 f -- Display a form to query the CCSO PH/QI nameserver.
267 n -- Move to next record.
268 p -- Move to previous record."
265 (interactive) 269 (interactive)
266 (kill-all-local-variables) 270 (kill-all-local-variables)
267 (setq major-mode 'ph-mode) 271 (setq major-mode 'ph-mode)
268 (setq mode-name "PH") 272 (setq mode-name "PH")
269 (use-local-map ph-mode-map) 273 (use-local-map ph-mode-map)
271 (run-hooks 'ph-mode-hook) 275 (run-hooks 'ph-mode-hook)
272 ) 276 )
273 277
274 (defun ph-display-records (records &optional raw-field-names) 278 (defun ph-display-records (records &optional raw-field-names)
275 "Display the record list RECORDS in a formatted buffer. 279 "Display the record list RECORDS in a formatted buffer.
276 If RAW-FIELD-NAMES is non-nil, field names will be formatted to look 280 If RAW-FIELD-NAMES is non-nil, the raw field names are displayed
277 more attractive byi capitalizing and forming strings." 281 otherwise they are formatted according to `ph-fieldname-formstring-alist'."
278 (let ((buffer (get-buffer-create "*PH Query Results*")) 282 (let ((buffer (get-buffer-create "*PH Query Results*"))
279 inhibit-read-only 283 inhibit-read-only
280 precords 284 precords
281 (width 0) 285 (width 0)
282 beg field-beg 286 beg field-beg
353 (widget-setup) 357 (widget-setup)
354 ) 358 )
355 ) 359 )
356 360
357 (defun ph-process-form () 361 (defun ph-process-form ()
358 "Process the form in current buffer and display the results" 362 "Process the form in current buffer and display the results."
359 (let (query-alist 363 (let (query-alist
360 value) 364 value)
361 (if (not (and (boundp 'ph-form-widget-list) 365 (if (not (and (boundp 'ph-form-widget-list)
362 ph-form-widget-list)) 366 ph-form-widget-list))
363 (error "Not in a PH query form buffer") 367 (error "Not in a PH query form buffer")
375 379
376 (defun ph-query-internal (query &optional return-fields) 380 (defun ph-query-internal (query &optional return-fields)
377 "Query the PH/QI server with QUERY. 381 "Query the PH/QI server with QUERY.
378 QUERY can be a string NAME or a list made of strings NAME 382 QUERY can be a string NAME or a list made of strings NAME
379 and/or cons cells (KEY . VALUE) where KEYs should be valid 383 and/or cons cells (KEY . VALUE) where KEYs should be valid
380 CCSO database keys. NAME is equivalent to (DEFAULT . NAME) where 384 CCSO database keys. NAME is equivalent to (DEFAULT . NAME),
381 DEFAULT is the default key of the database) 385 where DEFAULT is the default key of the database.
382 RETURN-FIELDS is a list of database fields to return defaulting to 386 RETURN-FIELDS is a list of database fields to return,
383 ph-default-return-fields." 387 defaulting to `ph-default-return-fields'."
384 (let (request) 388 (let (request)
385 (if (null return-fields) 389 (if (null return-fields)
386 (setq return-fields ph-default-return-fields)) 390 (setq return-fields ph-default-return-fields))
387 (setq request 391 (setq request
388 (concat "query " 392 (concat "query "
398 (and (> (length request) 6) 402 (and (> (length request) 6)
399 (ph-do-request request) 403 (ph-do-request request)
400 (ph-parse-query-result return-fields)))) 404 (ph-parse-query-result return-fields))))
401 405
402 (defun ph-parse-query-result (&optional fields) 406 (defun ph-parse-query-result (&optional fields)
403 "Return a list of alists of key/values from the record in ph-process-buffer. 407 "Return a list of alists of key/values from in `ph-process-buffer'.
404 Fields not in FIELDS are discarded." 408 Fields not in FIELDS are discarded."
405 (let (record records 409 (let (record
406 line-regexp 410 records
407 current-key key value 411 line-regexp
408 ignore) 412 current-key
413 key
414 value
415 ignore)
409 (save-excursion 416 (save-excursion
410 (message "Parsing results...") 417 (message "Parsing results...")
411 (set-buffer ph-process-buffer) 418 (set-buffer ph-process-buffer)
412 (goto-char (point-min)) 419 (goto-char (point-min))
413 (while (re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" nil t) 420 (while (re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" nil t)
418 ignore nil 425 ignore nil
419 current-key nil) 426 current-key nil)
420 (while (re-search-forward line-regexp nil t) 427 (while (re-search-forward line-regexp nil t)
421 (catch 'skip-line 428 (catch 'skip-line
422 (if (string= "-508" (match-string 1)) 429 (if (string= "-508" (match-string 1))
423 ;; A field is missing in this entry. Skip it or skip the 430 ;; A field is missing in this entry. Skip it or skip the
424 ;; whole record (see ph-strict-return-matches) 431 ;; whole record (see ph-strict-return-matches)
425 (if (not ph-strict-return-matches) 432 (if (not ph-strict-return-matches)
426 (throw 'skip-line t) 433 (throw 'skip-line t)
427 (while (re-search-forward line-regexp nil t)) 434 (while (re-search-forward line-regexp nil t))
428 (setq ignore t) 435 (setq ignore t)
454 (message "Done") 461 (message "Done")
455 records) 462 records)
456 ) 463 )
457 464
458 (defun ph-filter-duplicate-fields (record) 465 (defun ph-filter-duplicate-fields (record)
459 "Filter RECORD according to ph-duplicate-fields-handling-method." 466 "Filter RECORD according to `ph-duplicate-fields-handling-method'."
460 (let ((rec record) 467 (let ((rec record)
461 unique 468 unique
462 duplicates 469 duplicates
463 result) 470 result)
464 471
590 (process-send-string process "\r\n") 597 (process-send-string process "\r\n")
591 ) 598 )
592 599
593 (defun ph-read-response (process &optional return-response) 600 (defun ph-read-response (process &optional return-response)
594 "Read a response from the PH/QI query process PROCESS. 601 "Read a response from the PH/QI query process PROCESS.
595 Returns nil if response starts with an error code. If the 602 Returns nil if response starts with an error code. If the
596 response is successful the return code or the reponse itself is returned 603 response is successful the return code or the reponse itself is returned
597 depending on RETURN-RESPONSE" 604 depending on RETURN-RESPONSE."
598 (let ((case-fold-search nil) 605 (let ((case-fold-search nil)
599 return-code 606 return-code
600 match-end) 607 match-end)
601 (goto-char ph-read-point) 608 (goto-char ph-read-point)
602 ;; CCSO protocol : response complete if status >= 200 609 ;; CCSO protocol : response complete if status >= 200
615 return-code)))) 622 return-code))))
616 623
617 (defun ph-create-bbdb-record (record) 624 (defun ph-create-bbdb-record (record)
618 "Create a BBDB record using the RECORD alist. 625 "Create a BBDB record using the RECORD alist.
619 RECORD is an alist of (KEY . VALUE) where KEY is a symbol naming a field 626 RECORD is an alist of (KEY . VALUE) where KEY is a symbol naming a field
620 of the PH/QI database and VALUE is the corresponding value for the record" 627 of the PH/QI database and VALUE is the corresponding value for the record."
621 ;; This function runs in a special context where lisp symbols corresponding 628 ;; This function runs in a special context where lisp symbols corresponding
622 ;; to field names in record are bound to the corresponding values 629 ;; to field names in record are bound to the corresponding values
623 (eval 630 (eval
624 `(let* (,@(mapcar '(lambda (c) 631 `(let* (,@(mapcar '(lambda (c)
625 (list (car c) (if (listp (cdr c)) 632 (list (car c) (if (listp (cdr c))
670 677
671 (bbdb-display-records (list bbdb-record)) 678 (bbdb-display-records (list bbdb-record))
672 ))) 679 )))
673 680
674 (defun ph-parse-spec (spec record recurse) 681 (defun ph-parse-spec (spec record recurse)
675 "Parse the conversion SPEC using RECORD. 682 "Parse the conversion SPEC using RECORD.
676 If RECURSE is non-nil then SPEC may be a list of atomic specs" 683 If RECURSE is non-nil then SPEC may be a list of atomic specs."
677 (cond 684 (cond
678 ((or (stringp spec) 685 ((or (stringp spec)
679 (symbolp spec) 686 (symbolp spec)
680 (and (listp spec) 687 (and (listp spec)
681 (symbolp (car spec)) 688 (symbolp (car spec))
687 (listp spec)) 694 (listp spec))
688 (mapcar '(lambda (spec-elem) 695 (mapcar '(lambda (spec-elem)
689 (ph-parse-spec spec-elem record nil)) 696 (ph-parse-spec spec-elem record nil))
690 spec)) 697 spec))
691 (t 698 (t
692 (error "Invalid mapping specification for `%s'. Fix ph-bbdb-conversion-alist" spec)))) 699 (error "Invalid specification for `%s' in `ph-bbdb-conversion-alist'" spec))))
693 700
694 (defun ph-bbdbify-address (addr location) 701 (defun ph-bbdbify-address (addr location)
695 "Parse ADDR into a vector compatible with bbdb-create-internal. 702 "Parse ADDR into a vector compatible with BBDB.
696 ADDR should be an address string of no more than four lines or a 703 ADDR should be an address string of no more than four lines or a
697 list of lines. 704 list of lines.
698 The last line is searched for the zip code, city and state name. 705 The last line is searched for the zip code, city and state name.
699 LOCATION is used as the address location for bbdb." 706 LOCATION is used as the address location for bbdb."
700 (let* ((addr-components (if (listp addr) 707 (let* ((addr-components (if (listp addr)
701 (reverse addr) 708 (reverse addr)
702 (reverse (split-string addr "\n")))) 709 (reverse (split-string addr "\n"))))
712 ;; European style 719 ;; European style
713 ((string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" lastl) 720 ((string-match "\\([0-9]+\\)[ \t]+\\(.*\\)" lastl)
714 (setq city (match-string 2 lastl) 721 (setq city (match-string 2 lastl)
715 zip (string-to-number (match-string 1 lastl)))) 722 zip (string-to-number (match-string 1 lastl))))
716 (t 723 (t
717 (error "ph-bbdbify-address was unable to parse the address. Customize ph-bbdb-conversion-alist"))) 724 (error "Cannot parse the address; see `ph-bbdb-conversion-alist'")))
718 (vector location 725 (vector location
719 (or (nth 0 addr-components) "") 726 (or (nth 0 addr-components) "")
720 (or (nth 1 addr-components) "") 727 (or (nth 1 addr-components) "")
721 (or (nth 2 addr-components) "") 728 (or (nth 2 addr-components) "")
722 (or city "") 729 (or city "")
723 (or state "") 730 (or state "")
724 zip))) 731 zip)))
725 732
726 (defun ph-bbdbify-phone (phone location) 733 (defun ph-bbdbify-phone (phone location)
727 "Parse PHONE into a vector compatible with bbdb-create-internal. 734 "Parse PHONE into a vector compatible with BBDB.
728 PHONE is either a string supposedly containing a phone number or 735 PHONE is either a string supposedly containing a phone number or
729 a list of such strings which are concatenated. 736 a list of such strings which are concatenated.
730 LOCATION is used as the phone location for bbdb" 737 LOCATION is used as the phone location for bbdb."
731 (cond 738 (cond
732 ((stringp phone) 739 ((stringp phone)
733 (let (phone-list) 740 (let (phone-list)
734 (condition-case err 741 (condition-case err
735 (setq phone-list (bbdb-parse-phone-number phone)) 742 (setq phone-list (bbdb-parse-phone-number phone))
736 (error 743 (error
737 (if (string= "phone number unparsable." (ph-cadr err)) 744 (if (string= "phone number unparsable." (ph-cadr err))
738 (if (not (y-or-n-p (format "BBDB claims %S to be unparsable. Insert it unparsed ? " phone))) 745 (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone)))
739 (error "phone number unparsable") 746 (error "Phone number unparsable")
740 (setq phone-list (list (bbdb-string-trim phone)))) 747 (setq phone-list (list (bbdb-string-trim phone))))
741 (signal (car err) (cdr err))))) 748 (signal (car err) (cdr err)))))
742 (if (= 3 (length phone-list)) 749 (if (= 3 (length phone-list))
743 (setq phone-list (append phone-list '(nil)))) 750 (setq phone-list (append phone-list '(nil))))
744 (apply 'vector location phone-list))) 751 (apply 'vector location phone-list)))
745 ((listp phone) 752 ((listp phone)
746 (vector location (mapconcat 'identity phone ", "))) 753 (vector location (mapconcat 'identity phone ", ")))
747 (t 754 (t
748 (error "Invalid phone specification. Cannot create bbdb record")))) 755 (error "Invalid phone specification"))))
749 756
750 ;;}}} 757 ;;}}}
751 758
752 ;;{{{ High-level interfaces (interactive functions) 759 ;;{{{ High-level interfaces (interactive functions)
753 760
755 "Customize the PH package." 762 "Customize the PH package."
756 (interactive) 763 (interactive)
757 (customize-group 'ph)) 764 (customize-group 'ph))
758 765
759 (defun ph-set-server (server) 766 (defun ph-set-server (server)
760 "Set the server to SERVER." 767 "Set the PH server to SERVER."
761 (interactive "sNew PH/QI Server: ") 768 (interactive "sNew PH/QI Server: ")
762 (message "Selected PH/QI server is now %s" server) 769 (message "Selected PH/QI server is now %s" server)
763 (setq ph-server server)) 770 (setq ph-server server))
764 771
765 ;;;###autoload 772 ;;;###autoload
797 (ph-parse-query-result))) 804 (ph-parse-query-result)))
798 ) 805 )
799 806
800 ;;;###autoload 807 ;;;###autoload
801 (defun ph-expand-inline (&optional replace) 808 (defun ph-expand-inline (&optional replace)
802 "Query the server and expand the query string before point. 809 "Query the PH server, and expand the query string before point.
803 The query string consists of the buffer substring from the point back to 810 The query string consists of the buffer substring from the point back to
804 the preceding comma, colon or beginning of line. If it consists of more than 811 the preceding comma, colon or beginning of line. If it contains more than
805 one word the variable ph-inline-query-format-list controls how these are mapped 812 one word, the variable `ph-inline-query-format-list' controls to map these
806 onto CCSO database field names. 813 onto CCSO database field names.
807 After querying the server for the given string, the expansion specified by 814 After querying the server for the given string, the expansion specified by
808 ph-inline-expansion-format is inserted in the buffer at point. If REPLACE is t 815 `ph-inline-expansion-format' is inserted in the buffer at point.
809 then this expansion replaces the name in the buffer. 816 If REPLACE is t, then this expansion replaces the name in the buffer.
810 If ph-expanding-overwrites-query is t then the meaning of REPLACE is inverted." 817 If `ph-expanding-overwrites-query' is t, that inverts the meaning of REPLACE."
811 (interactive) 818 (interactive)
812 (let* ((end (point)) 819 (let* ((end (point))
813 (beg (save-excursion 820 (beg (save-excursion
814 (if (re-search-backward "[:,][ \t]*" 821 (if (re-search-backward "[:,][ \t]*"
815 (save-excursion 822 (save-excursion
888 ) 895 )
889 ) 896 )
890 897
891 ;;;###autoload 898 ;;;###autoload
892 (defun ph-query-form (&optional get-fields-from-server) 899 (defun ph-query-form (&optional get-fields-from-server)
893 "*Display a form to query the CCSO PH/QI nameserver. 900 "Display a form to query the CCSO PH/QI nameserver.
894 If given a non-nil argument the function first queries the server 901 If given a non-nil argument the function first queries the server
895 for the existing fields and displays a corresponding form." 902 for the existing fields and displays a corresponding form."
896 (interactive "P") 903 (interactive "P")
897 (let ((fields (or (and get-fields-from-server 904 (let ((fields (or (and get-fields-from-server
898 (ph-get-field-list)) 905 (ph-get-field-list))
958 (use-local-map widget-keymap) 965 (use-local-map widget-keymap)
959 (widget-setup)) 966 (widget-setup))
960 ) 967 )
961 968
962 (defun ph-bookmark-server (server) 969 (defun ph-bookmark-server (server)
963 "Add SERVER to the `servers' hotlist." 970 "Add SERVER to the PH `servers' hotlist."
964 (interactive "sServer: ") 971 (interactive "sPH server: ")
965 (if (member server ph-server-hotlist) 972 (if (member server ph-server-hotlist)
966 (error "%s is already in the hotlist" server) 973 (error "%s is already in the hotlist" server)
967 (setq ph-server-hotlist (cons server ph-server-hotlist)) 974 (setq ph-server-hotlist (cons server ph-server-hotlist))
968 (ph-install-menu) 975 (ph-install-menu)
969 (ph-save-options))) 976 (ph-save-options)))
970 977
971 (defun ph-bookmark-current-server () 978 (defun ph-bookmark-current-server ()
972 "Add current server to the `servers' hotlist." 979 "Add current server to the PH `servers' hotlist."
973 (interactive) 980 (interactive)
974 (ph-bookmark-server ph-server)) 981 (ph-bookmark-server ph-server))
975 982
976 (defun ph-save-options () 983 (defun ph-save-options ()
977 "Save options (essentially the hotlist) to ph-options-file" 984 "Save options (essentially the hotlist) to `ph-options-file'."
978 (interactive) 985 (interactive)
979 (save-excursion 986 (save-excursion
980 (set-buffer (find-file-noselect ph-options-file t)) 987 (set-buffer (find-file-noselect ph-options-file t))
981 ;; delete the previous setq 988 ;; delete the previous setq
982 (let ((standard-output (current-buffer)) 989 (let ((standard-output (current-buffer))
1024 (if (null record) 1031 (if (null record)
1025 (error "Point is not over a record") 1032 (error "Point is not over a record")
1026 (ph-create-bbdb-record record)))) 1033 (ph-create-bbdb-record record))))
1027 1034
1028 (defun ph-try-bbdb-insert () 1035 (defun ph-try-bbdb-insert ()
1029 "Call ph-insert-record-at-point-into-bbdb if on a record" 1036 "Call `ph-insert-record-at-point-into-bbdb' if on a record."
1030 (interactive) 1037 (interactive)
1031 (and (or (featurep 'bbdb) 1038 (and (or (featurep 'bbdb)
1032 (prog1 (locate-library "bbdb") (message ""))) 1039 (prog1 (locate-library "bbdb") (message "")))
1033 (overlays-at (point)) 1040 (overlays-at (point))
1034 (overlay-get (car (overlays-at (point))) 'ph-record) 1041 (overlay-get (car (overlays-at (point))) 'ph-record)
1035 (ph-insert-record-at-point-into-bbdb))) 1042 (ph-insert-record-at-point-into-bbdb)))
1036 1043
1037 (defun ph-move-to-next-record () 1044 (defun ph-move-to-next-record ()
1038 "Move to next record in a buffer displaying ph query results" 1045 "Move to next record, in a buffer displaying PH query results."
1039 (interactive) 1046 (interactive)
1040 (if (not (eq major-mode 'ph-mode)) 1047 (if (not (eq major-mode 'ph-mode))
1041 (error "Not in a PH buffer") 1048 (error "Not in a PH buffer")
1042 (let ((pt (next-overlay-change (point)))) 1049 (let ((pt (next-overlay-change (point))))
1043 (if (< pt (point-max)) 1050 (if (< pt (point-max))
1044 (goto-char (1+ pt)) 1051 (goto-char (1+ pt))
1045 (error "No more records after point"))))) 1052 (error "No more records after point")))))
1046 1053
1047 (defun ph-move-to-previous-record () 1054 (defun ph-move-to-previous-record ()
1048 "Move to next record in a buffer displaying ph query results" 1055 "Move to previous record, in a buffer displaying PH query results."
1049 (interactive) 1056 (interactive)
1050 (if (not (eq major-mode 'ph-mode)) 1057 (if (not (eq major-mode 'ph-mode))
1051 (error "Not in a PH buffer") 1058 (error "Not in a PH buffer")
1052 (let ((pt (previous-overlay-change (point)))) 1059 (let ((pt (previous-overlay-change (point))))
1053 (if (> pt (point-min)) 1060 (if (> pt (point-min))
1074 1081
1075 (defconst ph-tail-menu 1082 (defconst ph-tail-menu
1076 `(["---" nil nil] 1083 `(["---" nil nil]
1077 ["Query Form" ph-query-form t] 1084 ["Query Form" ph-query-form t]
1078 ["Expand Inline" ph-expand-inline t] 1085 ["Expand Inline" ph-expand-inline t]
1079 ["Insert Record into BBDB" ph-insert-record-at-point-into-bbdb
1080 (and (or (featurep 'bbdb)
1081 (prog1 (locate-library "bbdb") (message "")))
1082 (overlays-at (point))
1083 (overlay-get (car (overlays-at (point))) 'ph-record))]
1084 ["---" nil nil] 1086 ["---" nil nil]
1085 ["Get Email" ph-get-email t] 1087 ["Get Email" ph-get-email t]
1086 ["Get Phone" ph-get-phone t] 1088 ["Get Phone" ph-get-phone t]
1087 ["List Valid Field Names" ph-get-field-list t] 1089 ["List Valid Field Names" ph-get-field-list t]
1088 ["---" nil nil] 1090 ["---" nil nil]