;;; Code:
(defgroup minibuffer nil
- "Controling the behaviour of the minibuffer."
+ "Controling the behavior of the minibuffer."
:group 'environment)
CODE, which says what kind of things to do.
CODE can be nil, t or `lambda'.
nil means to return the best completion of STRING, nil if there is none,
- or t if it is was already a unique completion.
+ or t if it is already a unique completion.
t means to return a list of all possible completions of STRING.
`lambda' means to return t if STRING is a valid completion as it stands.")
(delete-region (point-min) (point)))
(insert ?~))
+
(defvar read-file-name-map
(let ((map (make-sparse-keymap 'read-file-name-map)))
(set-keymap-parents map (list minibuffer-local-completion-map))
to be inserted into the minibuffer before reading input.
If INITIAL-CONTENTS is (STRING . POSITION), the initial input
is STRING, but point is placed POSITION characters into the string.
-Third arg KEYMAP is a keymap to use whilst reading;
+Third arg KEYMAP is a keymap to use while reading;
if omitted or nil, the default is `minibuffer-local-map'.
If fourth arg READ is non-nil, then interpret the result as a lisp object
and return that object:
(insert initial-contents)
(setq current-minibuffer-contents initial-contents
current-minibuffer-point (point))))
- (use-local-map (or keymap minibuffer-local-map))
+ (use-local-map (help-keymap-with-help-key
+ (or keymap minibuffer-local-map)
+ minibuffer-help-form))
(let ((mouse-grabbed-buffer
(and minibuffer-smart-completion-tracking-behavior
(current-buffer)))
(current-prefix-arg current-prefix-arg)
- (help-form minibuffer-help-form)
+;; (help-form minibuffer-help-form)
(minibuffer-history-variable (cond ((not _history_)
'minibuffer-history)
((consp _history_)
(read-from-minibuffer
prompt (if num (prin1-to-string num)) nil t
t)) ;no history
+ (input-error nil)
(invalid-read-syntax nil)
(end-of-file nil)))
(or (funcall pred num) (beep)))
(olen (length string))
new
n o ch)
- (cond ((eq system-type 'vax-vms)
- string)
- ((not (string-match regexp string))
- string)
- (t
- (setq n 1)
- (while (string-match regexp string (match-end 0))
- (setq n (1+ n)))
- (setq new (make-string (+ olen n) ?$))
- (setq n 0 o 0)
- (while (< o olen)
- (setq ch (aref string o))
- (aset new n ch)
- (setq o (1+ o) n (1+ n))
- (if (eq ch ?$)
- ;; already aset by make-string initial-value
- (setq n (1+ n))))
- new))))
+ (if (not (string-match regexp string))
+ string
+ (setq n 1)
+ (while (string-match regexp string (match-end 0))
+ (setq n (1+ n)))
+ (setq new (make-string (+ olen n) ?$))
+ (setq n 0 o 0)
+ (while (< o olen)
+ (setq ch (aref string o))
+ (aset new n ch)
+ (setq o (1+ o) n (1+ n))
+ (if (eq ch ?$)
+ ;; already aset by make-string initial-value
+ (setq n (1+ n))))
+ new)))
(defun read-file-name-2 (history prompt dir default
must-match initial-contents
(length dir)))
(t
(un-substitute-in-file-name dir))))
- (val (let ((completion-ignore-case (or completion-ignore-case
- (eq system-type 'vax-vms))))
+ (val
;; Hateful, broken, case-sensitive un*x
;;; (completing-read prompt
;;; completer
;;; must-match
;;; insert
;;; history)
- ;; #### - this is essentially the guts of completing read.
- ;; There should be an elegant way to pass a pair of keymaps to
- ;; completing read, but this will do for now. All sins are
- ;; relative. --Stig
- (let ((minibuffer-completion-table completer)
- (minibuffer-completion-predicate dir)
- (minibuffer-completion-confirm (if (eq must-match 't)
- nil t))
- (last-exact-completion nil))
- (read-from-minibuffer prompt
- insert
- (if (not must-match)
- read-file-name-map
- read-file-name-must-match-map)
- nil
- history)))
+ ;; #### - this is essentially the guts of completing read.
+ ;; There should be an elegant way to pass a pair of keymaps to
+ ;; completing read, but this will do for now. All sins are
+ ;; relative. --Stig
+ (let ((minibuffer-completion-table completer)
+ (minibuffer-completion-predicate dir)
+ (minibuffer-completion-confirm (if (eq must-match 't)
+ nil t))
+ (last-exact-completion nil))
+ (read-from-minibuffer prompt
+ insert
+ (if (not must-match)
+ read-file-name-map
+ read-file-name-must-match-map)
+ nil
+ history))
))
;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar"
;;; (let ((hist (cond ((not history) 'minibuffer-history)
'read-directory-name-internal))
-;; Environment-variable completion hack
+;; Environment-variable and ~username completion hack
(defun read-file-name-internal-1 (string dir action completer)
(if (not (string-match
"\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
;; 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)))
+ ;; ~username completion
+ (if (and (fboundp 'user-name-completion-1)
+ (string-match "^[~]" name))
+ (let ((user (substring name 1)))
+ (cond ((eq action 'lambda)
+ (file-directory-p name))
+ ((eq action 't)
+ ;; all completions
+ (mapcar #'(lambda (p) (concat "~" p))
+ (user-name-all-completions user)))
+ (t;; 'nil
+ ;; complete
+ (let* ((val+uniq (user-name-completion-1 user))
+ (val (car val+uniq))
+ (uniq (cdr val+uniq)))
+ (cond ((stringp val)
+ (if uniq
+ (file-name-as-directory (concat "~" val))
+ (concat "~" val)))
+ ((eq val t)
+ (file-name-as-directory 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
(alist #'(lambda ()
(mapcar #'(lambda (x)
(cons (substring x 0 (string-match "=" x))
- 'nil))
+ nil))
process-environment))))
(cond ((eq action 'lambda)
(concat "$" p)
(concat head "$" p)))
(all-completions env (funcall alist))))
- (t ;; 'nil
+ (t ;; nil
;; complete
(let* ((e (funcall alist))
(val (try-completion env e)))
;; all completions
(mapcar #'un-substitute-in-file-name
(file-name-all-completions name dir)))
- (t;; 'nil
+ (t;; nil
;; complete
(let* ((d (or dir default-directory))
(val (file-name-completion name d)))
nil
'directories))))
(mapcar fn
- (cond ((eq system-type 'vax-vms)
- l)
- (t
- ;; Wretched unix
- (delete "." l))))))))
+ ;; Wretched unix
+ (delete "." l))))))
(cond ((eq action 'lambda)
;; complete?
(if (not orig)
projects / chise / xemacs-chise.git.1 / blobdiff