Mercurial > hg > xemacs-beta
comparison lisp/minibuf.el @ 380:8626e4521993 r21-2-5
Import from CVS: tag r21-2-5
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:07:10 +0200 |
parents | 6240c7796c7a |
children | aabb7f5b1c81 |
comparison
equal
deleted
inserted
replaced
379:76b7d63099ad | 380:8626e4521993 |
---|---|
39 ;; (following|preceding)-char. -slb | 39 ;; (following|preceding)-char. -slb |
40 | 40 |
41 ;;; Code: | 41 ;;; Code: |
42 | 42 |
43 (defgroup minibuffer nil | 43 (defgroup minibuffer nil |
44 "Controling the behaviour of the minibuffer." | 44 "Controling the behavior of the minibuffer." |
45 :group 'environment) | 45 :group 'environment) |
46 | 46 |
47 | 47 |
48 (defcustom insert-default-directory t | 48 (defcustom insert-default-directory t |
49 "*Non-nil means when reading a filename start with default dir in minibuffer." | 49 "*Non-nil means when reading a filename start with default dir in minibuffer." |
348 "Read a string from the minibuffer, prompting with string PROMPT. | 348 "Read a string from the minibuffer, prompting with string PROMPT. |
349 If optional second arg INITIAL-CONTENTS is non-nil, it is a string | 349 If optional second arg INITIAL-CONTENTS is non-nil, it is a string |
350 to be inserted into the minibuffer before reading input. | 350 to be inserted into the minibuffer before reading input. |
351 If INITIAL-CONTENTS is (STRING . POSITION), the initial input | 351 If INITIAL-CONTENTS is (STRING . POSITION), the initial input |
352 is STRING, but point is placed POSITION characters into the string. | 352 is STRING, but point is placed POSITION characters into the string. |
353 Third arg KEYMAP is a keymap to use whilst reading; | 353 Third arg KEYMAP is a keymap to use while reading; |
354 if omitted or nil, the default is `minibuffer-local-map'. | 354 if omitted or nil, the default is `minibuffer-local-map'. |
355 If fourth arg READ is non-nil, then interpret the result as a lisp object | 355 If fourth arg READ is non-nil, then interpret the result as a lisp object |
356 and return that object: | 356 and return that object: |
357 in other words, do `(car (read-from-string INPUT-STRING))' | 357 in other words, do `(car (read-from-string INPUT-STRING))' |
358 Fifth arg HISTORY, if non-nil, specifies a history list | 358 Fifth arg HISTORY, if non-nil, specifies a history list |
1475 (defun un-substitute-in-file-name (string) | 1475 (defun un-substitute-in-file-name (string) |
1476 (let ((regexp "\\$") | 1476 (let ((regexp "\\$") |
1477 (olen (length string)) | 1477 (olen (length string)) |
1478 new | 1478 new |
1479 n o ch) | 1479 n o ch) |
1480 (cond ((eq system-type 'vax-vms) | 1480 (if (not (string-match regexp string)) |
1481 string) | 1481 string |
1482 ((not (string-match regexp string)) | 1482 (setq n 1) |
1483 string) | 1483 (while (string-match regexp string (match-end 0)) |
1484 (t | 1484 (setq n (1+ n))) |
1485 (setq n 1) | 1485 (setq new (make-string (+ olen n) ?$)) |
1486 (while (string-match regexp string (match-end 0)) | 1486 (setq n 0 o 0) |
1487 (setq n (1+ n))) | 1487 (while (< o olen) |
1488 (setq new (make-string (+ olen n) ?$)) | 1488 (setq ch (aref string o)) |
1489 (setq n 0 o 0) | 1489 (aset new n ch) |
1490 (while (< o olen) | 1490 (setq o (1+ o) n (1+ n)) |
1491 (setq ch (aref string o)) | 1491 (if (eq ch ?$) |
1492 (aset new n ch) | 1492 ;; already aset by make-string initial-value |
1493 (setq o (1+ o) n (1+ n)) | 1493 (setq n (1+ n)))) |
1494 (if (eq ch ?$) | 1494 new))) |
1495 ;; already aset by make-string initial-value | |
1496 (setq n (1+ n)))) | |
1497 new)))) | |
1498 | 1495 |
1499 (defun read-file-name-2 (history prompt dir default | 1496 (defun read-file-name-2 (history prompt dir default |
1500 must-match initial-contents | 1497 must-match initial-contents |
1501 completer) | 1498 completer) |
1502 (if (not dir) | 1499 (if (not dir) |
1509 (cons (un-substitute-in-file-name | 1506 (cons (un-substitute-in-file-name |
1510 (concat dir initial-contents)) | 1507 (concat dir initial-contents)) |
1511 (length dir))) | 1508 (length dir))) |
1512 (t | 1509 (t |
1513 (un-substitute-in-file-name dir)))) | 1510 (un-substitute-in-file-name dir)))) |
1514 (val (let ((completion-ignore-case (or completion-ignore-case | 1511 (val |
1515 (eq system-type 'vax-vms)))) | |
1516 ;; Hateful, broken, case-sensitive un*x | 1512 ;; Hateful, broken, case-sensitive un*x |
1517 ;;; (completing-read prompt | 1513 ;;; (completing-read prompt |
1518 ;;; completer | 1514 ;;; completer |
1519 ;;; dir | 1515 ;;; dir |
1520 ;;; must-match | 1516 ;;; must-match |
1521 ;;; insert | 1517 ;;; insert |
1522 ;;; history) | 1518 ;;; history) |
1523 ;; #### - this is essentially the guts of completing read. | 1519 ;; #### - this is essentially the guts of completing read. |
1524 ;; There should be an elegant way to pass a pair of keymaps to | 1520 ;; There should be an elegant way to pass a pair of keymaps to |
1525 ;; completing read, but this will do for now. All sins are | 1521 ;; completing read, but this will do for now. All sins are |
1526 ;; relative. --Stig | 1522 ;; relative. --Stig |
1527 (let ((minibuffer-completion-table completer) | 1523 (let ((minibuffer-completion-table completer) |
1528 (minibuffer-completion-predicate dir) | 1524 (minibuffer-completion-predicate dir) |
1529 (minibuffer-completion-confirm (if (eq must-match 't) | 1525 (minibuffer-completion-confirm (if (eq must-match 't) |
1530 nil t)) | 1526 nil t)) |
1531 (last-exact-completion nil)) | 1527 (last-exact-completion nil)) |
1532 (read-from-minibuffer prompt | 1528 (read-from-minibuffer prompt |
1533 insert | 1529 insert |
1534 (if (not must-match) | 1530 (if (not must-match) |
1535 read-file-name-map | 1531 read-file-name-map |
1536 read-file-name-must-match-map) | 1532 read-file-name-must-match-map) |
1537 nil | 1533 nil |
1538 history))) | 1534 history)) |
1539 )) | 1535 )) |
1540 ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar" | 1536 ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar" |
1541 ;;; (let ((hist (cond ((not history) 'minibuffer-history) | 1537 ;;; (let ((hist (cond ((not history) 'minibuffer-history) |
1542 ;;; ((consp history) (car history)) | 1538 ;;; ((consp history) (car history)) |
1543 ;;; (t history)))) | 1539 ;;; (t history)))) |
1726 start)))) | 1722 start)))) |
1727 (head (substring string 0 (1- start))) | 1723 (head (substring string 0 (1- start))) |
1728 (alist #'(lambda () | 1724 (alist #'(lambda () |
1729 (mapcar #'(lambda (x) | 1725 (mapcar #'(lambda (x) |
1730 (cons (substring x 0 (string-match "=" x)) | 1726 (cons (substring x 0 (string-match "=" x)) |
1731 'nil)) | 1727 nil)) |
1732 process-environment)))) | 1728 process-environment)))) |
1733 | 1729 |
1734 (cond ((eq action 'lambda) | 1730 (cond ((eq action 'lambda) |
1735 nil) | 1731 nil) |
1736 ((eq action 't) | 1732 ((eq action 't) |
1741 ;;#### -- need absolute-pathname-p | 1737 ;;#### -- need absolute-pathname-p |
1742 (/= (aref p 0) ?/)) | 1738 (/= (aref p 0) ?/)) |
1743 (concat "$" p) | 1739 (concat "$" p) |
1744 (concat head "$" p))) | 1740 (concat head "$" p))) |
1745 (all-completions env (funcall alist)))) | 1741 (all-completions env (funcall alist)))) |
1746 (t ;; 'nil | 1742 (t ;; nil |
1747 ;; complete | 1743 ;; complete |
1748 (let* ((e (funcall alist)) | 1744 (let* ((e (funcall alist)) |
1749 (val (try-completion env e))) | 1745 (val (try-completion env e))) |
1750 (cond ((stringp val) | 1746 (cond ((stringp val) |
1751 (if (string-match "[^A-Za-z0-9_]" val) | 1747 (if (string-match "[^A-Za-z0-9_]" val) |
1777 (file-exists-p sstring))))) | 1773 (file-exists-p sstring))))) |
1778 ((eq action 't) | 1774 ((eq action 't) |
1779 ;; all completions | 1775 ;; all completions |
1780 (mapcar #'un-substitute-in-file-name | 1776 (mapcar #'un-substitute-in-file-name |
1781 (file-name-all-completions name dir))) | 1777 (file-name-all-completions name dir))) |
1782 (t;; 'nil | 1778 (t;; nil |
1783 ;; complete | 1779 ;; complete |
1784 (let* ((d (or dir default-directory)) | 1780 (let* ((d (or dir default-directory)) |
1785 (val (file-name-completion name d))) | 1781 (val (file-name-completion name d))) |
1786 (if (and (eq val 't) | 1782 (if (and (eq val 't) |
1787 (not (null completion-ignored-extensions))) | 1783 (not (null completion-ignored-extensions))) |
1818 nil | 1814 nil |
1819 (concat "\\`" (regexp-quote name)) | 1815 (concat "\\`" (regexp-quote name)) |
1820 nil | 1816 nil |
1821 'directories)))) | 1817 'directories)))) |
1822 (mapcar fn | 1818 (mapcar fn |
1823 (cond ((eq system-type 'vax-vms) | 1819 ;; Wretched unix |
1824 l) | 1820 (delete "." l)))))) |
1825 (t | |
1826 ;; Wretched unix | |
1827 (delete "." l)))))))) | |
1828 (cond ((eq action 'lambda) | 1821 (cond ((eq action 'lambda) |
1829 ;; complete? | 1822 ;; complete? |
1830 (if (not orig) | 1823 (if (not orig) |
1831 nil | 1824 nil |
1832 (file-directory-p string))) | 1825 (file-directory-p string))) |