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