/[emacs]/emacs/lisp/net/eudc.el
ViewVC logotype

Diff of /emacs/lisp/net/eudc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by miles, Mon Sep 1 15:45:33 2003 UTC revision 1.11 by rms, Mon Nov 1 07:47:18 2004 UTC
# Line 462  attribute name ATTR." Line 462  attribute name ATTR."
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."
# Line 709  server for future sessions." Line 709  server for future sessions."
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)))

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26