X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fminibuf.el;h=4a8ad96a9954906117754771e4ac79a3a9d30f14;hb=19f3d076b847b61fae1f8313d588207cc0d41ab0;hp=b7b90e03818b053d07066602a690e4c0f3aaad12;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git diff --git a/lisp/minibuf.el b/lisp/minibuf.el index b7b90e0..4a8ad96 100644 --- a/lisp/minibuf.el +++ b/lisp/minibuf.el @@ -41,7 +41,7 @@ ;;; Code: (defgroup minibuffer nil - "Controling the behaviour of the minibuffer." + "Controling the behavior of the minibuffer." :group 'environment) @@ -67,7 +67,7 @@ The value may alternatively be a function, which is given three arguments: 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.") @@ -243,6 +243,7 @@ in `substitute-in-file-name'." (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)) @@ -349,7 +350,7 @@ If optional second arg INITIAL-CONTENTS is non-nil, it is a string 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: @@ -447,12 +448,14 @@ See also the variable completion-highlight-first-word-only for control over (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_) @@ -1452,6 +1455,7 @@ only existing buffer names are allowed." (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))) @@ -1473,24 +1477,21 @@ only existing buffer names are allowed." (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 @@ -1507,8 +1508,7 @@ only existing buffer names are allowed." (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 @@ -1516,22 +1516,22 @@ only existing buffer names are allowed." ;;; 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) @@ -1669,7 +1669,7 @@ DIR defaults to current buffer's directory default." '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_]*\\|{[^}]*\\)\\'" @@ -1677,14 +1677,38 @@ DIR defaults to current buffer's directory default." ;; 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 @@ -1700,7 +1724,7 @@ DIR defaults to current buffer's directory default." (alist #'(lambda () (mapcar #'(lambda (x) (cons (substring x 0 (string-match "=" x)) - 'nil)) + nil)) process-environment)))) (cond ((eq action 'lambda) @@ -1715,7 +1739,7 @@ DIR defaults to current buffer's directory default." (concat "$" p) (concat head "$" p))) (all-completions env (funcall alist)))) - (t ;; 'nil + (t ;; nil ;; complete (let* ((e (funcall alist)) (val (try-completion env e))) @@ -1751,7 +1775,7 @@ DIR defaults to current buffer's directory default." ;; 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))) @@ -1792,11 +1816,8 @@ DIR defaults to current buffer's directory default." 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)