Mercurial > hg > xemacs-beta

comparison lisp/prim/minibuf.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; minibuf.el -- Minibuffer support functions for XEmacs 1 ;;; minibuf.el
2
3 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. 2 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems 3 ;; Copyright (C) 1995 Tinker Systems
5 ;; Copyright (C) 1995, 1996 Ben Wing 4 ;; Copyright (C) 1995, 1996 Ben Wing
6 5
7 ;; Author: Richard Mlynarik
8 ;; Keywords: internal
9
10 ;; This file is part of XEmacs. 6 ;; This file is part of XEmacs.
11 7
12 ;; XEmacs is free software; you can redistribute it and/or modify it 8 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by 9 ;; under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option) 10 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 16 ;; General Public License for more details.
21 17
22 ;; You should have received a copy of the GNU General Public License 18 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free 19 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 20 ;; Free Software Foundation, 59 Temple Place - Suite 330,
25 ;; 02111-1307, USA. 21 ;; Boston, MA 02111-1307, USA.
26 22
27 ;;; Synched up with: all the minibuffer history stuff is synched with 23 ;;; Synched up with: all the minibuffer history stuff is synched with
28 ;;; 19.34. Not sure about the rest. 24 ;;; 19.30. Not sure about the rest.
29 25
30 ;;; Commentary: 26 ;;; Commentary:
31 27
32 ;; Written by Richard Mlynarik 2-Oct-92 28 ;; Written by Richard Mlynarik 2-Oct-92
33 29
159 (define-key map "\t" 'comint-dynamic-complete) 155 (define-key map "\t" 'comint-dynamic-complete)
160 (define-key map "\M-\t" 'comint-dynamic-complete) 156 (define-key map "\M-\t" 'comint-dynamic-complete)
161 (define-key map "\M-?" 'comint-dynamic-list-completions) 157 (define-key map "\M-?" 'comint-dynamic-list-completions)
162 map) 158 map)
163 "Minibuffer keymap used by shell-command and related commands.") 159 "Minibuffer keymap used by shell-command and related commands.")
164
165 (defvar use-dialog-box t
166 "Variable controlling usage of the dialog box. If nil, the dialog box
167 will never be used, even in response to mouse events.")
168 160
169 (defvar minibuffer-electric-file-name-behavior t 161 (defvar minibuffer-electric-file-name-behavior t
170 "If non-nil, slash and tilde in certain places cause immediate deletion. 162 "If non-nil, slash and tilde in certain places cause immediate deletion.
171 These are the same places where this behavior would occur later on anyway, 163 These are the same places where this behavior would occur later on anyway,
172 in `substitute-in-file-name'.") 164 in `substitute-in-file-name'.")
265 (defvar minibuffer-history-position) 257 (defvar minibuffer-history-position)
266 258
267 (defvar minibuffer-history-minimum-string-length 3 259 (defvar minibuffer-history-minimum-string-length 3
268 "If this variable is non-nil, a string will not be added to the 260 "If this variable is non-nil, a string will not be added to the
269 minibuffer history if its length is less than that value.") 261 minibuffer history if its length is less than that value.")
270
271 (define-error 'input-error "Keyboard input error")
272 262
273 (defun read-from-minibuffer (prompt &optional initial-contents 263 (defun read-from-minibuffer (prompt &optional initial-contents
274 keymap 264 keymap
275 readp 265 readp
276 history 266 history
407 ;; return value 397 ;; return value
408 (let* ((val (progn (set-buffer buffer) 398 (let* ((val (progn (set-buffer buffer)
409 (if minibuffer-exit-hook 399 (if minibuffer-exit-hook
410 (run-hooks 'minibuffer-exit-hook)) 400 (run-hooks 'minibuffer-exit-hook))
411 (buffer-string))) 401 (buffer-string)))
412 (histval val)
413 (err nil)) 402 (err nil))
414 (if readp 403 (if readp
415 (condition-case e 404 (condition-case e
416 (let ((v (read-from-string val))) 405 (let ((v (read-from-string val)))
417 (if (< (cdr v) (length val)) 406 (if (< (cdr v) (length val))
420 (error "Trailing garbage following expression")))) 409 (error "Trailing garbage following expression"))))
421 (setq v (car v)) 410 (setq v (car v))
422 ;; total total kludge 411 ;; total total kludge
423 (if (stringp v) (setq v (list 'quote v))) 412 (if (stringp v) (setq v (list 'quote v)))
424 (setq val v)) 413 (setq val v))
425 (end-of-file 414 (error (setq err e))))
426 (setq err
427 '(input-error "End of input before end of expression")))
428 (error (setq err e))))
429 ;; Add the value to the appropriate history list unless 415 ;; Add the value to the appropriate history list unless
430 ;; it's already the most recent element, or it's only 416 ;; it's already the most recent element, or it's only
431 ;; two characters long. 417 ;; two characters long.
432 (if (and (symbolp minibuffer-history-variable) 418 (if (and (symbolp minibuffer-history-variable)
433 (boundp minibuffer-history-variable)) 419 (boundp minibuffer-history-variable))
434 (let ((list (symbol-value minibuffer-history-variable))) 420 (let ((list (symbol-value minibuffer-history-variable)))
435 (or (eq list t) 421 (or (eq list t)
436 (null val) 422 (null val)
437 (and list (equal histval (car list))) 423 (and list (equal val (car list)))
438 (and (stringp val) 424 (and (stringp val)
439 minibuffer-history-minimum-string-length 425 minibuffer-history-minimum-string-length
440 (< (length val) 426 (< (length val)
441 minibuffer-history-minimum-string-length)) 427 minibuffer-history-minimum-string-length))
442 (set minibuffer-history-variable (cons histval list))))) 428 (set minibuffer-history-variable (cons val list)))))
443 (if err (signal (car err) (cdr err))) 429 (if err (signal (car err) (cdr err)))
444 val)))) 430 val))))
445 ;; stupid display code requires this for some reason 431 ;; stupid display code requires this for some reason
446 (set-buffer buffer) 432 (set-buffer buffer)
447 (buffer-disable-undo buffer) 433 (buffer-disable-undo buffer)
1219 (erase-buffer) 1205 (erase-buffer)
1220 (setq minibuffer-history-position narg) 1206 (setq minibuffer-history-position narg)
1221 (let ((elt (nth (1- minibuffer-history-position) 1207 (let ((elt (nth (1- minibuffer-history-position)
1222 (symbol-value minibuffer-history-variable)))) 1208 (symbol-value minibuffer-history-variable))))
1223 (insert 1209 (insert
1224 (if (not (stringp elt)) 1210 (if (and minibuffer-history-sexp-flag
1211 ;; total kludge
1212 (not (stringp elt)))
1225 (let ((print-level nil)) 1213 (let ((print-level nil))
1226 (condition-case nil 1214 (condition-case nil
1227 (let ((print-readably t) 1215 (let ((print-readably t)
1228 (print-escape-newlines t)) 1216 (print-escape-newlines t))
1229 (prin1-to-string elt)) 1217 (prin1-to-string elt))
1712 (delete "." l)))))))) 1700 (delete "." l))))))))
1713 (cond ((eq action 'lambda) 1701 (cond ((eq action 'lambda)
1714 ;; complete? 1702 ;; complete?
1715 (if (not orig) 1703 (if (not orig)
1716 nil 1704 nil
1717 (file-directory-p string))) 1705 (and (file-directory-p string)
1706 ;; So "foo" is ambiguous between "foo/" and "foobar/"
1707 (equal string (file-name-as-directory string)))))
1718 ((eq action 't) 1708 ((eq action 't)
1719 ;; all completions 1709 ;; all completions
1720 (funcall dirs #'(lambda (n) 1710 (funcall dirs #'(lambda (n)
1721 (un-substitute-in-file-name 1711 (un-substitute-in-file-name
1722 (file-name-as-directory n))))) 1712 (file-name-as-directory n)))))
1767 result) 1757 result)
1768 (t file)))) 1758 (t file))))
1769 1759
1770 (defun mouse-file-display-completion-list (window dir minibuf user-data) 1760 (defun mouse-file-display-completion-list (window dir minibuf user-data)
1771 (let ((standard-output (window-buffer window))) 1761 (let ((standard-output (window-buffer window)))
1772 (condition-case nil 1762 (display-completion-list
1773 (display-completion-list 1763 (directory-files dir nil nil nil t)
1774 (directory-files dir nil nil nil t) 1764 :window-width (* 2 (window-width window))
1775 :window-width (* 2 (window-width window)) 1765 :activate-callback
1776 :activate-callback 1766 'mouse-read-file-name-activate-callback
1777 'mouse-read-file-name-activate-callback 1767 :user-data user-data
1778 :user-data user-data 1768 :reference-buffer minibuf
1779 :reference-buffer minibuf 1769 :help-string "")))
1780 :help-string "")
1781 (t nil))))
1782 1770
1783 (defun mouse-directory-display-completion-list (window dir minibuf user-data) 1771 (defun mouse-directory-display-completion-list (window dir minibuf user-data)
1784 (let ((standard-output (window-buffer window))) 1772 (let ((standard-output (window-buffer window)))
1785 (condition-case nil 1773 (display-completion-list
1786 (display-completion-list 1774 (delete "." (directory-files dir nil nil nil 1))
1787 (delete "." (directory-files dir nil nil nil 1)) 1775 :window-width (window-width window)
1788 :window-width (window-width window) 1776 :activate-callback
1789 :activate-callback 1777 'mouse-read-file-name-activate-callback
1790 'mouse-read-file-name-activate-callback 1778 :user-data user-data
1791 :user-data user-data 1779 :reference-buffer minibuf
1792 :reference-buffer minibuf 1780 :help-string "")))
1793 :help-string "")
1794 (t nil))))
1795 1781
1796 (defun mouse-read-file-name-activate-callback (event extent user-data) 1782 (defun mouse-read-file-name-activate-callback (event extent user-data)
1797 (let* ((file (extent-string extent)) 1783 (let* ((file (extent-string extent))
1798 (minibuf (symbol-value-in-buffer 'completion-reference-buffer 1784 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
1799 (extent-object extent))) 1785 (extent-object extent)))
2015 ;; even when dialog boxes are not present. 2001 ;; even when dialog boxes are not present.
2016 (defun should-use-dialog-box-p () 2002 (defun should-use-dialog-box-p ()
2017 "If non-nil, questions should be asked with a dialog box instead of the 2003 "If non-nil, questions should be asked with a dialog box instead of the
2018 minibuffer. This looks at `last-command-event' to see if it was a mouse 2004 minibuffer. This looks at `last-command-event' to see if it was a mouse
2019 event, and checks whether dialog-support exists and the current device 2005 event, and checks whether dialog-support exists and the current device
2020 supports dialog boxes. 2006 supports dialog boxes."
2021
2022 The dialog box is totally disabled if the variable `use-dialog-box'
2023 is set to nil."
2024 (and (featurep 'dialog) 2007 (and (featurep 'dialog)
2025 (device-on-window-system-p) 2008 (device-on-window-system-p)
2026 use-dialog-box
2027 (or force-dialog-box-use 2009 (or force-dialog-box-use
2028 (button-press-event-p last-command-event) 2010 (button-press-event-p last-command-event)
2029 (button-release-event-p last-command-event) 2011 (button-release-event-p last-command-event)
2030 (misc-user-event-p last-command-event)))) 2012 (misc-user-event-p last-command-event))))
2031
2032 ;;; minibuf.el ends here