Mercurial > hg > xemacs-beta

comparison lisp/minibuf.el @ 373:6240c7796c7a r21-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents cc15677e0335
children 8626e4521993
comparison
equal deleted inserted replaced
372:49e1ed2d7ed8 373:6240c7796c7a
240 (eq directory-sep-char (char-before (point))) 240 (eq directory-sep-char (char-before (point)))
241 ;; permit URL's with //, for e.g. http://hostname/~user 241 ;; permit URL's with //, for e.g. http://hostname/~user
242 (not (save-excursion (search-backward "//" nil t))) 242 (not (save-excursion (search-backward "//" nil t)))
243 (delete-region (point-min) (point))) 243 (delete-region (point-min) (point)))
244 (insert ?~)) 244 (insert ?~))
245
245 246
246 (defvar read-file-name-map 247 (defvar read-file-name-map
247 (let ((map (make-sparse-keymap 'read-file-name-map))) 248 (let ((map (make-sparse-keymap 'read-file-name-map)))
248 (set-keymap-parents map (list minibuffer-local-completion-map)) 249 (set-keymap-parents map (list minibuffer-local-completion-map))
249 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator) 250 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
445 (setq current-minibuffer-contents (car initial-contents) 446 (setq current-minibuffer-contents (car initial-contents)
446 current-minibuffer-point (cdr initial-contents))) 447 current-minibuffer-point (cdr initial-contents)))
447 (insert initial-contents) 448 (insert initial-contents)
448 (setq current-minibuffer-contents initial-contents 449 (setq current-minibuffer-contents initial-contents
449 current-minibuffer-point (point)))) 450 current-minibuffer-point (point))))
450 (use-local-map (or keymap minibuffer-local-map)) 451 (use-local-map (help-keymap-with-help-key
452 (or keymap minibuffer-local-map)
453 minibuffer-help-form))
451 (let ((mouse-grabbed-buffer 454 (let ((mouse-grabbed-buffer
452 (and minibuffer-smart-completion-tracking-behavior 455 (and minibuffer-smart-completion-tracking-behavior
453 (current-buffer))) 456 (current-buffer)))
454 (current-prefix-arg current-prefix-arg) 457 (current-prefix-arg current-prefix-arg)
455 (help-form minibuffer-help-form) 458 ;; (help-form minibuffer-help-form)
456 (minibuffer-history-variable (cond ((not _history_) 459 (minibuffer-history-variable (cond ((not _history_)
457 'minibuffer-history) 460 'minibuffer-history)
458 ((consp _history_) 461 ((consp _history_)
459 (car _history_)) 462 (car _history_))
460 (t 463 (t
1450 (setq num (condition-case () 1453 (setq num (condition-case ()
1451 (let ((minibuffer-completion-table nil)) 1454 (let ((minibuffer-completion-table nil))
1452 (read-from-minibuffer 1455 (read-from-minibuffer
1453 prompt (if num (prin1-to-string num)) nil t 1456 prompt (if num (prin1-to-string num)) nil t
1454 t)) ;no history 1457 t)) ;no history
1458 (input-error nil)
1455 (invalid-read-syntax nil) 1459 (invalid-read-syntax nil)
1456 (end-of-file nil))) 1460 (end-of-file nil)))
1457 (or (funcall pred num) (beep))) 1461 (or (funcall pred num) (beep)))
1458 num)) 1462 num))
1459 1463
1667 (or history 'file-name-history) 1671 (or history 'file-name-history)
1668 prompt dir (or default default-directory) must-match initial-contents 1672 prompt dir (or default default-directory) must-match initial-contents
1669 'read-directory-name-internal)) 1673 'read-directory-name-internal))
1670 1674
1671 1675
1672 ;; Environment-variable completion hack 1676 ;; Environment-variable and ~username completion hack
1673 (defun read-file-name-internal-1 (string dir action completer) 1677 (defun read-file-name-internal-1 (string dir action completer)
1674 (if (not (string-match 1678 (if (not (string-match
1675 "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'" 1679 "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
1676 string)) 1680 string))
1677 ;; Not doing environment-variable completion hack 1681 ;; Not doing environment-variable completion hack
1678 (let* ((orig (if (equal string "") nil string)) 1682 (let* ((orig (if (equal string "") nil string))
1679 (sstring (if orig (substitute-in-file-name string) string)) 1683 (sstring (if orig (substitute-in-file-name string) string))
1680 (specdir (if orig (file-name-directory sstring) nil))) 1684 (specdir (if orig (file-name-directory sstring) nil))
1681 (funcall completer 1685 (name (if orig (file-name-nondirectory sstring) string))
1682 action 1686 (direct (if specdir (expand-file-name specdir dir) dir)))
1683 orig 1687 ;; ~username completion
1684 sstring 1688 (if (and (fboundp 'user-name-completion-1)
1685 specdir 1689 (string-match "^[~]" name))
1686 (if specdir (expand-file-name specdir dir) dir) 1690 (let ((user (substring name 1)))
1687 (if orig (file-name-nondirectory sstring) string))) 1691 (cond ((eq action 'lambda)
1692 (file-directory-p name))
1693 ((eq action 't)
1694 ;; all completions
1695 (mapcar #'(lambda (p) (concat "~" p))
1696 (user-name-all-completions user)))
1697 (t;; 'nil
1698 ;; complete
1699 (let* ((val+uniq (user-name-completion-1 user))
1700 (val (car val+uniq))
1701 (uniq (cdr val+uniq)))
1702 (cond ((stringp val)
1703 (if uniq
1704 (file-name-as-directory (concat "~" val))
1705 (concat "~" val)))
1706 ((eq val t)
1707 (file-name-as-directory name))
1708 (t nil))))))
1709 (funcall completer
1710 action
1711 orig
1712 sstring
1713 specdir
1714 direct
1715 name)))
1688 ;; An odd number of trailing $'s 1716 ;; An odd number of trailing $'s
1689 (let* ((start (match-beginning 3)) 1717 (let* ((start (match-beginning 3))
1690 (env (substring string 1718 (env (substring string
1691 (cond ((= start (length string)) 1719 (cond ((= start (length string))
1692 ;; "...$" 1720 ;; "...$"