Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-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 05472e90ae02
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
180 (list 'and 'string (list function 'string))))) 180 (list 'and 'string (list function 'string)))))
181 (while keymaps 181 (while keymaps
182 (setq keymap (car keymaps)) 182 (setq keymap (car keymaps))
183 (cond ((vm-mouse-xemacs-mouse-p) 183 (cond ((vm-mouse-xemacs-mouse-p)
184 (define-key keymap 'button1 command) 184 (define-key keymap 'button1 command)
185 (define-key keymap 'button2 command)) 185 (define-key keymap 'button2 command)
186 (define-key keymap 'button3 command))
186 ((vm-mouse-fsfemacs-mouse-p) 187 ((vm-mouse-fsfemacs-mouse-p)
187 (define-key keymap [down-mouse-1] 'ignore) 188 (define-key keymap [down-mouse-1] 'ignore)
188 (define-key keymap [drag-mouse-1] 'ignore) 189 (define-key keymap [drag-mouse-1] 'ignore)
189 (define-key keymap [mouse-1] command) 190 (define-key keymap [mouse-1] command)
190 (define-key keymap [drag-mouse-2] 'ignore) 191 (define-key keymap [drag-mouse-2] 'ignore)
191 (define-key keymap [down-mouse-2] 'ignore) 192 (define-key keymap [down-mouse-2] 'ignore)
192 (define-key keymap [mouse-2] command))) 193 (define-key keymap [mouse-2] command)
194 (define-key keymap [drag-mouse-3] 'ignore)
195 (define-key keymap [down-mouse-3] 'ignore)
196 (define-key keymap [mouse-3] command)))
193 (setq keymaps (cdr keymaps))))) 197 (setq keymaps (cdr keymaps)))))
194 (setq w (vm-get-buffer-window (current-buffer))) 198 (setq w (vm-get-buffer-window (current-buffer)))
195 (setq q list 199 (setq q list
196 list-length 0 200 list-length 0
197 longest 0) 201 longest 0)
260 (define-key minibuffer-local-map " " 'vm-minibuffer-complete-word) 264 (define-key minibuffer-local-map " " 'vm-minibuffer-complete-word)
261 (define-key minibuffer-local-map "?" 'vm-minibuffer-completion-help) 265 (define-key minibuffer-local-map "?" 'vm-minibuffer-completion-help)
262 (if (not multi-word) 266 (if (not multi-word)
263 (define-key minibuffer-local-map "\r" 267 (define-key minibuffer-local-map "\r"
264 'vm-minibuffer-complete-word-and-exit)) 268 'vm-minibuffer-complete-word-and-exit))
265 ;; evade the XEmacs dialog box, yeccch. 269 (read-string prompt)))
266 (let ((use-dialog-box nil))
267 (read-string prompt))))
268 270
269 (defvar last-nonmenu-event) 271 (defvar last-nonmenu-event)
270 272
271 (defun vm-read-string (prompt completion-list &optional multi-word) 273 (defun vm-read-string (prompt completion-list &optional multi-word)
272 ;; handle alist 274 ;; handle alist
273 (if (consp (car completion-list)) 275 (if (consp (car completion-list))
274 (setq completion-list (nreverse (mapcar 'car completion-list)))) 276 (setq completion-list (nreverse (mapcar 'car completion-list))))
275 (if (and completion-list (vm-mouse-support-possible-here-p)) 277 (if (and completion-list (vm-mouse-support-possible-p))
276 (cond ((and (vm-mouse-xemacs-mouse-p) 278 (cond ((and (vm-mouse-xemacs-mouse-p)
277 (or (button-press-event-p last-command-event) 279 (or (button-press-event-p last-command-event)
278 (button-release-event-p last-command-event) 280 (button-release-event-p last-command-event)
279 (menu-event-p last-command-event))) 281 (menu-event-p last-command-event)))
280 (vm-mouse-read-string prompt completion-list multi-word)) 282 (vm-mouse-read-string prompt completion-list multi-word))
315 (save-excursion 317 (save-excursion
316 (setq input-buffer (get-buffer-create " *password*")) 318 (setq input-buffer (get-buffer-create " *password*"))
317 (set-buffer input-buffer) 319 (set-buffer input-buffer)
318 (while t 320 (while t
319 (erase-buffer) 321 (erase-buffer)
320 (message "%s%s" prompt 322 (vm-unsaved-message "%s%s" prompt
321 (vm-truncate-string xxx (buffer-size))) 323 (vm-truncate-string xxx (buffer-size)))
322 (while (not (memq (setq char (read-char)) '(?\C-m ?\C-j))) 324 (while (not (memq (setq char (read-char)) '(?\C-m ?\C-j)))
323 (if (setq form 325 (if (setq form
324 (cdr 326 (cdr
325 (assq char 327 (assq char
331 (?\C-v . (quoted-insert 1)))))) 333 (?\C-v . (quoted-insert 1))))))
332 (condition-case error-data 334 (condition-case error-data
333 (eval form) 335 (eval form)
334 (error t)) 336 (error t))
335 (insert char)) 337 (insert char))
336 (message "%s%s" prompt 338 (vm-unsaved-message "%s%s" prompt
337 (vm-truncate-string xxx (buffer-size)))) 339 (vm-truncate-string xxx (buffer-size))))
338 (cond ((and confirm string) 340 (cond ((and confirm string)
339 (cond ((not (string= string (buffer-string))) 341 (cond ((not (string= string (buffer-string)))
340 (message 342 (vm-unsaved-message
341 (concat prompt 343 (concat prompt
342 (vm-truncate-string xxx (buffer-size)) 344 (vm-truncate-string xxx (buffer-size))
343 " [Mismatch... try again.]")) 345 " [Mismatch... try again.]"))
344 (ding) 346 (ding)
345 (sit-for 2) 347 (sit-for 2)
346 (setq string nil)) 348 (setq string nil))
347 (t (throw 'return-value string)))) 349 (t (throw 'return-value string))))
348 (confirm 350 (confirm
349 (setq string (buffer-string)) 351 (setq string (buffer-string))
350 (message 352 (vm-unsaved-message
351 (concat prompt 353 (concat prompt
352 (vm-truncate-string xxx (buffer-size)) 354 (vm-truncate-string xxx (buffer-size))
353 " [Retype to confirm...]")) 355 " [Retype to confirm...]"))
354 (sit-for 2)) 356 (sit-for 2))
355 (t 357 (t
356 (message "") 358 (vm-unsaved-message "")
357 (throw 'return-value (buffer-string)))))) 359 (throw 'return-value (buffer-string))))))
358 (and input-buffer (kill-buffer input-buffer))))))) 360 (and input-buffer (kill-buffer input-buffer)))))))
359 361
360 (defun vm-keyboard-read-file-name (prompt &optional dir default 362 (defun vm-keyboard-read-file-name (prompt &optional dir default
361 must-match initial history) 363 must-match initial history)
362 "Like read-file-name, except HISTORY's value is unaltered." 364 "Like read-file-name, except HISTORY's value is unaltered."
363 (let ((oldvalue (symbol-value history)) 365 (let ((oldvalue (symbol-value history)))
364 ;; evade the XEmacs dialog box, yeccch.
365 (use-dialog-box nil))
366 (unwind-protect 366 (unwind-protect
367 (condition-case nil 367 (condition-case nil
368 (read-file-name prompt dir default must-match initial history) 368 (read-file-name prompt dir default must-match initial history)
369 (wrong-number-of-arguments 369 (wrong-number-of-arguments
370 (if history 370 (if history
378 378
379 (defun vm-read-file-name (prompt &optional dir default 379 (defun vm-read-file-name (prompt &optional dir default
380 must-match initial history) 380 must-match initial history)
381 "Like read-file-name, except a mouse interface is used if a mouse 381 "Like read-file-name, except a mouse interface is used if a mouse
382 click mouse triggered the current command." 382 click mouse triggered the current command."
383 (if (vm-mouse-support-possible-here-p) 383 (if (vm-mouse-support-possible-p)
384 (cond ((and (vm-mouse-xemacs-mouse-p) 384 (cond ((and (vm-mouse-xemacs-mouse-p)
385 (or (button-press-event-p last-command-event) 385 (or (button-press-event-p last-command-event)
386 (button-release-event-p last-command-event) 386 (button-release-event-p last-command-event)
387 (menu-event-p last-command-event))) 387 (menu-event-p last-command-event)))
388 (vm-mouse-read-file-name prompt dir default 388 (vm-mouse-read-file-name prompt dir default