X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/26e06f4464c58704889bdc536edc25b73e8c0179..f998bbe793e9ae7a8df071fec7de63879e67ef1a:/lisp/net/eudc.el diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 408381d1c9..275f5f0fcb 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1,7 +1,6 @@ ;;; eudc.el --- Emacs Unified Directory Client -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1998-2012 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo ;; Maintainer: Pavel Janík @@ -352,12 +351,12 @@ accordingly. Otherwise it is set to its EUDC default binding" The translation is done according to `eudc-protocol-attributes-translation-alist'." (if eudc-protocol-attributes-translation-alist - (mapcar '(lambda (attribute) - (let ((trans (assq (car attribute) - (symbol-value eudc-protocol-attributes-translation-alist)))) - (if trans - (cons (cdr trans) (cdr attribute)) - attribute))) + (mapcar (lambda (attribute) + (let ((trans (assq (car attribute) + (symbol-value eudc-protocol-attributes-translation-alist)))) + (if trans + (cons (cdr trans) (cdr attribute)) + attribute))) query) query)) @@ -367,7 +366,7 @@ The translation is done according to `eudc-protocol-attributes-translation-alist'." (if eudc-protocol-attributes-translation-alist (let (trans) - (mapcar '(lambda (attribute) + (mapcar (lambda (attribute) (setq trans (assq attribute (symbol-value eudc-protocol-attributes-translation-alist))) (if trans @@ -693,7 +692,7 @@ server for future sessions." (interactive (list (read-from-minibuffer "Directory Server: ") (intern (completing-read "Protocol: " - (mapcar '(lambda (elt) + (mapcar (lambda (elt) (cons (symbol-name elt) elt)) eudc-known-protocols))))) @@ -706,7 +705,7 @@ server for future sessions." (setq eudc-server server) (eudc-update-local-variables) (run-hooks 'eudc-switch-to-server-hook) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "Current directory server is now %s (%s)" eudc-server eudc-protocol)) (if (null no-save) (eudc-save-options))) @@ -753,9 +752,10 @@ When called interactively the list is formatted in a dedicated buffer otherwise a list of symbols is returned." (interactive) (if eudc-list-attributes-function - (let ((entries (funcall eudc-list-attributes-function (interactive-p)))) + (let ((entries (funcall eudc-list-attributes-function + (called-interactively-p 'interactive)))) (if entries - (if (interactive-p) + (if (called-interactively-p 'interactive) (eudc-display-records entries t) entries))) (error "The %s protocol has no support for listing attributes" eudc-protocol))) @@ -796,7 +796,7 @@ If none try N - 1 and so forth." (> n 0)) (setq formats (delq nil - (mapcar '(lambda (format) + (mapcar (lambda (format) (if (= n (length format)) format @@ -829,10 +829,7 @@ see `eudc-inline-expansion-servers'" (let* ((end (point)) (beg (save-excursion (if (re-search-backward "\\([:,]\\|^\\)[ \t]*" - (save-excursion - (beginning-of-line) - (point)) - 'move) + (point-at-bol) 'move) (goto-char (match-end 0))) (point))) (query-words (split-string (buffer-substring beg end) "[ \t]+")) @@ -931,7 +928,7 @@ see `eudc-inline-expansion-servers'" (or (and (equal eudc-server eudc-former-server) (equal eudc-protocol eudc-former-protocol)) (eudc-set-server eudc-former-server eudc-former-protocol t))) - (t + (error (or (and (equal eudc-server eudc-former-server) (equal eudc-protocol eudc-former-protocol)) (eudc-set-server eudc-former-server eudc-former-protocol t)) @@ -1035,8 +1032,7 @@ queries the server for the existing fields and displays a corresponding form." (defun eudc-save-options () "Save options to `eudc-options-file'." (interactive) - (save-excursion - (set-buffer (find-file-noselect eudc-options-file t)) + (with-current-buffer (find-file-noselect eudc-options-file t) (goto-char (point-min)) ;; delete the previous setq (let ((standard-output (current-buffer)) @@ -1241,25 +1237,25 @@ This does nothing except loading eudc by autoload side-effect." (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Search"))) (define-key map [phone] - '(menu-item "Get Phone" eudc-get-phone - :help "Get the phone field of name from the directory server")) + `(menu-item ,(purecopy "Get Phone") eudc-get-phone + :help ,(purecopy "Get the phone field of name from the directory server"))) (define-key map [email] - '(menu-item "Get Email" eudc-get-email - :help "Get the email field of NAME from the directory server")) - (define-key map [separator-eudc-email] '("--")) + `(menu-item ,(purecopy "Get Email") eudc-get-email + :help ,(purecopy "Get the email field of NAME from the directory server"))) + (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] - '(menu-item "Expand Inline Query" eudc-expand-inline - :help "Query the directory server, and expand the query string before point")) + `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline + :help ,(purecopy "Query the directory server, and expand the query string before point"))) (define-key map [query] - '(menu-item "Query with Form" eudc-query-form - :help "Display a form to query the directory server")) - (define-key map [separator-eudc-query] '("--")) + `(menu-item ,(purecopy "Query with Form") eudc-query-form + :help ,(purecopy "Display a form to query the directory server"))) + (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] - '(menu-item "New Server" eudc-set-server - :help "Set the directory server to SERVER using PROTOCOL")) + `(menu-item ,(purecopy "New Server") eudc-set-server + :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) (define-key map [load] - '(menu-item "Load Hotlist of Servers" eudc-load-eudc - :help "Load the Emacs Unified Directory Client")) + `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc + :help ,(purecopy "Load the Emacs Unified Directory Client"))) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) (t @@ -1295,5 +1291,4 @@ This does nothing except loading eudc by autoload side-effect." (provide 'eudc) -;; arch-tag: e18872b6-db83-400b-869d-be54e9a4160c ;;; eudc.el ends here