Mercurial > hg > xemacs-beta

comparison lisp/minibuf.el @ 408:501cfd01ee6d r21-2-34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-34
author cvs
date Mon, 13 Aug 2007 11:18:11 +0200
parents 2f8bb876ab1d
children 697ef44129c6
comparison
equal deleted inserted replaced
407:ed6218a7d4d3 408:501cfd01ee6d
1542 (if (eq ch ?$) 1542 (if (eq ch ?$)
1543 ;; already aset by make-string initial-value 1543 ;; already aset by make-string initial-value
1544 (setq n (1+ n)))) 1544 (setq n (1+ n))))
1545 new))) 1545 new)))
1546 1546
1547
1548 ;; Wrapper for `directory-files' for use in generating completion lists.
1549 ;; Generates output in the same format as `file-name-all-completions'.
1550 ;;
1551 ;; The EFS replacement for `directory-files' doesn't support the FILES-ONLY
1552 ;; option, so it has to be faked. The listing cache will hopefully
1553 ;; improve the performance of this operation.
1554 (defun minibuf-directory-files (dir &optional match-regexp files-only)
1555 (let ((want-file (or (eq files-only nil) (eq files-only t)))
1556 (want-dirs (or (eq files-only nil) (not (eq files-only t)))))
1557 (delete nil
1558 (mapcar (function (lambda (f)
1559 (if (file-directory-p (expand-file-name f dir))
1560 (and want-dirs (file-name-as-directory f))
1561 (and want-file f))))
1562 (delete "." (directory-files dir nil match-regexp))))))
1563
1564
1547 (defun read-file-name-2 (history prompt dir default 1565 (defun read-file-name-2 (history prompt dir default
1548 must-match initial-contents 1566 must-match initial-contents
1549 completer) 1567 completer)
1550 (if (not dir) 1568 (if (not dir)
1551 (setq dir default-directory)) 1569 (setq dir default-directory))
1630 (insert-string (file-name-as-directory 1648 (insert-string (file-name-as-directory
1631 (abbreviate-file-name full t)) minibuf) 1649 (abbreviate-file-name full t)) minibuf)
1632 (reset-buffer completion-buf) 1650 (reset-buffer completion-buf)
1633 (let ((standard-output completion-buf)) 1651 (let ((standard-output completion-buf))
1634 (display-completion-list 1652 (display-completion-list
1635 (delete "." (directory-files full nil nil nil (if dir-p 'directory))) 1653 (minibuf-directory-files full nil (if dir-p 'directory))
1636 :user-data dir-p 1654 :user-data dir-p
1637 :reference-buffer minibuf 1655 :reference-buffer minibuf
1638 :activate-callback 'read-file-name-activate-callback) 1656 :activate-callback 'read-file-name-activate-callback)
1639 (goto-char (point-min) completion-buf))))) 1657 (goto-char (point-min) completion-buf)))))
1640 1658
1823 nil 1841 nil
1824 (file-exists-p sstring))))) 1842 (file-exists-p sstring)))))
1825 ((eq action 't) 1843 ((eq action 't)
1826 ;; all completions 1844 ;; all completions
1827 (mapcar #'un-substitute-in-file-name 1845 (mapcar #'un-substitute-in-file-name
1828 (file-name-all-completions name dir))) 1846 (if (string= name "")
1847 (delete "./" (file-name-all-completions "" dir))
1848 (file-name-all-completions name dir))))
1829 (t;; nil 1849 (t;; nil
1830 ;; complete 1850 ;; complete
1831 (let* ((d (or dir default-directory)) 1851 (let* ((d (or dir default-directory))
1832 (val (file-name-completion name d))) 1852 (val (file-name-completion name d)))
1833 (if (and (eq val 't) 1853 (if (and (eq val 't)
1852 (read-file-name-internal-1 1872 (read-file-name-internal-1
1853 string dir action 1873 string dir action
1854 #'(lambda (action orig string specdir dir name) 1874 #'(lambda (action orig string specdir dir name)
1855 (let* ((dirs #'(lambda (fn) 1875 (let* ((dirs #'(lambda (fn)
1856 (let ((l (if (equal name "") 1876 (let ((l (if (equal name "")
1857 (directory-files 1877 (minibuf-directory-files
1858 dir 1878 dir
1859 nil
1860 "" 1879 ""
1861 nil
1862 'directories) 1880 'directories)
1863 (directory-files 1881 (minibuf-directory-files
1864 dir 1882 dir
1865 nil
1866 (concat "\\`" (regexp-quote name)) 1883 (concat "\\`" (regexp-quote name))
1867 nil
1868 'directories)))) 1884 'directories))))
1869 (mapcar fn 1885 (mapcar fn
1870 ;; Wretched unix 1886 ;; Wretched unix
1871 (delete "." l)))))) 1887 (delete "." l))))))
1872 (cond ((eq action 'lambda) 1888 (cond ((eq action 'lambda)
1945 1961
1946 (defun mouse-file-display-completion-list (window dir minibuf user-data) 1962 (defun mouse-file-display-completion-list (window dir minibuf user-data)
1947 (let ((standard-output (window-buffer window))) 1963 (let ((standard-output (window-buffer window)))
1948 (condition-case nil 1964 (condition-case nil
1949 (display-completion-list 1965 (display-completion-list
1950 (directory-files dir nil nil nil t) 1966 (minibuf-directory-files dir nil t)
1951 :window-width (window-width window) 1967 :window-width (window-width window)
1952 :window-height (window-text-area-height window) 1968 :window-height (window-text-area-height window)
1953 :completion-string "" 1969 :completion-string ""
1954 :activate-callback 1970 :activate-callback
1955 'mouse-read-file-name-activate-callback 1971 'mouse-read-file-name-activate-callback
1961 1977
1962 (defun mouse-directory-display-completion-list (window dir minibuf user-data) 1978 (defun mouse-directory-display-completion-list (window dir minibuf user-data)
1963 (let ((standard-output (window-buffer window))) 1979 (let ((standard-output (window-buffer window)))
1964 (condition-case nil 1980 (condition-case nil
1965 (display-completion-list 1981 (display-completion-list
1966 (delete "." (directory-files dir nil nil nil 1)) 1982 (minibuf-directory-files dir nil 1)
1967 :window-width (window-width window) 1983 :window-width (window-width window)
1968 :window-height (window-text-area-height window) 1984 :window-height (window-text-area-height window)
1969 :completion-string "" 1985 :completion-string ""
1970 :activate-callback 1986 :activate-callback
1971 'mouse-read-file-name-activate-callback 1987 'mouse-read-file-name-activate-callback