X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fminibuf.el;h=8177a3edc8c3beb9bab89f8f6c65234286a198ff;hb=84d69cedb1497fde83814a796ebe5d93e168c78b;hp=342f5bdfa3a3a2532a0491d718de9a05b6e6e9af;hpb=2fd9701a4f902054649dde9143a3f77809afee8f;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/minibuf.el b/lisp/minibuf.el index 342f5bd..8177a3e 100644 --- a/lisp/minibuf.el +++ b/lisp/minibuf.el @@ -52,7 +52,7 @@ (defcustom minibuffer-history-uniquify t "*Non-nil means when adding an item to a minibuffer history, remove -previous occurances of the same item from the history list first, +previous occurrences of the same item from the history list first, rather than just consing the new element onto the front of the list." :type 'boolean :group 'minibuffer) @@ -196,7 +196,7 @@ minibuffer is reinvoked while it is the selected window." (define-key map "\M-\t" 'comint-dynamic-complete) (define-key map "\M-?" 'comint-dynamic-list-completions) map) - "Minibuffer keymap used by shell-command and related commands.") + "Minibuffer keymap used by `shell-command' and related commands.") (defcustom use-dialog-box t "*Variable controlling usage of the dialog box. @@ -271,8 +271,7 @@ in `substitute-in-file-name'." If `zmacs-regions' is true, and the zmacs region is active in this buffer, then this key deactivates the region without beeping." (interactive) - (if (and (region-active-p) - (eq (current-buffer) (zmacs-region-buffer))) + (if (region-active-p) ;; pseudo-zmacs compatibility: don't beep if this ^G is simply ;; deactivating the region. If it is inactive, beep. nil @@ -376,8 +375,8 @@ Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table' Seventh arg DEFAULT, if non-nil, will be returned when user enters an empty string. -See also the variable completion-highlight-first-word-only for control over - completion display." +See also the variable `completion-highlight-first-word-only' for + control over completion display." (if (and (not enable-recursive-minibuffers) (> (minibuffer-depth) 0) (eq (selected-window) (minibuffer-window))) @@ -765,17 +764,21 @@ See also the variable completion-highlight-first-word-only for control over &optional predicate require-match initial-contents history default) "Read a string in the minibuffer, with completion. -Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY. + PROMPT is a string to prompt with; normally it ends in a colon and a space. TABLE is an alist whose elements' cars are strings, or an obarray. +TABLE can also be a function which does the completion itself. PREDICATE limits completion to a subset of TABLE. -See `try-completion' for more details on completion, TABLE, and PREDICATE. +See `try-completion' and `all-completions' for more details + on completion, TABLE, and PREDICATE. + If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless - the input is (or completes to) an element of TABLE or is null. - If it is also not t, Return does not exit if it does non-null completion. + the input is (or completes to) an element of TABLE or is null. + If it is also not t, Return does not exit if it does non-null completion. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string. + HISTORY, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list variable to use, @@ -785,7 +788,9 @@ HISTORY, if non-nil, specifies a history list which INITIAL-CONTENTS corresponds to). If HISTORY is `t', no history will be recorded. Positions are counted starting from 1 at the beginning of the list. -DEFAULT, if non-nil, is the default value. +DEFAULT, if non-nil, will be returned when the user enters an empty + string. + Completion ignores case if the ambient value of `completion-ignore-case' is non-nil." (let ((minibuffer-completion-table table) @@ -1212,7 +1217,7 @@ the special minibuffer behavior." (defun minibuffer-smart-maybe-select-highlighted-completion (event &optional click-count) - "Like minibuffer-smart-select-highlighted-completion but does nothing if + "Like `minibuffer-smart-select-highlighted-completion' but does nothing if there is no completion (as opposed to executing the global binding). Useful as the value of `mouse-track-click-hook'." (interactive "e") @@ -1329,6 +1334,15 @@ If N is negative, find the previous or Nth previous match." current-minibuffer-point (point))) (let ((narg (- minibuffer-history-position n)) (minimum (if minibuffer-default -1 0))) + ;; a weird special case here; when in repeat-complex-command, we're + ;; trying to edit the top command, and minibuffer-history-position + ;; points to 1, the next-to-top command. in this case, the top + ;; command in the history is suppressed in favor of the one being + ;; edited, and there is no more command below it, except maybe the + ;; default. + (if (and (zerop narg) (eq minibuffer-history-position + initial-minibuffer-history-position)) + (setq minimum (1+ minimum))) (cond ((< narg minimum) (error (if minibuffer-default "No following item in %s" @@ -1342,7 +1356,7 @@ If N is negative, find the previous or Nth previous match." (progn (insert current-minibuffer-contents) (goto-char current-minibuffer-point)) - (let ((elt (if (>= narg 0) + (let ((elt (if (> narg 0) (nth (1- minibuffer-history-position) (symbol-value minibuffer-history-variable)) minibuffer-default))) @@ -1544,6 +1558,24 @@ If DEFAULT-VALUE is non-nil, return that if user enters an empty (setq n (1+ n)))) new))) + +;; Wrapper for `directory-files' for use in generating completion lists. +;; Generates output in the same format as `file-name-all-completions'. +;; +;; The EFS replacement for `directory-files' doesn't support the FILES-ONLY +;; option, so it has to be faked. The listing cache will hopefully +;; improve the performance of this operation. +(defun minibuf-directory-files (dir &optional match-regexp files-only) + (let ((want-file (or (eq files-only nil) (eq files-only t))) + (want-dirs (or (eq files-only nil) (not (eq files-only t))))) + (delete nil + (mapcar (function (lambda (f) + (if (file-directory-p (expand-file-name f dir)) + (and want-dirs (file-name-as-directory f)) + (and want-file f)))) + (delete "." (directory-files dir nil match-regexp)))))) + + (defun read-file-name-2 (history prompt dir default must-match initial-contents completer) @@ -1632,19 +1664,39 @@ If DEFAULT-VALUE is non-nil, return that if user enters an empty (reset-buffer completion-buf) (let ((standard-output completion-buf)) (display-completion-list - (delete "." (directory-files full nil nil nil (if dir-p 'directory))) + (minibuf-directory-files full nil (if dir-p 'directory)) :user-data dir-p :reference-buffer minibuf :activate-callback 'read-file-name-activate-callback) (goto-char (point-min) completion-buf))))) -(defun read-file-name-1 (history prompt dir default - must-match initial-contents - completer) +(defun read-file-name-1 (type history prompt dir default + must-match initial-contents + completer) (if (should-use-dialog-box-p) - ;; this calls read-file-name-2 - (mouse-read-file-name-1 history prompt dir default must-match - initial-contents completer) + (condition-case nil + (let ((file + (apply #'make-dialog-box + type `(:title ,(capitalize-string-as-title + ;; Kludge: Delete ": " off the end. + (replace-in-string prompt ": $" "")) + ,@(and dir (list :initial-directory + dir)) + :file-must-exist ,must-match + ,@(and initial-contents + (list :initial-filename + initial-contents)))))) + ;; hack -- until we implement reading a directory properly, + ;; allow a file as indicating the directory it's in + (if (and (eq completer 'read-directory-name-internal) + (not (file-directory-p file))) + (file-name-directory file) + file)) + (unimplemented + ;; this calls read-file-name-2 + (mouse-read-file-name-1 history prompt dir default must-match + initial-contents completer) + )) (add-one-shot-hook 'minibuffer-setup-hook (lambda () @@ -1684,8 +1736,8 @@ Fifth arg INITIAL-CONTENTS specifies text to start with. If this is not Sixth arg HISTORY specifies the history list to use. Default is `file-name-history'. DIR defaults to current buffer's directory default." - (read-file-name-1 - (or history 'file-name-history) + (read-file-name-1 + 'file (or history 'file-name-history) prompt dir (or default (and initial-contents (abbreviate-file-name (expand-file-name @@ -1715,9 +1767,9 @@ Sixth arg HISTORY specifies the history list to use. Default is `file-name-history'. DIR defaults to current buffer's directory default." (read-file-name-1 - (or history 'file-name-history) - prompt dir (or default default-directory) must-match initial-contents - 'read-directory-name-internal)) + 'directory (or history 'file-name-history) + prompt dir (or default default-directory) must-match initial-contents + 'read-directory-name-internal)) ;; Environment-variable and ~username completion hack @@ -1825,7 +1877,9 @@ DIR defaults to current buffer's directory default." ((eq action 't) ;; all completions (mapcar #'un-substitute-in-file-name - (file-name-all-completions name dir))) + (if (string= name "") + (delete "./" (file-name-all-completions "" dir)) + (file-name-all-completions name dir)))) (t;; nil ;; complete (let* ((d (or dir default-directory)) @@ -1854,17 +1908,13 @@ DIR defaults to current buffer's directory default." #'(lambda (action orig string specdir dir name) (let* ((dirs #'(lambda (fn) (let ((l (if (equal name "") - (directory-files + (minibuf-directory-files dir - nil "" - nil 'directories) - (directory-files + (minibuf-directory-files dir - nil (concat "\\`" (regexp-quote name)) - nil 'directories)))) (mapcar fn ;; Wretched unix @@ -1930,13 +1980,8 @@ whether it is a file(/result) or a directory (/result/)." ;; a specifier would be nice. (set (make-local-variable 'frame-title-format) (capitalize-string-as-title - ;; Delete ": " off the end. There must be an easier way! - (let ((end-pos (length prompt))) - (if (and (> end-pos 0) (eq (aref prompt (1- end-pos)) ? )) - (setq end-pos (1- end-pos))) - (if (and (> end-pos 0) (eq (aref prompt (1- end-pos)) ?:)) - (setq end-pos (1- end-pos))) - (substring prompt 0 end-pos)))) + ;; Kludge: Delete ": " off the end. + (replace-in-string prompt ": $" ""))) ;; ensure that killing the frame works right, ;; instead of leaving us in the minibuffer. (add-local-hook 'delete-frame-hook @@ -1947,7 +1992,7 @@ whether it is a file(/result) or a directory (/result/)." (let ((standard-output (window-buffer window))) (condition-case nil (display-completion-list - (directory-files dir nil nil nil t) + (minibuf-directory-files dir nil t) :window-width (window-width window) :window-height (window-text-area-height window) :completion-string "" @@ -1963,7 +2008,7 @@ whether it is a file(/result) or a directory (/result/)." (let ((standard-output (window-buffer window))) (condition-case nil (display-completion-list - (delete "." (directory-files dir nil nil nil 1)) + (minibuf-directory-files dir nil 1) :window-width (window-width window) :window-height (window-text-area-height window) :completion-string "" @@ -2151,7 +2196,9 @@ whether it is a file(/result) or a directory (/result/)." "/usr/local/lib/X11R5/X11/" "/usr/X11/lib/X11/" "/usr/lib/X11/" + "/usr/share/X11/" "/usr/local/lib/X11/" + "/usr/local/share/X11/" "/usr/X386/lib/X11/" "/usr/x386/lib/X11/" "/usr/XFree86/lib/X11/" @@ -2168,7 +2215,7 @@ whether it is a file(/result) or a directory (/result/)." (defun read-color-completion-table () (case (device-type) ;; #### Evil device-type dependency - (x + ((x gtk) (if (boundp 'x-read-color-completion-table) x-read-color-completion-table (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))