diff options
| author | Richard M. Stallman | 2004-11-01 07:47:18 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2004-11-01 07:47:18 +0000 |
| commit | e2c76fd857e1174126d92b134fd76def53c65b40 (patch) | |
| tree | 72bfb4e1d62b2eb21e26df708e51fd17f9058ab6 /lisp | |
| parent | 9d0d10708496729d062ae04fe2f191c16dc831b3 (diff) | |
| download | emacs-e2c76fd857e1174126d92b134fd76def53c65b40.tar.gz emacs-e2c76fd857e1174126d92b134fd76def53c65b40.zip | |
(eudc-display-records): Use with-output-to-temp-buffer;
don't select the temporary buffer.
(eudc-get-email): New optional arg ERROR; don't use interactive-p.
(eudc-get-phone): Likewise.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/net/eudc.el | 142 |
1 files changed, 72 insertions, 70 deletions
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 6d12d5e6364..bcdd1d195bf 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el | |||
| @@ -462,73 +462,73 @@ attribute name ATTR." | |||
| 462 | "Display the record list RECORDS in a formatted buffer. | 462 | "Display the record list RECORDS in a formatted buffer. |
| 463 | If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed | 463 | If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed |
| 464 | otherwise they are formatted according to `eudc-user-attribute-names-alist'." | 464 | otherwise they are formatted according to `eudc-user-attribute-names-alist'." |
| 465 | (let ((buffer (get-buffer-create "*Directory Query Results*")) | 465 | (let (inhibit-read-only |
| 466 | inhibit-read-only | ||
| 467 | precords | 466 | precords |
| 468 | (width 0) | 467 | (width 0) |
| 469 | beg | 468 | beg |
| 470 | first-record | 469 | first-record |
| 471 | attribute-name) | 470 | attribute-name) |
| 472 | (switch-to-buffer buffer) | 471 | (with-output-to-temp-buffer "*Directory Query Results*" |
| 473 | (setq buffer-read-only t) | 472 | (with-current-buffer standard-output |
| 474 | (setq inhibit-read-only t) | 473 | (setq buffer-read-only t) |
| 475 | (erase-buffer) | 474 | (setq inhibit-read-only t) |
| 476 | (insert "Directory Query Result\n") | 475 | (erase-buffer) |
| 477 | (insert "======================\n\n\n") | 476 | (insert "Directory Query Result\n") |
| 478 | (if (null records) | 477 | (insert "======================\n\n\n") |
| 479 | (insert "No match found.\n" | 478 | (if (null records) |
| 480 | (if eudc-strict-return-matches | 479 | (insert "No match found.\n" |
| 481 | "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" | 480 | (if eudc-strict-return-matches |
| 482 | "")) | 481 | "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" |
| 483 | ;; Replace field names with user names, compute max width | 482 | "")) |
| 484 | (setq precords | 483 | ;; Replace field names with user names, compute max width |
| 485 | (mapcar | 484 | (setq precords |
| 486 | (function | ||
| 487 | (lambda (record) | ||
| 488 | (mapcar | 485 | (mapcar |
| 489 | (function | 486 | (function |
| 490 | (lambda (field) | 487 | (lambda (record) |
| 491 | (setq attribute-name | 488 | (mapcar |
| 492 | (if raw-attr-names | 489 | (function |
| 493 | (symbol-name (car field)) | 490 | (lambda (field) |
| 494 | (eudc-format-attribute-name-for-display (car field)))) | 491 | (setq attribute-name |
| 495 | (if (> (length attribute-name) width) | 492 | (if raw-attr-names |
| 496 | (setq width (length attribute-name))) | 493 | (symbol-name (car field)) |
| 497 | (cons attribute-name (cdr field)))) | 494 | (eudc-format-attribute-name-for-display (car field)))) |
| 498 | record))) | 495 | (if (> (length attribute-name) width) |
| 499 | records)) | 496 | (setq width (length attribute-name))) |
| 500 | ;; Display the records | 497 | (cons attribute-name (cdr field)))) |
| 501 | (setq first-record (point)) | 498 | record))) |
| 502 | (mapcar | 499 | records)) |
| 503 | (function | 500 | ;; Display the records |
| 504 | (lambda (record) | 501 | (setq first-record (point)) |
| 505 | (setq beg (point)) | 502 | (mapcar |
| 506 | ;; Map over the record fields to print the attribute/value pairs | 503 | (function |
| 507 | (mapcar (function | 504 | (lambda (record) |
| 508 | (lambda (field) | 505 | (setq beg (point)) |
| 509 | (eudc-print-record-field field width))) | 506 | ;; Map over the record fields to print the attribute/value pairs |
| 510 | record) | 507 | (mapcar (function |
| 511 | ;; Store the record internal format in some convenient place | 508 | (lambda (field) |
| 512 | (overlay-put (make-overlay beg (point)) | 509 | (eudc-print-record-field field width))) |
| 513 | 'eudc-record | 510 | record) |
| 514 | (car records)) | 511 | ;; Store the record internal format in some convenient place |
| 515 | (setq records (cdr records)) | 512 | (overlay-put (make-overlay beg (point)) |
| 516 | (insert "\n"))) | 513 | 'eudc-record |
| 517 | precords)) | 514 | (car records)) |
| 518 | (insert "\n") | 515 | (setq records (cdr records)) |
| 519 | (widget-create 'push-button | 516 | (insert "\n"))) |
| 520 | :notify (lambda (&rest ignore) | 517 | precords)) |
| 521 | (eudc-query-form)) | 518 | (insert "\n") |
| 522 | "New query") | 519 | (widget-create 'push-button |
| 523 | (widget-insert " ") | 520 | :notify (lambda (&rest ignore) |
| 524 | (widget-create 'push-button | 521 | (eudc-query-form)) |
| 525 | :notify (lambda (&rest ignore) | 522 | "New query") |
| 526 | (kill-this-buffer)) | 523 | (widget-insert " ") |
| 527 | "Quit") | 524 | (widget-create 'push-button |
| 528 | (eudc-mode) | 525 | :notify (lambda (&rest ignore) |
| 529 | (widget-setup) | 526 | (kill-this-buffer)) |
| 530 | (if first-record | 527 | "Quit") |
| 531 | (goto-char first-record)))) | 528 | (eudc-mode) |
| 529 | (widget-setup) | ||
| 530 | (if first-record | ||
| 531 | (goto-char first-record)))))) | ||
| 532 | 532 | ||
| 533 | (defun eudc-process-form () | 533 | (defun eudc-process-form () |
| 534 | "Process the query form in current buffer and display the results." | 534 | "Process the query form in current buffer and display the results." |
| @@ -709,34 +709,36 @@ server for future sessions." | |||
| 709 | (eudc-save-options))) | 709 | (eudc-save-options))) |
| 710 | 710 | ||
| 711 | ;;;###autoload | 711 | ;;;###autoload |
| 712 | (defun eudc-get-email (name) | 712 | (defun eudc-get-email (name &optional error) |
| 713 | "Get the email field of NAME from the directory server." | 713 | "Get the email field of NAME from the directory server. |
| 714 | (interactive "sName: ") | 714 | If ERROR is non-nil, report an error if there is none." |
| 715 | (interactive "sName: \np") | ||
| 715 | (or eudc-server | 716 | (or eudc-server |
| 716 | (call-interactively 'eudc-set-server)) | 717 | (call-interactively 'eudc-set-server)) |
| 717 | (let ((result (eudc-query (list (cons 'name name)) '(email))) | 718 | (let ((result (eudc-query (list (cons 'name name)) '(email))) |
| 718 | email) | 719 | email) |
| 719 | (if (null (cdr result)) | 720 | (if (null (cdr result)) |
| 720 | (setq email (eudc-cdaar result)) | 721 | (setq email (eudc-cdaar result)) |
| 721 | (error "Multiple match. Use the query form")) | 722 | (error "Multiple match--use the query form")) |
| 722 | (if (interactive-p) | 723 | (if error |
| 723 | (if email | 724 | (if email |
| 724 | (message "%s" email) | 725 | (message "%s" email) |
| 725 | (error "No record matching %s" name))) | 726 | (error "No record matching %s" name))) |
| 726 | email)) | 727 | email)) |
| 727 | 728 | ||
| 728 | ;;;###autoload | 729 | ;;;###autoload |
| 729 | (defun eudc-get-phone (name) | 730 | (defun eudc-get-phone (name &optional error) |
| 730 | "Get the phone field of NAME from the directory server." | 731 | "Get the phone field of NAME from the directory server. |
| 731 | (interactive "sName: ") | 732 | If ERROR is non-nil, report an error if there is none." |
| 733 | (interactive "sName: \np") | ||
| 732 | (or eudc-server | 734 | (or eudc-server |
| 733 | (call-interactively 'eudc-set-server)) | 735 | (call-interactively 'eudc-set-server)) |
| 734 | (let ((result (eudc-query (list (cons 'name name)) '(phone))) | 736 | (let ((result (eudc-query (list (cons 'name name)) '(phone))) |
| 735 | phone) | 737 | phone) |
| 736 | (if (null (cdr result)) | 738 | (if (null (cdr result)) |
| 737 | (setq phone (eudc-cdaar result)) | 739 | (setq phone (eudc-cdaar result)) |
| 738 | (error "Multiple match. Use the query form")) | 740 | (error "Multiple match--use the query form")) |
| 739 | (if (interactive-p) | 741 | (if error |
| 740 | (if phone | 742 | (if phone |
| 741 | (message "%s" phone) | 743 | (message "%s" phone) |
| 742 | (error "No record matching %s" name))) | 744 | (error "No record matching %s" name))) |