summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/comint.el2
-rw-r--r--lisp/ebuff-menu.el6
-rw-r--r--lisp/ehelp.el4
-rw-r--r--lisp/electric.el4
-rw-r--r--lisp/emacs-lisp/disass.el9
-rw-r--r--lisp/emacs-lisp/edebug.el2
-rw-r--r--lisp/emerge.el2
-rw-r--r--lisp/emulation/vip.el8
-rw-r--r--lisp/frame.el2
-rw-r--r--lisp/gnus.el2
-rw-r--r--lisp/help.el2
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/isearch.el16
-rw-r--r--lisp/map-ynp.el4
-rw-r--r--lisp/mouse.el724
-rw-r--r--lisp/progmodes/c-mode.el10
-rw-r--r--lisp/progmodes/fortran.el6
-rw-r--r--lisp/progmodes/simula.el2
-rw-r--r--lisp/scroll-bar.el8
-rw-r--r--lisp/simple.el13
-rw-r--r--lisp/subr.el6
-rw-r--r--lisp/term/sun-mouse.el6
-rw-r--r--lisp/terminal.el2
23 files changed, 437 insertions, 405 deletions
diff --git a/lisp/comint.el b/lisp/comint.el
index 94e5201cd9f..0c2022e53bf 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1091,7 +1091,7 @@ it just adds completion characters to the end of the filename."
(let ((ch (read-char)))
(if (= ch ?\ )
(set-window-configuration conf)
- (setq unread-command-event ch))))))))
+ (setq unread-command-events (list ch)))))))))
;;; Converting process modes to use comint mode
;;; ===========================================================================
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index d39b819a1de..d0feab9ca70 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -63,8 +63,8 @@ Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
(setq select
(catch 'electric-buffer-menu-select
(message "<<< Press Space to bury the buffer list >>>")
- (if (= (setq unread-command-event (read-char)) ?\ )
- (progn (setq unread-command-event nil)
+ (if (= (setq unread-command-events (list (read-char))) ?\ )
+ (progn (setq unread-command-events nil)
(throw 'electric-buffer-menu-select nil)))
(let ((first (progn (goto-char (point-min))
(forward-line 2)
@@ -196,7 +196,7 @@ electric-buffer-menu-mode-hook if it is non-nil."
(defun Electric-buffer-menu-exit ()
(interactive)
- (setq unread-command-event last-input-char)
+ (setq unread-command-events (list last-input-char))
;; for robustness
(condition-case ()
(throw 'electric-buffer-menu-select nil)
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index c6a7b77716a..327d48936ba 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -119,8 +119,8 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit"
(catch 'exit
(if (pos-visible-in-window-p (point-max))
(progn (message "<<< Press Space to bury the help buffer >>>")
- (if (= (setq unread-command-event (read-char)) ?\ )
- (progn (setq unread-command-event nil)
+ (if (= (setq unread-command-events (list (read-char))) ?\ )
+ (progn (setq unread-command-events nil)
(throw 'exit t)))))
(let (up down both neither
(standard (and (eq (key-binding " ")
diff --git a/lisp/electric.el b/lisp/electric.el
index acc002abaac..3f91adf2093 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -85,7 +85,7 @@
cmd this-command)
(if (or (prog1 quit-flag (setq quit-flag nil))
(= last-input-char ?\C-g))
- (progn (setq unread-command-event nil
+ (progn (setq unread-command-events nil
prefix-arg nil)
;; If it wasn't cancelling a prefix character, then quit.
(if (or (= (length (this-command-keys)) 1)
@@ -101,7 +101,7 @@
(setq last-command this-command)
(if (or (prog1 quit-flag (setq quit-flag nil))
(= last-input-char ?\C-g))
- (progn (setq unread-command-event nil)
+ (progn (setq unread-command-events nil)
(if (not inhibit-quit)
(progn (ding)
(message "Quit")
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 09f6ea3d687..aca4f015bb1 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -41,6 +41,7 @@
(defvar disassemble-recursive-indent 3 "*")
+;;;###autoload
(defun disassemble (object &optional buffer indent interactive-p)
"Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
@@ -136,7 +137,7 @@ redefine OBJECT if it is a symbol."
(insert "\n"))))
(cond ((and (consp obj) (assq 'byte-code obj))
(disassemble-1 (assq 'byte-code obj) indent))
- ((compiled-function-p obj)
+ ((byte-code-function-p obj)
(disassemble-1 obj indent))
(t
(insert "Uncompiled body: ")
@@ -195,14 +196,14 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
(setq arg (car arg))
;; but if the value of the constant is compiled code, then
;; recursively disassemble it.
- (cond ((or (compiled-function-p arg)
+ (cond ((or (byte-code-function-p arg)
(and (eq (car-safe arg) 'lambda)
(assq 'byte-code arg))
(and (eq (car-safe arg) 'macro)
- (or (compiled-function-p (cdr arg))
+ (or (byte-code-function-p (cdr arg))
(and (eq (car-safe (cdr arg)) 'lambda)
(assq 'byte-code (cdr arg))))))
- (cond ((compiled-function-p arg)
+ (cond ((byte-code-function-p arg)
(insert "<compiled-function>\n"))
((eq (car-safe arg) 'lambda)
(insert "<compiled lambda>"))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1f5f6dca46f..1003e15d4c7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1480,7 +1480,7 @@ Should be 0 at the top level.")
(last-command last-command)
(this-command this-command)
(last-input-char last-input-char)
- ;; Assume no edebug command sets unread-command-char.
+ ;; Assume no edebug command sets unread-command-events.
;; (unread-command-char -1)
(debug-on-error debug-on-error)
diff --git a/lisp/emerge.el b/lisp/emerge.el
index e70bf3969c6..2309c6db93a 100644
--- a/lisp/emerge.el
+++ b/lisp/emerge.el
@@ -2910,7 +2910,7 @@ SPC, it is ignored; if it is anything else, it is processed as a command."
(enlarge-window 1))
(let ((c (read-char)))
(if (/= c 32)
- (setq unread-command-event c))))))))
+ (setq unread-command-events (list c)))))))))
;; Improved auto-save file names.
;; This function fixes many problems with the standard auto-save file names:
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
index 9c57fdcec69..14da705e602 100644
--- a/lisp/emulation/vip.el
+++ b/lisp/emulation/vip.el
@@ -333,9 +333,9 @@ vi mode. ARG is used as the prefix value for the executed command. If
CHAR is given it becomes the first character of the command."
(interactive "P")
(let (com (buff (current-buffer)) (first t))
- (if char (setq unread-command-event char))
+ (if char (setq unread-command-events (list char)))
(setq prefix-arg arg)
- (while (or first unread-command-event)
+ (while (or first unread-command-events)
;; this while loop is executed until unread command char will be
;; exhausted.
(setq first nil)
@@ -393,7 +393,7 @@ obtained so far, and COM is the command part obtained so far."
(while (= char ?U)
(vip-describe-arg prefix-arg)
(setq char (read-char)))
- (setq unread-command-event char))
+ (setq unread-command-events (list char)))
(defun vip-prefix-arg-com (char value com)
"Vi operator as prefix argument."
@@ -447,7 +447,7 @@ obtained so far, and COM is the command part obtained so far."
(while (= char ?U)
(vip-describe-arg prefix-arg)
(setq char (read-char)))
- (setq unread-command-event char))
+ (setq unread-command-events (list char)))
;; as com is non-nil, this means that we have a command to execute
(if (or (= (car com) ?r) (= (car com) ?R))
;; execute apropriate region command.
diff --git a/lisp/frame.el b/lisp/frame.el
index 59f87e3f858..d8060baf9ea 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -113,7 +113,7 @@ These supercede the values given in default-frame-alist.")
;;; need to see if it should go away or change. Create a text frame
;;; here.
(defun frame-notice-user-settings ()
- (if (live-frame-p frame-initial-frame)
+ (if (frame-live-p frame-initial-frame)
(progn
;; If the user wants a minibuffer-only frame, we'll have to
;; make a new one; you can't remove or add a root window to/from
diff --git a/lisp/gnus.el b/lisp/gnus.el
index c472ed04216..4859096721f 100644
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2287,7 +2287,7 @@ If argument UNREAD is non-nil, only unread article is selected."
(let ((char (read-char)))
(if (= char cmd)
(gnus-Subject-next-group nil)
- (setq unread-command-event char))))
+ (setq unread-command-events (list char)))))
)
))
)))
diff --git a/lisp/help.el b/lisp/help.el
index f7cdbf35414..d968aedb7a7 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -293,7 +293,7 @@ C-w print information on absence of warranty for GNU Emacs."
(princ (cond ((stringp def) "a keyboard macro.")
((subrp def)
(concat beg "built-in function."))
- ((compiled-function-p def)
+ ((byte-code-function-p def)
(concat beg "compiled Lisp function."))
((symbolp def)
(format "alias for `%s'." def))
diff --git a/lisp/info.el b/lisp/info.el
index 4f463b1dd85..5ed08baab28 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -768,7 +768,7 @@ N is the digit argument used to invoke this command."
(message (if flag "Type Space to see more"
"Type Space to return to Info"))
(if (/= ?\ (setq ch (read-char)))
- (progn (setq unread-command-event ch) nil)
+ (progn (setq unread-command-events (list ch)) nil)
flag))
(scroll-up)))))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 2057e40c3f0..6a110214906 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -4,7 +4,7 @@
;; LCD Archive Entry:
;; isearch-mode|Daniel LaLiberte|liberte@cs.uiuc.edu
;; |A minor mode replacement for isearch.el.
-;; |$Date: 1992/11/07 06:17:04 $|$Revision: 1.15 $|~/modes/isearch-mode.el
+;; |$Date: 1992/11/16 01:37:06 $|$Revision: 1.16 $|~/modes/isearch-mode.el
;; This file is not yet part of GNU Emacs, but it is based almost
;; entirely on isearch.el which is part of GNU Emacs.
@@ -88,8 +88,15 @@
;;;====================================================================
;;; Change History
-;;; $Header: /home/gd/gnu/emacs/19.0/lisp/RCS/isearch-mode.el,v 1.15 1992/11/07 06:17:04 jimb Exp jimb $
+;;; $Header: /home/gd/gnu/emacs/19.0/lisp/RCS/isearch-mode.el,v 1.16 1992/11/16 01:37:06 jimb Exp jimb $
;;; $Log: isearch-mode.el,v $
+; Revision 1.16 1992/11/16 01:37:06 jimb
+; * bytecomp.el: Declare unread-command-char an obsolete variable.
+; * vip.el (vip-escape-to-emacs, vip-prefix-arg-value,
+; vip-prefix-arg-com): Use unread-command-event instead of
+; unread-command-char; respect its new semantics.
+; * isearch-mode.el (isearch-update, isearch-unread): Same.
+;
; Revision 1.15 1992/11/07 06:17:04 jimb
; * isearch.el (isearch-frames-exist): This isn't what we want -
; replaced by...
@@ -557,7 +564,7 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(if (if isearch-event-data-type
(null unread-command-event)
(if isearch-gnu-emacs-events
- (null unread-command-event)
+ (null unread-command-events)
(< unread-command-char 0)))
(progn
(if (not (input-pending-p))
@@ -1413,6 +1420,7 @@ have special meaning in a regexp."
;; To quiet the byte-compiler.
(defvar unread-command-event)
+(defvar unread-command-events)
(defvar last-command-event)
(defun isearch-char-to-string (c)
@@ -1429,7 +1437,7 @@ have special meaning in a regexp."
(isearch-event-data-type
(setq unread-command-event char-or-event))
(isearch-gnu-emacs-events
- (setq unread-command-event char-or-event))
+ (setq unread-command-events (list char-or-event)))
(t
(setq unread-command-char char-or-event))))
diff --git a/lisp/map-ynp.el b/lisp/map-ynp.el
index 37f9e702c86..ddc91d32776 100644
--- a/lisp/map-ynp.el
+++ b/lisp/map-ynp.el
@@ -100,7 +100,7 @@ the current %s and exit."
prompt char elt tail
(next (if (or (symbolp list)
(subrp list)
- (compiled-function-p list)
+ (byte-code-function-p list)
(and (consp list)
(eq (car list) 'lambda)))
(function (lambda ()
@@ -157,7 +157,7 @@ the current %s and exit."
(funcall actor elt)
(setq actions (1+ actions))))))
((= ?? char)
- (setq unread-command-event help-char)
+ (setq unread-command-events (list help-char))
(setq next (` (lambda ()
(setq next '(, next))
'(, elt)))))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 27db7536758..7994db2a92d 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,6 +1,6 @@
;;; mouse.el --- window system-independent mouse support.
-;;; Copyright (C) 1988, 1992 Free Software Foundation, Inc.
+;;; Copyright (C) 1988, 1992, 1993 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware
@@ -40,11 +40,12 @@ The `posn-' functions access elements of such lists."
(nth 1 event))
(defsubst event-end (event)
- "Return the ending location of EVENT. EVENT should be a drag event.
+ "Return the ending location of EVENT. EVENT should be a click or drag event.
+If EVENT is a click event, this function is the same as `event-start'.
The return value is of the form
(WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
The `posn-' functions access elements of such lists."
- (nth 2 event))
+ (nth (1- (length event)) event))
(defsubst posn-window (position)
"Return the window in POSITION.
@@ -113,7 +114,7 @@ This command must be bound to a mouse click."
The window is split at the column clicked on.
This command must be bound to a mouse click."
(interactive "@e")
- (split-window-horizontally (1+ (car (mouse-coords click)))))
+ (split-window-horizontally (1+ (car (posn-col-row (event-end click))))))
(defun mouse-set-point (click)
"Move point to the position clicked on with the mouse.
@@ -173,6 +174,14 @@ This does not delete the region; it acts like \\[kill-ring-save]."
(mouse-set-mark click)
(call-interactively 'kill-ring-save))
+;;; This function used to delete the text between point and the mouse
+;;; whenever it was equal to the front of the kill ring, but some
+;;; people found that confusing.
+
+;;; A list (TEXT START END), describing the text and position of the last
+;;; invocation of mouse-save-then-kill.
+(defvar mouse-save-then-kill-posn nil)
+
(defun mouse-save-then-kill (click)
"Save text to point in kill ring; the second time, kill the text.
If the text between point and the mouse is the same as what's
@@ -181,18 +190,24 @@ Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
which prepares for a second click to delete the text."
(interactive "e")
(let ((click-posn (posn-point (event-start click))))
- (if (string= (buffer-substring (point) click-posn) (car kill-ring))
- ;; If this text was already saved in kill ring,
- ;; now delete it from the buffer.
+ (if (and (eq last-command 'kill-region)
+ mouse-save-then-kill-posn
+ (eq (car mouse-save-then-kill-posn) (car kill-ring))
+ (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
+ ;; If this is the second time we've called
+ ;; mouse-save-then-kill, delete the text from the buffer.
(progn
(let ((buffer-undo-list t))
(delete-region (point) (mark)))
;; Make the undo list by hand so it is shared.
- (setq buffer-undo-list
- (cons (cons (car kill-ring) (point)) buffer-undo-list)))
+ (if (not (eq buffer-undo-list t))
+ (setq buffer-undo-list
+ (cons (cons (car kill-ring) (point)) buffer-undo-list))))
;; Otherwise, save this region.
(mouse-set-mark click)
- (call-interactively 'kill-ring-save))))
+ (call-interactively 'kill-ring-save)
+ (setq mouse-save-then-kill-posn
+ (list (car kill-ring) (point) click-posn)))))
(defun mouse-buffer-menu (event)
"Pop up a menu of buffers for selection with the mouse.
@@ -225,329 +240,331 @@ and selects that window."
(select-window window)
(switch-to-buffer buf))))))
-;; Commands for the scroll bar.
-
-(defun mouse-scroll-down (click)
- (interactive "@e")
- (scroll-down (1+ (cdr (mouse-coords click)))))
-
-(defun mouse-scroll-up (click)
- (interactive "@e")
- (scroll-up (1+ (cdr (mouse-coords click)))))
-
-(defun mouse-scroll-down-full ()
- (interactive "@")
- (scroll-down nil))
-
-(defun mouse-scroll-up-full ()
- (interactive "@")
- (scroll-up nil))
-
-(defun mouse-scroll-move-cursor (click)
- (interactive "@e")
- (move-to-window-line (1+ (cdr (mouse-coords click)))))
-
-(defun mouse-scroll-absolute (event)
- (interactive "@e")
- (let* ((pos (car event))
- (position (car pos))
- (length (car (cdr pos))))
- (if (<= length 0) (setq length 1))
- (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
- (newpos (* (/ (* (/ (buffer-size) scale-factor)
- position)
- length)
- scale-factor)))
- (goto-char newpos)
- (recenter '(4)))))
-
-(defun mouse-scroll-left (click)
- (interactive "@e")
- (scroll-left (1+ (car (mouse-coords click)))))
-
-(defun mouse-scroll-right (click)
- (interactive "@e")
- (scroll-right (1+ (car (mouse-coords click)))))
-
-(defun mouse-scroll-left-full ()
- (interactive "@")
- (scroll-left nil))
-
-(defun mouse-scroll-right-full ()
- (interactive "@")
- (scroll-right nil))
-
-(defun mouse-scroll-move-cursor-horizontally (click)
- (interactive "@e")
- (move-to-column (1+ (car (mouse-coords click)))))
-
-(defun mouse-scroll-absolute-horizontally (event)
- (interactive "@e")
- (let* ((pos (car event))
- (position (car pos))
- (length (car (cdr pos))))
- (set-window-hscroll (selected-window) 33)))
-
-(global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
-(global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
-(global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
-
-(global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
-(global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
-(global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
-
-(global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
-(global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
-(global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
-
-(global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
-(global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
-(global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
-
-(global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
-(global-set-key [horizontal-scroll-bar mouse-2]
- 'mouse-scroll-absolute-horizontally)
-(global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
-
-(global-set-key [horizontal-slider mouse-1]
- 'mouse-scroll-move-cursor-horizontally)
-(global-set-key [horizontal-slider mouse-2]
- 'mouse-scroll-move-cursor-horizontally)
-(global-set-key [horizontal-slider mouse-3]
- 'mouse-scroll-move-cursor-horizontally)
-
-(global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
-(global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
-(global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
-
-(global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
-(global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
-(global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
-
-(global-set-key [horizontal-scroll-bar S-mouse-2]
- 'mouse-split-window-horizontally)
-(global-set-key [mode-line S-mouse-2]
- 'mouse-split-window-horizontally)
-(global-set-key [vertical-scroll-bar S-mouse-2]
- 'mouse-split-window)
+;;; These need to be rewritten for the new scrollbar implementation.
+
+;;;!! ;; Commands for the scroll bar.
+;;;!!
+;;;!! (defun mouse-scroll-down (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-up (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-down-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-down nil))
+;;;!!
+;;;!! (defun mouse-scroll-up-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-up nil))
+;;;!!
+;;;!! (defun mouse-scroll-move-cursor (click)
+;;;!! (interactive "@e")
+;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-absolute (event)
+;;;!! (interactive "@e")
+;;;!! (let* ((pos (car event))
+;;;!! (position (car pos))
+;;;!! (length (car (cdr pos))))
+;;;!! (if (<= length 0) (setq length 1))
+;;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
+;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
+;;;!! position)
+;;;!! length)
+;;;!! scale-factor)))
+;;;!! (goto-char newpos)
+;;;!! (recenter '(4)))))
+;;;!!
+;;;!! (defun mouse-scroll-left (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-left (1+ (car (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-right (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-right (1+ (car (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-left-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-left nil))
+;;;!!
+;;;!! (defun mouse-scroll-right-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-right nil))
+;;;!!
+;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
+;;;!! (interactive "@e")
+;;;!! (move-to-column (1+ (car (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-absolute-horizontally (event)
+;;;!! (interactive "@e")
+;;;!! (let* ((pos (car event))
+;;;!! (position (car pos))
+;;;!! (length (car (cdr pos))))
+;;;!! (set-window-hscroll (selected-window) 33)))
+;;;!!
+;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
+;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
+;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
+;;;!!
+;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
+;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
+;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
+;;;!!
+;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
+;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
+;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
+;;;!!
+;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
+;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
+;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
+;;;!!
+;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
+;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
+;;;!! 'mouse-scroll-absolute-horizontally)
+;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
+;;;!!
+;;;!! (global-set-key [horizontal-slider mouse-1]
+;;;!! 'mouse-scroll-move-cursor-horizontally)
+;;;!! (global-set-key [horizontal-slider mouse-2]
+;;;!! 'mouse-scroll-move-cursor-horizontally)
+;;;!! (global-set-key [horizontal-slider mouse-3]
+;;;!! 'mouse-scroll-move-cursor-horizontally)
+;;;!!
+;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
+;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
+;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
+;;;!!
+;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
+;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
+;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
+;;;!!
+;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
+;;;!! 'mouse-split-window-horizontally)
+;;;!! (global-set-key [mode-line S-mouse-2]
+;;;!! 'mouse-split-window-horizontally)
+;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
+;;;!! 'mouse-split-window)
-;;;;
-;;;; Here are experimental things being tested. Mouse events
-;;;; are of the form:
-;;;; ((x y) window screen-part key-sequence timestamp)
-;;
-;;;;
-;;;; Dynamically track mouse coordinates
-;;;;
-;;
-;;(defun track-mouse (event)
-;; "Track the coordinates, absolute and relative, of the mouse."
-;; (interactive "@e")
-;; (while mouse-grabbed
-;; (let* ((pos (read-mouse-position (selected-screen)))
-;; (abs-x (car pos))
-;; (abs-y (cdr pos))
-;; (relative-coordinate (coordinates-in-window-p
-;; (list (car pos) (cdr pos))
-;; (selected-window))))
-;; (if (consp relative-coordinate)
-;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
-;; (car relative-coordinate)
-;; (car (cdr relative-coordinate)))
-;; (message "mouse: [%d %d]" abs-x abs-y)))))
-
-;;
-;; Dynamically put a box around the line indicated by point
-;;
-;;
-;;(require 'backquote)
-;;
-;;(defun mouse-select-buffer-line (event)
-;; (interactive "@e")
-;; (let ((relative-coordinate
-;; (coordinates-in-window-p (car event) (selected-window)))
-;; (abs-y (car (cdr (car event)))))
-;; (if (consp relative-coordinate)
-;; (progn
-;; (save-excursion
-;; (move-to-window-line (car (cdr relative-coordinate)))
-;; (x-draw-rectangle
-;; (selected-screen)
-;; abs-y 0
-;; (save-excursion
-;; (move-to-window-line (car (cdr relative-coordinate)))
-;; (end-of-line)
-;; (push-mark nil t)
-;; (beginning-of-line)
-;; (- (region-end) (region-beginning))) 1))
-;; (sit-for 1)
-;; (x-erase-rectangle (selected-screen))))))
-;;
-;;(defvar last-line-drawn nil)
-;;(defvar begin-delim "[^ \t]")
-;;(defvar end-delim "[^ \t]")
-;;
-;;(defun mouse-boxing (event)
-;; (interactive "@e")
-;; (save-excursion
-;; (let ((screen (selected-screen)))
-;; (while (= (x-mouse-events) 0)
-;; (let* ((pos (read-mouse-position screen))
-;; (abs-x (car pos))
-;; (abs-y (cdr pos))
-;; (relative-coordinate
-;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
-;; (selected-window)))
-;; (begin-reg nil)
-;; (end-reg nil)
-;; (end-column nil)
-;; (begin-column nil))
-;; (if (and (consp relative-coordinate)
-;; (or (not last-line-drawn)
-;; (not (= last-line-drawn abs-y))))
-;; (progn
-;; (move-to-window-line (car (cdr relative-coordinate)))
-;; (if (= (following-char) 10)
-;; ()
-;; (progn
-;; (setq begin-reg (1- (re-search-forward end-delim)))
-;; (setq begin-column (1- (current-column)))
-;; (end-of-line)
-;; (setq end-reg (1+ (re-search-backward begin-delim)))
-;; (setq end-column (1+ (current-column)))
-;; (message "%s" (buffer-substring begin-reg end-reg))
-;; (x-draw-rectangle screen
-;; (setq last-line-drawn abs-y)
-;; begin-column
-;; (- end-column begin-column) 1))))))))))
-;;
-;;(defun mouse-erase-box ()
-;; (interactive)
-;; (if last-line-drawn
-;; (progn
-;; (x-erase-rectangle (selected-screen))
-;; (setq last-line-drawn nil))))
-
-;;; (defun test-x-rectangle ()
-;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
-;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
-;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
-
-;;
-;; Here is how to do double clicking in lisp. About to change.
-;;
-
-(defvar double-start nil)
-(defconst double-click-interval 300
- "Max ticks between clicks")
-
-(defun double-down (event)
- (interactive "@e")
- (if double-start
- (let ((interval (- (nth 4 event) double-start)))
- (if (< interval double-click-interval)
- (progn
- (backward-up-list 1)
- ;; (message "Interval %d" interval)
- (sleep-for 1)))
- (setq double-start nil))
- (setq double-start (nth 4 event))))
-
-(defun double-up (event)
- (interactive "@e")
- (and double-start
- (> (- (nth 4 event ) double-start) double-click-interval)
- (setq double-start nil)))
-
-;;; (defun x-test-doubleclick ()
-;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
-;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
-;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
-
-;;
-;; This scrolls while button is depressed. Use preferable in scrollbar.
-;;
-
-(defvar scrolled-lines 0)
-(defconst scroll-speed 1)
-
-(defun incr-scroll-down (event)
- (interactive "@e")
- (setq scrolled-lines 0)
- (incremental-scroll scroll-speed))
-
-(defun incr-scroll-up (event)
- (interactive "@e")
- (setq scrolled-lines 0)
- (incremental-scroll (- scroll-speed)))
-
-(defun incremental-scroll (n)
- (while (= (x-mouse-events) 0)
- (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
- (scroll-down n)
- (sit-for 300 t)))
-
-(defun incr-scroll-stop (event)
- (interactive "@e")
- (message "Scrolled %d lines" scrolled-lines)
- (setq scrolled-lines 0)
- (sleep-for 1))
-
-;;; (defun x-testing-scroll ()
-;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
-;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
-;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
-;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
-;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
-
-;;
-;; Some playthings suitable for picture mode? They need work.
-;;
-
-(defun mouse-kill-rectangle (event)
- "Kill the rectangle between point and the mouse cursor."
- (interactive "@e")
- (let ((point-save (point)))
- (save-excursion
- (mouse-set-point event)
- (push-mark nil t)
- (if (> point-save (point))
- (kill-rectangle (point) point-save)
- (kill-rectangle point-save (point))))))
-
-(defun mouse-open-rectangle (event)
- "Kill the rectangle between point and the mouse cursor."
- (interactive "@e")
- (let ((point-save (point)))
- (save-excursion
- (mouse-set-point event)
- (push-mark nil t)
- (if (> point-save (point))
- (open-rectangle (point) point-save)
- (open-rectangle point-save (point))))))
-
-;; Must be a better way to do this.
-
-(defun mouse-multiple-insert (n char)
- (while (> n 0)
- (insert char)
- (setq n (1- n))))
-
-;; What this could do is not finalize until button was released.
-
-(defun mouse-move-text (event)
- "Move text from point to cursor position, inserting spaces."
- (interactive "@e")
- (let* ((relative-coordinate
- (coordinates-in-window-p (car event) (selected-window))))
- (if (consp relative-coordinate)
- (cond ((> (current-column) (car relative-coordinate))
- (delete-char
- (- (car relative-coordinate) (current-column))))
- ((< (current-column) (car relative-coordinate))
- (mouse-multiple-insert
- (- (car relative-coordinate) (current-column)) " "))
- ((= (current-column) (car relative-coordinate)) (ding))))))
+;;;!! ;;;;
+;;;!! ;;;; Here are experimental things being tested. Mouse events
+;;;!! ;;;; are of the form:
+;;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
+;;;!! ;;
+;;;!! ;;;;
+;;;!! ;;;; Dynamically track mouse coordinates
+;;;!! ;;;;
+;;;!! ;;
+;;;!! ;;(defun track-mouse (event)
+;;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
+;;;!! ;; (interactive "@e")
+;;;!! ;; (while mouse-grabbed
+;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
+;;;!! ;; (abs-x (car pos))
+;;;!! ;; (abs-y (cdr pos))
+;;;!! ;; (relative-coordinate (coordinates-in-window-p
+;;;!! ;; (list (car pos) (cdr pos))
+;;;!! ;; (selected-window))))
+;;;!! ;; (if (consp relative-coordinate)
+;;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
+;;;!! ;; (car relative-coordinate)
+;;;!! ;; (car (cdr relative-coordinate)))
+;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
+;;;!!
+;;;!! ;;
+;;;!! ;; Dynamically put a box around the line indicated by point
+;;;!! ;;
+;;;!! ;;
+;;;!! ;;(require 'backquote)
+;;;!! ;;
+;;;!! ;;(defun mouse-select-buffer-line (event)
+;;;!! ;; (interactive "@e")
+;;;!! ;; (let ((relative-coordinate
+;;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
+;;;!! ;; (abs-y (car (cdr (car event)))))
+;;;!! ;; (if (consp relative-coordinate)
+;;;!! ;; (progn
+;;;!! ;; (save-excursion
+;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
+;;;!! ;; (x-draw-rectangle
+;;;!! ;; (selected-screen)
+;;;!! ;; abs-y 0
+;;;!! ;; (save-excursion
+;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
+;;;!! ;; (end-of-line)
+;;;!! ;; (push-mark nil t)
+;;;!! ;; (beginning-of-line)
+;;;!! ;; (- (region-end) (region-beginning))) 1))
+;;;!! ;; (sit-for 1)
+;;;!! ;; (x-erase-rectangle (selected-screen))))))
+;;;!! ;;
+;;;!! ;;(defvar last-line-drawn nil)
+;;;!! ;;(defvar begin-delim "[^ \t]")
+;;;!! ;;(defvar end-delim "[^ \t]")
+;;;!! ;;
+;;;!! ;;(defun mouse-boxing (event)
+;;;!! ;; (interactive "@e")
+;;;!! ;; (save-excursion
+;;;!! ;; (let ((screen (selected-screen)))
+;;;!! ;; (while (= (x-mouse-events) 0)
+;;;!! ;; (let* ((pos (read-mouse-position screen))
+;;;!! ;; (abs-x (car pos))
+;;;!! ;; (abs-y (cdr pos))
+;;;!! ;; (relative-coordinate
+;;;!! ;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
+;;;!! ;; (selected-window)))
+;;;!! ;; (begin-reg nil)
+;;;!! ;; (end-reg nil)
+;;;!! ;; (end-column nil)
+;;;!! ;; (begin-column nil))
+;;;!! ;; (if (and (consp relative-coordinate)
+;;;!! ;; (or (not last-line-drawn)
+;;;!! ;; (not (= last-line-drawn abs-y))))
+;;;!! ;; (progn
+;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
+;;;!! ;; (if (= (following-char) 10)
+;;;!! ;; ()
+;;;!! ;; (progn
+;;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
+;;;!! ;; (setq begin-column (1- (current-column)))
+;;;!! ;; (end-of-line)
+;;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
+;;;!! ;; (setq end-column (1+ (current-column)))
+;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
+;;;!! ;; (x-draw-rectangle screen
+;;;!! ;; (setq last-line-drawn abs-y)
+;;;!! ;; begin-column
+;;;!! ;; (- end-column begin-column) 1))))))))))
+;;;!! ;;
+;;;!! ;;(defun mouse-erase-box ()
+;;;!! ;; (interactive)
+;;;!! ;; (if last-line-drawn
+;;;!! ;; (progn
+;;;!! ;; (x-erase-rectangle (selected-screen))
+;;;!! ;; (setq last-line-drawn nil))))
+;;;!!
+;;;!! ;;; (defun test-x-rectangle ()
+;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
+;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
+;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
+;;;!!
+;;;!! ;;
+;;;!! ;; Here is how to do double clicking in lisp. About to change.
+;;;!! ;;
+;;;!!
+;;;!! (defvar double-start nil)
+;;;!! (defconst double-click-interval 300
+;;;!! "Max ticks between clicks")
+;;;!!
+;;;!! (defun double-down (event)
+;;;!! (interactive "@e")
+;;;!! (if double-start
+;;;!! (let ((interval (- (nth 4 event) double-start)))
+;;;!! (if (< interval double-click-interval)
+;;;!! (progn
+;;;!! (backward-up-list 1)
+;;;!! ;; (message "Interval %d" interval)
+;;;!! (sleep-for 1)))
+;;;!! (setq double-start nil))
+;;;!! (setq double-start (nth 4 event))))
+;;;!!
+;;;!! (defun double-up (event)
+;;;!! (interactive "@e")
+;;;!! (and double-start
+;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
+;;;!! (setq double-start nil)))
+;;;!!
+;;;!! ;;; (defun x-test-doubleclick ()
+;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
+;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
+;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
+;;;!!
+;;;!! ;;
+;;;!! ;; This scrolls while button is depressed. Use preferable in scrollbar.
+;;;!! ;;
+;;;!!
+;;;!! (defvar scrolled-lines 0)
+;;;!! (defconst scroll-speed 1)
+;;;!!
+;;;!! (defun incr-scroll-down (event)
+;;;!! (interactive "@e")
+;;;!! (setq scrolled-lines 0)
+;;;!! (incremental-scroll scroll-speed))
+;;;!!
+;;;!! (defun incr-scroll-up (event)
+;;;!! (interactive "@e")
+;;;!! (setq scrolled-lines 0)
+;;;!! (incremental-scroll (- scroll-speed)))
+;;;!!
+;;;!! (defun incremental-scroll (n)
+;;;!! (while (= (x-mouse-events) 0)
+;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
+;;;!! (scroll-down n)
+;;;!! (sit-for 300 t)))
+;;;!!
+;;;!! (defun incr-scroll-stop (event)
+;;;!! (interactive "@e")
+;;;!! (message "Scrolled %d lines" scrolled-lines)
+;;;!! (setq scrolled-lines 0)
+;;;!! (sleep-for 1))
+;;;!!
+;;;!! ;;; (defun x-testing-scroll ()
+;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
+;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
+;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
+;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
+;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
+;;;!!
+;;;!! ;;
+;;;!! ;; Some playthings suitable for picture mode? They need work.
+;;;!! ;;
+;;;!!
+;;;!! (defun mouse-kill-rectangle (event)
+;;;!! "Kill the rectangle between point and the mouse cursor."
+;;;!! (interactive "@e")
+;;;!! (let ((point-save (point)))
+;;;!! (save-excursion
+;;;!! (mouse-set-point event)
+;;;!! (push-mark nil t)
+;;;!! (if (> point-save (point))
+;;;!! (kill-rectangle (point) point-save)
+;;;!! (kill-rectangle point-save (point))))))
+;;;!!
+;;;!! (defun mouse-open-rectangle (event)
+;;;!! "Kill the rectangle between point and the mouse cursor."
+;;;!! (interactive "@e")
+;;;!! (let ((point-save (point)))
+;;;!! (save-excursion
+;;;!! (mouse-set-point event)
+;;;!! (push-mark nil t)
+;;;!! (if (> point-save (point))
+;;;!! (open-rectangle (point) point-save)
+;;;!! (open-rectangle point-save (point))))))
+;;;!!
+;;;!! ;; Must be a better way to do this.
+;;;!!
+;;;!! (defun mouse-multiple-insert (n char)
+;;;!! (while (> n 0)
+;;;!! (insert char)
+;;;!! (setq n (1- n))))
+;;;!!
+;;;!! ;; What this could do is not finalize until button was released.
+;;;!!
+;;;!! (defun mouse-move-text (event)
+;;;!! "Move text from point to cursor position, inserting spaces."
+;;;!! (interactive "@e")
+;;;!! (let* ((relative-coordinate
+;;;!! (coordinates-in-window-p (car event) (selected-window))))
+;;;!! (if (consp relative-coordinate)
+;;;!! (cond ((> (current-column) (car relative-coordinate))
+;;;!! (delete-char
+;;;!! (- (car relative-coordinate) (current-column))))
+;;;!! ((< (current-column) (car relative-coordinate))
+;;;!! (mouse-multiple-insert
+;;;!! (- (car relative-coordinate) (current-column)) " "))
+;;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
;; Font selection.
@@ -604,44 +621,47 @@ and selects that window."
)
"X fonts suitable for use in Emacs.")
-(defun mouse-set-font (font)
+(defun mouse-set-font (&optional font)
"Select an emacs font from a list of known good fonts"
(interactive
(x-popup-menu last-nonmenu-event x-fixed-font-alist))
- (modify-frame-parameters (selected-frame)
- (list (cons 'font font))))
+ (if font
+ (modify-frame-parameters (selected-frame)
+ (list (cons 'font font)))))
;;; Bindings for mouse commands.
;; This won't be needed once the drag and down events
;; are properly implemented.
-(global-set-key [mouse-1] 'mouse-set-point)
-
-(global-set-key [drag-mouse-1] 'mouse-set-region)
-(global-set-key [mouse-2] 'mouse-yank-at-click)
-(global-set-key [mouse-3] 'mouse-save-then-kill)
+(global-set-key [mouse-1] 'mouse-set-point)
-(global-set-key [C-mouse-1] 'mouse-buffer-menu)
+(global-set-key [drag-mouse-1] 'mouse-set-region)
+(global-set-key [mouse-2] 'mouse-yank-at-click)
+(global-set-key [mouse-3] 'mouse-save-then-kill)
-(global-set-key [C-mouse-3] 'mouse-set-font)
+;; By binding these to down-going events, we let the user use the up-going
+;; event to make the selection, saving a click.
+(global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
+(global-set-key [C-down-mouse-3] 'mouse-set-font)
;; Replaced with dragging mouse-1
;; (global-set-key [S-mouse-1] 'mouse-set-mark)
-(global-set-key [mode-line mouse-1] 'mouse-delete-other-windows)
-(global-set-key [mode-line mouse-3] 'mouse-delete-window)
+(global-set-key [mode-line mouse-1] 'mouse-delete-other-windows)
+(global-set-key [mode-line mouse-3] 'mouse-delete-window)
+(global-set-key [mode-line S-mouse-2] 'mouse-split-window-horizontally)
;; Define the mouse help menu tree.
(defvar help-menu-map '(keymap "Help"))
-(global-set-key [C-mouse-2] help-menu-map)
-
-(defvar help-apropos-map '(keymap "Is there a command that..."))
-(defvar help-keys-map '(keymap "Key Commands <==> Functions"))
-(defvar help-manual-map '(keymap "Manual and tutorial"))
-(defvar help-misc-map '(keymap "Odds and ends"))
-(defvar help-modes-map '(keymap "Modes"))
-(defvar help-admin-map '(keymap "Administrivia"))
+(global-set-key [C-down-mouse-2] help-menu-map)
+
+(defvar help-apropos-map (make-sparse-keymap "Is there a command that..."))
+(defvar help-keys-map (make-sparse-keymap "Key Commands <==> Functions"))
+(defvar help-manual-map (make-sparse-keymap "Manual and tutorial"))
+(defvar help-misc-map (make-sparse-keymap "Odds and ends"))
+(defvar help-modes-map (make-sparse-keymap "Modes"))
+(defvar help-admin-map (make-sparse-keymap "Administrivia"))
(define-key help-menu-map [apropos]
(cons "@Is there a command that..." help-apropos-map))
diff --git a/lisp/progmodes/c-mode.el b/lisp/progmodes/c-mode.el
index 7bdfbdf8031..b39182f02af 100644
--- a/lisp/progmodes/c-mode.el
+++ b/lisp/progmodes/c-mode.el
@@ -322,11 +322,13 @@ preserving the comment indentation or line-starting decorations."
(paragraph-start
;; Lines containing just a comment start or just an end
;; should not be filled into paragraphs they are next to.
- (concat paragraph-start
- "\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[^ \t/*]"))
+ (concat
+ paragraph-start
+ "\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[ \t/*]*$"))
(paragraph-separate
- (concat paragraph-separate
- "\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[^ \t/*]"))
+ (concat
+ paragraph-separate
+ "\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[ \t/*]*$"))
(chars-to-delete 0))
(save-restriction
;; Don't fill the comment together with the code following it.
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 96addc99e42..5a0aa4511f8 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -39,7 +39,7 @@
;;; This file may be used with GNU Emacs version 18.xx if the following
;;; variable and function substutions are made.
;;; Replace:
-;;; unread-command-event with unread-command-char
+;;; unread-command-events with unread-command-char
;;; frame-width with screen-width
;;; auto-fill-function with auto-fill-hook
@@ -469,7 +469,7 @@ Any other key combination is executed normally."
(if (or (= (setq c (read-char)) ??) ;insert char if not equal to `?'
(= c help-char))
(fortran-abbrev-help)
- (setq unread-command-event c))))
+ (setq unread-command-events (list c)))))
(defun fortran-abbrev-help ()
"List the currently defined abbrevs in Fortran mode."
@@ -535,7 +535,7 @@ See also `fortran-window-create'."
(progn (message "Type SPC to continue editing.")
(let ((char (read-char)))
(or (equal char (string-to-char " "))
- (setq unread-command-event char))))))
+ (setq unread-command-events (list char)))))))
(fortran-window-create)))
(defun fortran-split-line ()
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index 4873ce1a1dc..7649c0ca048 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -401,7 +401,7 @@ The relative indentation among the lines of the statement are preserved."
(case-fold-search t)
;; don't mix a label with an assignment operator := :-
;; therefore look at next typed character...
- (next-char (setq unread-command-event (read-char)))
+ (next-char (setq unread-command-events (list (read-char))))
(com-char last-command-char))
(unwind-protect
;; Problem: find out if character just read is a command char
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index fbbc91a870d..e0d38e3d30c 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -21,6 +21,8 @@
;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+(require 'mouse)
+
;;;; Utilities.
@@ -43,7 +45,7 @@ that scrollbar position."
"Set the window start according to where the scrollbar is dragged.
EVENT should be a scrollbar click or drag event."
(interactive "e")
- (let* ((end-position (nth (1- (length event)) event))
+ (let* ((end-position (event-end event))
(window (nth 0 end-position))
(portion-whole (nth 2 end-position)))
(save-excursion
@@ -60,7 +62,7 @@ EVENT should be a scrollbar click."
(let ((old-selected-window (selected-window)))
(unwind-protect
(progn
- (let* ((end-position (nth (1- (length event)) event))
+ (let* ((end-position (event-end event))
(window (nth 0 end-position))
(portion-whole (nth 2 end-position)))
(select-window window)
@@ -75,7 +77,7 @@ EVENT should be a scrollbar click."
(let ((old-selected-window (selected-window)))
(unwind-protect
(progn
- (let* ((end-position (nth (1- (length event)) event))
+ (let* ((end-position (event-end event))
(window (nth 0 end-position))
(portion-whole (nth 2 end-position)))
(select-window window)
diff --git a/lisp/simple.el b/lisp/simple.el
index e0a027c660d..ee49c57900d 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -59,7 +59,10 @@ With arg N, insert N newlines."
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
-You may also type up to 3 octal digits, to insert a character with that code"
+You may also type up to 3 octal digits, to insert a character with that code.
+`quoted-insert' inserts the character even in overstrike mode; if you
+use overstrike as your normal editing mode, you can use this function
+to insert characters when necessary."
(interactive "*p")
(let ((char (read-quoted-char)))
(while (> arg 0)
@@ -789,13 +792,7 @@ Repeating \\[universal-argument] without digits or minus sign
(progn
(describe-arg value sign)
(setq key (read-key-sequence nil t))))
- (if (= (length key) 1)
- ;; Make sure self-insert-command finds the proper character;
- ;; unread the character and let the command loop process it.
- (setq unread-command-event (aref key 0))
- ;; We can't push back a longer string, so we'll emulate the
- ;; command loop ourselves.
- (command-execute (key-binding key)))))
+ (setq unread-command-events (append key '()))))
(defun describe-arg (value sign)
(cond ((numberp value)
diff --git a/lisp/subr.el b/lisp/subr.el
index 5ae06d130ef..23256306b89 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -65,7 +65,7 @@ Optional argument PROMPT specifies a string to use to prompt the user."
(and prompt (message (setq prompt
(format "%s %c" prompt char)))))
((> count 0)
- (setq unread-command-event char count 259))
+ (setq unread-command-events (list char) count 259))
(t (setq code char count 259))))
(logand 255 code)))
@@ -222,6 +222,7 @@ Accept any number of arguments, but ignore them."
(fset 'show-buffer 'set-window-buffer)
(fset 'buffer-flush-undo 'buffer-disable-undo)
(fset 'eval-current-buffer 'eval-buffer)
+(fset 'compiled-function-p 'byte-code-function-p)
; alternate names
(fset 'string= 'string-equal)
@@ -229,7 +230,6 @@ Accept any number of arguments, but ignore them."
(fset 'move-marker 'set-marker)
(fset 'eql 'eq)
(fset 'not 'null)
-(fset 'numberp 'integerp)
(fset 'rplaca 'setcar)
(fset 'rplacd 'setcdr)
(fset 'beep 'ding) ;preserve lingual purtity
@@ -325,7 +325,7 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
(single-key-description exit-char))
(let ((char (read-char)))
(or (eq char exit-char)
- (setq unread-command-event char))))
+ (setq unread-command-events (list char)))))
(if insert-end
(save-excursion
(delete-region pos insert-end)))
diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el
index 282225ea4e3..0ac9e46f4ea 100644
--- a/lisp/term/sun-mouse.el
+++ b/lisp/term/sun-mouse.el
@@ -318,12 +318,14 @@ but that uses minibuffer, and mucks up last-command."
(let ((pc1 (read-char)))
(if (or (not (equal pc1 mouse-prefix1))
(sit-for-millisecs 3)) ; a mouse prefix will have second char
- (progn (setq unread-command-event pc1) ; Can get away with one unread.
+ ;; Can get away with one unread.
+ (progn (setq unread-command-events (list pc1))
nil) ; Next input not mouse event.
(let ((pc2 (read-char)))
(if (not (equal pc2 mouse-prefix2))
- (progn (setq unread-command-event pc1) ; put back the ^X
+ (progn (setq unread-command-events (list pc1)) ; put back the ^X
;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2))
+;;; Well, now we can, but I don't understand this code well enough to fix it...
(ding) ; user will have to retype that pc2.
nil) ; This input is not a mouse event.
;; Next input has mouse prefix and is within time limit.
diff --git a/lisp/terminal.el b/lisp/terminal.el
index c1f30dda707..07e03ff9069 100644
--- a/lisp/terminal.el
+++ b/lisp/terminal.el
@@ -223,7 +223,7 @@ Other chars following \"%s\" are interpreted as follows:\n"
;; not used.
(defun te-escape-extended-command-unread ()
(interactive)
- (setq unread-command-event last-input-char)
+ (setq unread-command-events (list last-input-char))
(te-escape-extended-command))
(defun te-set-escape-char (c)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-23 21:07:34 +0000