1:05 a.m.
OK, I've got user name completion working and it was pretty simple.
Open issues are:
- dired.c is probably not the best home for these functions.
is minibuf.c better, or somewhere else?
- #include <pwd.h> needs to be conditionalized on a preprocessor
macro defined by configure. read-file-name-internal-1 use
fboundp to see if we have the user name completion functions.
- can someone suggest a better way than my ugly hack to return
whether the completion was unique from user-name-completion?
- fix other elisp, ie comint to do user name completion.
what else am I forgetting?
- cache user name lookup for speed.
I welcome any comments, esp from Ben or Kyle on whether this is the
right way to do this. As I said earlier, I really don't think
file-name-completion is the right place for this stuff.
enjoy,
greg
1998-07-20 Greg Klanderman <greg(a)alphatech.com>
* dired.c (Fuser_name_completion): new function.
(Fuser_name_all_completions): new function.
(user_name_completion): new function.
(syms_of_dired): 2 new DEFSUBRs.
1998-07-20 Greg Klanderman <greg(a)alphatech.com>
* minibuf.el (read-file-name-internal-1): do ~user completion.
Index: src/dired.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/dired.c,v
retrieving revision 1.18
diff -u -r1.18 dired.c
--- dired.c 1998/05/01 01:10:55 1.18
+++ dired.c 1998/07/21 07:39:10
＠＠ -31,6 +31,9 ＠＠
#include "sysfile.h"
#include "sysdir.h"
+#include <pwd.h>
+
+
Lisp_Object Vcompletion_ignored_extensions;
Lisp_Object Qdirectory_files;
Lisp_Object Qfile_name_completion;
＠＠ -528,6 +531,159 ＠＠
}
+static Lisp_Object user_name_completion (Lisp_Object user,
+ int all_flag,
+ Lisp_Object uniq);
+
+DEFUN ("user-name-completion", Fuser_name_completion, 1, 2, 0, /*
+Complete user name USER.
+Returns the longest string common to all user names that start
+with USER. If there is only one and USER matches it exactly,
+returns t. Returns nil if there is no user name starting with USER.
+
+If second optional argument UNIQ is a cons cell, set its car to
+t if the match is unique, and nil otherwise.
+*/
+ (user, uniq))
+{
+ return user_name_completion (user, 0, uniq);
+}
+
+DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
+Return a list of all completions of user name USER.
+These are all user names which begin with USER.
+*/
+ (user))
+{
+ return user_name_completion (user, 1, Qnil);
+}
+
+static Lisp_Object
+user_name_completion_unwind (Lisp_Object notused)
+{
+ endpwent();
+ return Qnil;
+}
+
+static Lisp_Object
+user_name_completion (Lisp_Object user, int all_flag, Lisp_Object uniq)
+{
+ /* #### i'm not particularly proud of this UNIQ hack. */
+ /* #### it would probably make sense to cache the usernames
+ * then maybe once a day rebuild it just in case */
+ struct passwd *pw;
+ int matchcount = 0;
+ Lisp_Object bestmatch = Qnil;
+ Charcount bestmatchsize = 0;
+ int speccount = specpdl_depth ();
+ Charcount user_name_length;
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (user, bestmatch);
+
+ CHECK_STRING (user);
+
+ user_name_length = XSTRING_CHAR_LENGTH (user);
+
+ setpwent();
+ record_unwind_protect (user_name_completion_unwind, Qnil);
+
+ while ((pw = getpwent()))
+ {
+ Bytecount len;
+ /* scmp() works in chars, not bytes, so we have to compute this: */
+ Charcount cclen;
+ Bufbyte *d_name;
+
+ /* #### This is a bad idea, because d_name can contain
+ control characters, which can make XEmacs crash. This
+ should be handled properly with FORMAT_FILENAME. */
+ d_name = (Bufbyte *) pw->pw_name;
+ len = strlen (d_name);
+ cclen = bytecount_to_charcount (d_name, len);
+
+ QUIT;
+
+ if (cclen < user_name_length ||
+ 0 <= scmp (d_name, XSTRING_DATA (user), user_name_length))
+ continue;
+
+ /* Update computation of how much all possible completions match */
+ matchcount++;
+
+ if (all_flag || NILP (bestmatch))
+ {
+ Lisp_Object name = Qnil;
+ struct gcpro ngcpro1;
+ NGCPRO1 (name);
+ /* This is a possible completion */
+ name = make_string (d_name, len);
+ if (all_flag)
+ {
+ bestmatch = Fcons (name, bestmatch);
+ }
+ else
+ {
+ bestmatch = name;
+ bestmatchsize = XSTRING_CHAR_LENGTH (name);
+ }
+ NUNGCPRO;
+ }
+ else
+ {
+ Charcount compare = min (bestmatchsize, cclen);
+ Bufbyte *p1 = XSTRING_DATA (bestmatch);
+ Bufbyte *p2 = d_name;
+ Charcount matchsize = scmp (p1, p2, compare);
+
+ if (matchsize < 0)
+ matchsize = compare;
+ if (completion_ignore_case)
+ {
+ /* If this is an exact match except for case,
+ use it as the best match rather than one that is not
+ an exact match. This way, we get the case pattern
+ of the actual match. */
+ if ((matchsize == cclen
+ && matchsize < XSTRING_CHAR_LENGTH (bestmatch))
+ ||
+ /* If there is no exact match ignoring case,
+ prefer a match that does not change the case
+ of the input. */
+ (((matchsize == cclen)
+ ==
+ (matchsize == XSTRING_CHAR_LENGTH (bestmatch)))
+ /* If there is more than one exact match aside from
+ case, and one of them is exact including case,
+ prefer that one. */
+ && 0 > scmp_1 (p2, XSTRING_DATA (user),
+ user_name_length, 0)
+ && 0 <= scmp_1 (p1, XSTRING_DATA (user),
+ user_name_length, 0)))
+ {
+ bestmatch = make_string (d_name, len);
+ }
+ }
+
+ bestmatchsize = matchsize;
+ }
+ }
+
+ unbind_to (speccount, Qnil); /* does endpwent() */
+
+ UNGCPRO;
+
+ if (CONSP (uniq))
+ Fsetcar (uniq, matchcount == 1 ? Qt : Qnil);
+
+ if (all_flag || NILP (bestmatch))
+ return bestmatch;
+ if (matchcount == 1 && bestmatchsize == user_name_length)
+ return Qt;
+ return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
+}
+
+
Lisp_Object
make_directory_hash_table (CONST char *path)
{
＠＠ -689,6 +845,8 ＠＠
DEFSUBR (Fdirectory_files);
DEFSUBR (Ffile_name_completion);
DEFSUBR (Ffile_name_all_completions);
+ DEFSUBR (Fuser_name_completion);
+ DEFSUBR (Fuser_name_all_completions);
DEFSUBR (Ffile_attributes);
}
Index: lisp/minibuf.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/minibuf.el,v
retrieving revision 1.14
diff -u -r1.14 minibuf.el
--- minibuf.el 1998/06/20 00:58:23 1.14
+++ minibuf.el 1998/07/21 07:39:11
＠＠ -1688,14 +1688,34 ＠＠
;; Not doing environment-variable completion hack
(let* ((orig (if (equal string "") nil string))
(sstring (if orig (substitute-in-file-name string) string))
- (specdir (if orig (file-name-directory sstring) nil)))
- (funcall completer
- action
- orig
- sstring
- specdir
- (if specdir (expand-file-name specdir dir) dir)
- (if orig (file-name-nondirectory sstring) string)))
+ (specdir (if orig (file-name-directory sstring) nil))
+ (name (if orig (file-name-nondirectory sstring) string))
+ (direct (if specdir (expand-file-name specdir dir) dir)))
+ ;; ~user completion
+ (if (string-match "^[~]" name)
+ (let ((user (substring name 1))
+ (uniq (cons nil nil)))
+ (cond ((eq action 'lambda)
+ nil)
+ ((eq action 't)
+ ;; all completions
+ (mapcar #'(lambda (p) (concat "~" p))
+ (user-name-all-completions user)))
+ (t;; 'nil
+ ;; complete
+ (let* ((val (user-name-completion user uniq)))
+ (cond ((stringp val)
+ (concat "~" val (if (car uniq) "/"
"")))
+ ((eq val t)
+ (concat name "/"))
+ (t nil))))))
+ (funcall completer
+ action
+ orig
+ sstring
+ specdir
+ direct
+ name)))
;; An odd number of trailing $'s
(let* ((start (match-beginning 3))
(env (substring string