Mercurial > emacs
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] |