/[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.5 by pj, Sun Jan 6 16:38:33 2002 UTC revision 1.6 by pj, Wed Jan 16 08:21:29 2002 UTC
# Line 1  Line 1 
1  ;;; eudc.el --- Emacs Unified Directory Client  ;;; eudc.el --- Emacs Unified Directory Client
2    
3  ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
4    
5  ;; Author: Oscar Figueiredo <oscar@xemacs.org>  ;; Author: Oscar Figueiredo <oscar@cpe.fr>
6  ;; Maintainer: Oscar Figueiredo <oscar@xemacs.org>  ;; Maintainer: Pavel Janík <Pavel@Janik.cz>
7  ;; Keywords: comm  ;; Keywords: comm
8    
9  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 74  Line 74 
74    
75  (defvar eudc-form-widget-list nil)  (defvar eudc-form-widget-list nil)
76  (defvar eudc-mode-map nil)  (defvar eudc-mode-map nil)
 ;; Used by the selection insertion mechanism  
 (defvar eudc-pre-select-window-configuration nil)  
 (defvar eudc-insertion-marker nil)  
77    
78  ;; List of known servers  ;; List of known servers
79  ;; Alist of (SERVER . PROTOCOL)  ;; Alist of (SERVER . PROTOCOL)
# Line 375  The translation is done according to Line 372  The translation is done according to
372                  list))                  list))
373      list))      list))
374    
375  (defun eudc-select (choices)  (defun eudc-select (choices beg end)
376    "Choose one from CHOICES using a completion buffer."    "Choose one from CHOICES using a completion.
377    (setq eudc-pre-select-window-configuration (current-window-configuration))  BEG and END delimit the text which is to be replaced."
378    (setq eudc-insertion-marker (point-marker))    (let ((replacement))
379    (with-output-to-temp-buffer "*EUDC Completions*"     (setq replacement
380      (apply 'display-completion-list           (completing-read "Multiple matches found; choose one:"
381             choices                            (mapcar 'list choices)))
382             (if eudc-xemacs-p     (delete-region beg end)
383                 '(:activate-callback eudc-insert-selected)))))     (insert replacement)))
   
 (defun eudc-insert-selected (event extent user)  
   "Insert a completion at the appropriate point."  
   (when eudc-insertion-marker  
     (set-buffer (marker-buffer eudc-insertion-marker))  
     (goto-char eudc-insertion-marker)  
     (insert (extent-string extent)))  
   (if eudc-pre-select-window-configuration  
       (set-window-configuration eudc-pre-select-window-configuration))  
   (setq eudc-pre-select-window-configuration nil  
         eudc-insertion-marker nil))  
384    
385  (defun eudc-query (query &optional return-attributes no-translation)  (defun eudc-query (query &optional return-attributes no-translation)
386     "Query the current directory server with QUERY.     "Query the current directory server with QUERY.
# Line 824  The variable `eudc-inline-query-format' Line 810  The variable `eudc-inline-query-format'
810  individual inline query words with directory attribute names.  individual inline query words with directory attribute names.
811  After querying the server for the given string, the expansion specified by  After querying the server for the given string, the expansion specified by
812  `eudc-inline-expansion-format' is inserted in the buffer at point.  `eudc-inline-expansion-format' is inserted in the buffer at point.
813  If REPLACE is non nil, then this expansion replaces the name in the buffer.  If REPLACE is non-nil, then this expansion replaces the name in the buffer.
814  `eudc-expansion-overwrites-query' being non nil inverts the meaning of REPLACE.  `eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE.
815  Multiple servers can be tried with the same query until one finds a match,  Multiple servers can be tried with the same query until one finds a match,
816  see `eudc-inline-expansion-servers'"  see `eudc-inline-expansion-servers'"
817    (interactive)    (interactive)
# Line 923  see `eudc-inline-expansion-servers'" Line 909  see `eudc-inline-expansion-servers'"
909              (if (or              (if (or
910                   (and replace (not eudc-expansion-overwrites-query))                   (and replace (not eudc-expansion-overwrites-query))
911                   (and (not replace) eudc-expansion-overwrites-query))                   (and (not replace) eudc-expansion-overwrites-query))
912                  (delete-region beg end))                  (kill-ring-save beg end))
913              (cond              (cond
914               ((or (= (length response-strings) 1)               ((or (= (length response-strings) 1)
915                    (null eudc-multiple-match-handling-method)                    (null eudc-multiple-match-handling-method)
916                    (eq eudc-multiple-match-handling-method 'first))                    (eq eudc-multiple-match-handling-method 'first))
917                  (delete-region beg end)
918                (insert (car response-strings)))                (insert (car response-strings)))
919               ((eq eudc-multiple-match-handling-method 'select)               ((eq eudc-multiple-match-handling-method 'select)
920                (eudc-select response-strings))                (eudc-select response-strings beg end))
921               ((eq eudc-multiple-match-handling-method 'all)               ((eq eudc-multiple-match-handling-method 'all)
922                (insert (mapconcat 'identity response-strings ", ")))                (insert (mapconcat 'identity response-strings ", ")))
923               ((eq eudc-multiple-match-handling-method 'abort)               ((eq eudc-multiple-match-handling-method 'abort)
924                (error "There is more than one match for the query"))                (error "There is more than one match for the query"))))
              ))  
925            (or (and (equal eudc-server eudc-former-server)            (or (and (equal eudc-server eudc-former-server)
926                     (equal eudc-protocol eudc-former-protocol))                     (equal eudc-protocol eudc-former-protocol))
927                (eudc-set-server eudc-former-server eudc-former-protocol t)))                (eudc-set-server eudc-former-server eudc-former-protocol t)))
# Line 1115  queries the server for the existing fiel Line 1101  queries the server for the existing fiel
1101            (goto-char pt)            (goto-char pt)
1102          (error "No more records before point")))))          (error "No more records before point")))))
1103    
   
1104  ;;}}}  ;;}}}
1105    
1106  ;;{{{      Menus an keymaps  ;;{{{      Menus an keymaps

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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