Mercurial > hg > xemacs-beta

comparison lisp/cmdloop.el @ 284:558f606b08ae r21-0b40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents c42ec1d1cded
children c9fe270a4101
comparison
equal deleted inserted replaced
283:fa3d41851a08 284:558f606b08ae
104 ((not (one-window-p t)) 104 ((not (one-window-p t))
105 (delete-other-windows)) 105 (delete-other-windows))
106 ((string-match "^ \\*" (buffer-name (current-buffer))) 106 ((string-match "^ \\*" (buffer-name (current-buffer)))
107 (bury-buffer)))) 107 (bury-buffer))))
108 108
109 ;;#### This should really be a ring of last errors. 109 ;; Someone wrote: "This should really be a ring of last errors."
110 ;;
111 ;; But why bother? This stuff is not all that necessary now that we
112 ;; have message log, anyway.
110 (defvar last-error nil 113 (defvar last-error nil
111 "#### Document me.") 114 "Object describing the last signaled error.")
112 115
113 (defcustom errors-deactivate-region nil 116 (defcustom errors-deactivate-region nil
114 "*Non-nil means that errors will cause the region to be deactivated." 117 "*Non-nil means that errors will cause the region to be deactivated."
115 :type 'boolean 118 :type 'boolean
116 :group 'editing-basics) 119 :group 'editing-basics)
152 t)) 155 t))
153 156
154 (defun describe-last-error () 157 (defun describe-last-error ()
155 "Redisplay the last error-message. See the variable `last-error'." 158 "Redisplay the last error-message. See the variable `last-error'."
156 (interactive) 159 (interactive)
157 (with-displaying-help-buffer 160 (if last-error
158 (lambda () 161 (with-displaying-help-buffer
159 (princ "Last error was:\n" standard-output) 162 (lambda ()
160 (display-error last-error standard-output)))) 163 (princ "Last error was:\n" standard-output)
164 (display-error last-error standard-output)))
165 (message "No error yet")))
161 166
162 167
163 ;;#### Must be done later in the loadup sequence 168 ;;#### Must be done later in the loadup sequence
164 ;(define-key (symbol-function 'help-command) "e" 'describe-last-error) 169 ;(define-key (symbol-function 'help-command) "e" 'describe-last-error)
165 170
437 If a mouse click or non-ASCII character is detected, an error is 442 If a mouse click or non-ASCII character is detected, an error is
438 signalled. The character typed is returned as an ASCII value. This 443 signalled. The character typed is returned as an ASCII value. This
439 is most likely the wrong thing for you to be using: consider using 444 is most likely the wrong thing for you to be using: consider using
440 the `next-command-event' function instead." 445 the `next-command-event' function instead."
441 (save-excursion 446 (save-excursion
442 (let* ((inhibit-quit t) 447 (let ((event (next-command-event)))
443 (event (next-command-event))) 448 (or inhibit-quit
449 (and (event-matches-key-specifier-p event (quit-char))
450 (signal 'quit nil)))
444 (prog1 (or (event-to-character event) 451 (prog1 (or (event-to-character event)
445 ;; Kludge. If the event we read was a mouse-release, 452 ;; Kludge. If the event we read was a mouse-release,
446 ;; discard it and read the next one. 453 ;; discard it and read the next one.
447 (if (button-release-event-p event) 454 (if (button-release-event-p event)
448 (event-to-character (next-command-event event))) 455 (event-to-character (next-command-event event)))
454 "Read a character from the command input (keyboard or macro). 461 "Read a character from the command input (keyboard or macro).
455 If a mouse click or non-ASCII character is detected, it is discarded. 462 If a mouse click or non-ASCII character is detected, it is discarded.
456 The character typed is returned as an ASCII value. This is most likely 463 The character typed is returned as an ASCII value. This is most likely
457 the wrong thing for you to be using: consider using the 464 the wrong thing for you to be using: consider using the
458 `next-command-event' function instead." 465 `next-command-event' function instead."
459 (let ((inhibit-quit t) 466 (let (event ch)
460 event ch)
461 (while (progn 467 (while (progn
462 (setq event (next-command-event)) 468 (setq event (next-command-event))
469 (or inhibit-quit
470 (and (event-matches-key-specifier-p event (quit-char))
471 (signal 'quit nil)))
463 (setq ch (event-to-character event)) 472 (setq ch (event-to-character event))
464 (deallocate-event event) 473 (deallocate-event event)
465 (null ch))) 474 (null ch)))
466 ch)) 475 ch))
467 476
468 (defun read-quoted-char (&optional prompt) 477 (defun read-quoted-char (&optional prompt)
469 "Like `read-char', except that if the first character read is an octal 478 "Like `read-char', except that if the first character read is an octal
470 digit, we read up to two more octal digits and return the character 479 digit, we read up to two more octal digits and return the character
471 represented by the octal number consisting of those digits. 480 represented by the octal number consisting of those digits.
472 Optional argument PROMPT specifies a string to use to prompt the user." 481 Optional argument PROMPT specifies a string to use to prompt the user."
473 (save-excursion 482 (let ((count 0) (code 0) done
474 (let ((count 0) (code 0) 483 (prompt (and prompt (gettext prompt)))
475 (prompt (and prompt (gettext prompt))) 484 char event)
476 char event) 485 (while (and (not done) (< count 3))
477 (while (< count 3) 486 (let ((inhibit-quit (zerop count))
478 (let ((inhibit-quit (zerop count))
479 ;; Don't let C-h get the help message--only help function keys. 487 ;; Don't let C-h get the help message--only help function keys.
480 (help-char nil) 488 (help-char nil)
481 (help-form 489 (help-form
482 "Type the special character you want to use, 490 "Type the special character you want to use,
483 or three octal digits representing its character code.")) 491 or three octal digits representing its character code."))
484 (and prompt (display-message 'prompt (format "%s-" prompt))) 492 (and prompt (display-message 'prompt (format "%s-" prompt)))
485 (setq event (next-command-event) 493 (setq event (next-command-event)
486 char (or (event-to-character event nil nil t) 494 char (or (event-to-character event nil nil t)
487 (error "key read cannot be inserted in a buffer: %S" 495 (signal 'error
488 event))) 496 (list "key read cannot be inserted in a buffer"
489 (if inhibit-quit (setq quit-flag nil))) 497 event))))
490 (cond ((null char)) 498 (if inhibit-quit (setq quit-flag nil)))
491 ((and (<= ?0 char) (<= char ?7)) 499 (cond ((<= ?0 char ?7)
492 (setq code (+ (* code 8) (- char ?0)) 500 (setq code (+ (* code 8) (- char ?0))
493 count (1+ count)) 501 count (1+ count))
494 (and prompt (display-message 502 (when prompt
495 'prompt 503 (display-message 'prompt
496 (setq prompt (format "%s %c" prompt char))))) 504 (setq prompt (format "%s %c" prompt char)))))
497 ((> count 0) 505 ((> count 0)
498 (setq unread-command-event event 506 (setq unread-command-event event
499 count 259)) 507 done t))
500 (t (setq code char count 259)))) 508 (t (setq code (char-int char)
509 done t))))
510 (int-char code)
501 ;; Turn a meta-character into a character with the 0200 bit set. 511 ;; Turn a meta-character into a character with the 0200 bit set.
502 (logior (if (/= (logand code ?\M-\^@) 0) 128 0) 512 ; (logior (if (/= (logand code ?\M-\^@) 0) 128 0)
503 (logand 255 code))))) 513 ; (logand 255 code))))
514 ))
504 515
505 (defun momentary-string-display (string pos &optional exit-char message) 516 (defun momentary-string-display (string pos &optional exit-char message)
506 "Momentarily display STRING in the buffer at POS. 517 "Momentarily display STRING in the buffer at POS.
507 Display remains until next character is typed. 518 Display remains until next character is typed.
508 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed; 519 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;