From dbc4e1c12940079cad7b24e1654a0badcda8d6fc Mon Sep 17 00:00:00 2001 From: Jim Blandy Date: Tue, 26 Jan 1993 01:58:16 +0000 Subject: [PATCH] JimB's changes since January 18th --- Makefile.in | 26 +- lisp/comint.el | 2 +- lisp/ebuff-menu.el | 6 +- lisp/ehelp.el | 4 +- lisp/electric.el | 4 +- lisp/emacs-lisp/disass.el | 9 +- lisp/emacs-lisp/edebug.el | 2 +- lisp/emerge.el | 2 +- lisp/emulation/vip.el | 8 +- lisp/frame.el | 2 +- lisp/gnus.el | 2 +- lisp/help.el | 2 +- lisp/info.el | 2 +- lisp/isearch.el | 16 +- lisp/map-ynp.el | 4 +- lisp/mouse.el | 720 ++++++++++++++++++++------------------ lisp/progmodes/c-mode.el | 10 +- lisp/progmodes/fortran.el | 6 +- lisp/progmodes/simula.el | 2 +- lisp/scroll-bar.el | 8 +- lisp/simple.el | 13 +- lisp/subr.el | 6 +- lisp/term/sun-mouse.el | 6 +- lisp/terminal.el | 2 +- src/Makefile.in | 13 +- src/buffer.c | 15 +- src/buffer.h | 3 +- src/callint.c | 43 ++- src/commands.h | 6 +- src/data.c | 20 +- src/dispnew.c | 17 +- src/emacs.c | 4 +- src/fns.c | 9 +- src/frame.c | 84 ++++- src/frame.h | 4 +- src/insdel.c | 8 +- src/keyboard.c | 136 ++++--- src/keyboard.h | 3 +- src/keymap.c | 10 +- src/lread.c | 12 +- src/minibuf.c | 4 +- src/term.c | 12 + src/termhooks.h | 11 + src/window.c | 48 ++- src/xfns.c | 86 +++-- src/xmenu.c | 2 +- src/xselect.c.old | 128 +++---- src/xterm.c | 435 ++++++++++++++--------- src/xterm.h | 19 +- 49 files changed, 1120 insertions(+), 876 deletions(-) diff --git a/Makefile.in b/Makefile.in index 7fb652284d1..c28918af947 100644 --- a/Makefile.in +++ b/Makefile.in @@ -231,7 +231,6 @@ lib-src/Makefile: ${srcdir}/lib-src/Makefile.in Makefile -e 's|^LOADLIBES *=.*$$|LOADLIBES='"${libsrc_libs}"'|' \ -e '/^# DIST: /d') > lib-src/Makefile.tmp ${srcdir}/move-if-change lib-src/Makefile.tmp lib-src/Makefile - # Remind people not to edit this. chmod -w lib-src/Makefile src/Makefile: ${srcdir}/src/Makefile.in Makefile @@ -248,7 +247,6 @@ src/Makefile: ${srcdir}/src/Makefile.in Makefile -e 's|^CONFIG_CFLAGS *=.*$$|CONFIG_CFLAGS='"${CONFIG_CFLAGS}"'|' \ -e '/^# DIST: /d') > src/Makefile.tmp ${srcdir}/move-if-change src/Makefile.tmp src/Makefile - # Remind people not to edit this. chmod -w src/Makefile oldXMenu/Makefile: ${srcdir}/oldXMenu/Makefile Makefile @@ -262,10 +260,10 @@ Makefile: # ==================== Installation ==================== +## If we let lib-src do its own installation, that means we +## don't have to duplicate the list of utilities to install in +## this Makefile as well. install: all mkdir - ## If we let lib-src do its own installation, that means we - ## don't have to duplicate the list of utilities to install in - ## this Makefile as well. (cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir}) -set ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ @@ -297,10 +295,10 @@ install: all mkdir -rm -f ${bindir}/emacs ln ${bindir}/emacs-${version} ${bindir}/emacs +## If we let lib-src do its own installation, that means we +## don't have to duplicate the list of utilities to install in +## this Makefile as well. install.sysv: all mkdir - ## If we let lib-src do its own installation, that means we - ## don't have to duplicate the list of utilities to install in - ## this Makefile as well. (cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir}) -set ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ @@ -330,10 +328,10 @@ install.sysv: all mkdir -cpset src/emacs ${bindir}/emacs-${version} 1755 bin bin -ln ${bindir}/emacs-${version} ${bindir}/emacs +## If we let lib-src do its own installation, that means we +## don't have to duplicate the list of utilities to install in +## this Makefile as well. install.xenix: all mkdir - ## If we let lib-src do its own installation, that means we - ## don't have to duplicate the list of utilities to install in - ## this Makefile as well. (cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir}) -set ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ @@ -368,10 +366,10 @@ install.xenix: all mkdir chmod 1755 ${bindir}/emacs -rm -f ${bindir}/emacs.old +## If we let lib-src do its own installation, that means we +## don't have to duplicate the list of utilities to install in +## this Makefile as well. install.aix: all mkdir - ## If we let lib-src do its own installation, that means we - ## don't have to duplicate the list of utilities to install in - ## this Makefile as well. (cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir}) -set ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ 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 "\n")) ((eq (car-safe arg) 'lambda) (insert "")) 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. +;;; These need to be rewritten for the new scrollbar implementation. -(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) +;;;!! ;; 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 [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 [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-1] 'mouse-buffer-menu) - -(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) +(global-set-key [C-down-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")) +(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) diff --git a/src/Makefile.in b/src/Makefile.in index 468e312abd6..5e19aa0248e 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -47,14 +47,17 @@ temacs: dotemacs dotemacs: xmakefile $(MAKE) CC='${CC}' -f xmakefile ${MFLAGS} temacs -# If you have a problem with cc -E here, changing -# the definition of CPP above may fix it. +### Some makes, like Ultrix's make, complain if you put a comment in +### the middle of a rule's command list! Dummies. + +### The flags for optimization and debugging depend on the +### system, so take an ordinary CFLAGS value and choose the +### appropriate CPP symbols to use in ymakefile. +### If you have a problem with cc -E here, changing +### the definition of CPP above may fix it. xmakefile: ymakefile config.h -rm -f xmakefile xmakefile.new junk.c junk.cpp cp ymakefile junk.c - ## The flags for optimization and debugging depend on the - ## system, so take an ordinary CFLAGS value and choose the - ## appropriate CPP symbols to use in ymakefile. $(CPP) junk.c > junk.cpp \ -DC_SWITCH_SITE="`echo ${CFLAGS}' ' \ | sed -e 's/-g /C_DEBUG_SWITCH /' \ diff --git a/src/buffer.c b/src/buffer.c index 4a78b568176..4057fffbf7d 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -112,8 +112,9 @@ Lisp_Object Vbuffer_alist; Lisp_Object Vbefore_change_function; Lisp_Object Vafter_change_function; -/* Function to call before changing an unmodified buffer. */ -Lisp_Object Vfirst_change_function; +/* List of functions to call before changing an unmodified buffer. */ +Lisp_Object Vfirst_change_hook; +Lisp_Object Qfirst_change_hook; Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local; @@ -1655,10 +1656,12 @@ While executing the `after-change-function', changes to buffers do not\n\ cause calls to any `before-change-function' or `after-change-function'."); Vafter_change_function = Qnil; - DEFVAR_LISP ("first-change-function", &Vfirst_change_function, - "Function to call before changing a buffer which is unmodified.\n\ -The function is called, with no arguments, if it is non-nil."); - Vfirst_change_function = Qnil; + DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook, + "A list of functions to call before changing a buffer which is unmodified.\n\ +The functions are run using the `run-hooks' function."); + Vfirst_change_hook = Qnil; + Qfirst_change_hook = intern ("first-change-hook"); + staticpro (&Qfirst_change_hook); DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer->undo_list, Qnil, "List of undo entries in current buffer.\n\ diff --git a/src/buffer.h b/src/buffer.h index 6e3f7a8ee23..77784d27da0 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -340,7 +340,8 @@ extern void reset_buffer (); /* Functions to call before and after each text change. */ extern Lisp_Object Vbefore_change_function; extern Lisp_Object Vafter_change_function; -extern Lisp_Object Vfirst_change_function; +extern Lisp_Object Vfirst_change_hook; +extern Lisp_Object Qfirst_change_hook; /* Fields. diff --git a/src/callint.c b/src/callint.c index 53cad4a4a78..ffa2fa39539 100644 --- a/src/callint.c +++ b/src/callint.c @@ -1,11 +1,11 @@ /* Call a Lisp function interactively. - Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -89,10 +89,11 @@ X -- Lisp expression read and evaluated.\n\ In addition, if the string begins with `*'\n\ then an error is signaled if the buffer is read-only.\n\ This happens before reading any arguments.\n\ -If the string begins with `@', then the window the mouse is over is selected\n\ - before anything else is done. You may use both `@' and `*';\n\ -they are processed in the order that they appear." -*/ +If the string begins with `@', then Emacs searches the key sequence\n\ + which invoked the command for its first mouse click (or any other\n\ + event which specifies a window), and selects that window before\n\ + reading any arguments. You may use both `@' and `*'; they are\n\ + processed in the order that they appear." */ /* ARGSUSED */ DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, @@ -167,7 +168,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.") /* The index of the next element of this_command_keys to examine for the 'e' interactive code. */ - int next_event = 0; + int next_event; Lisp_Object prefix_arg; unsigned char *string; @@ -296,6 +297,12 @@ Otherwise, this is done only if an arg is read using the minibuffer.") /* Here if function specifies a string to control parsing the defaults */ + /* Set next_event to point to the first event with parameters. */ + for (next_event = 0; next_event < this_command_key_count; next_event++) + if (EVENT_HAS_PARAMETERS + (XVECTOR (this_command_keys)->contents[next_event])) + break; + /* Handle special starting chars `*' and `@'. */ while (1) { @@ -307,9 +314,15 @@ Otherwise, this is done only if an arg is read using the minibuffer.") } else if (*string == '@') { + Lisp_Object event = + XVECTOR (this_command_keys)->contents[next_event]; + + if (EVENT_HAS_PARAMETERS (event) + && XTYPE (event = XCONS (event)->cdr) == Lisp_Cons + && XTYPE (event = XCONS (event)->car) == Lisp_Cons + && XTYPE (event = XCONS (event)->car) == Lisp_Window) + Fselect_window (event); string++; - if (!NILP (Vmouse_window)) - Fselect_window (Vmouse_window); } else break; } @@ -433,11 +446,6 @@ Otherwise, this is done only if an arg is read using the minibuffer.") break; case 'e': /* The invoking event. */ - /* Find the next parameterized event. */ - while (next_event < this_command_key_count - && ! (EVENT_HAS_PARAMETERS - (XVECTOR (this_command_keys)->contents[next_event]))) - next_event++; if (next_event >= this_command_key_count) error ("%s must be bound to an event with parameters", (XTYPE (function) == Lisp_Symbol @@ -445,6 +453,13 @@ Otherwise, this is done only if an arg is read using the minibuffer.") : "command")); args[i] = XVECTOR (this_command_keys)->contents[next_event++]; varies[i] = -1; + + /* Find the next parameterized event. */ + while (next_event < this_command_key_count + && ! (EVENT_HAS_PARAMETERS + (XVECTOR (this_command_keys)->contents[next_event]))) + next_event++; + break; case 'm': /* Value of mark. Does not do I/O. */ diff --git a/src/commands.h b/src/commands.h index 4e3d67d166e..4abdcac56f1 100644 --- a/src/commands.h +++ b/src/commands.h @@ -49,12 +49,12 @@ extern Lisp_Object last_command_char; reached by the mouse. */ extern Lisp_Object last_nonmenu_event; -/* Command event to be re-read, or Qnil. */ -extern Lisp_Object unread_command_event; +/* List of command events to be re-read, or Qnil. */ +extern Lisp_Object unread_command_events; /* If not Qnil, this is a switch-frame event which we decided to put off until the end of a key sequence. This should be read as the - next command input, after any unread_command_event. + next command input, after any unread_command_events. read_key_sequence uses this to delay switch-frame events until the end of the key sequence; Fread_char uses it to put off switch-frame diff --git a/src/data.c b/src/data.c index 3a19314873c..071cfe853b7 100644 --- a/src/data.c +++ b/src/data.c @@ -256,8 +256,8 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.") return Qnil; } -DEFUN ("compiled-function-p", Fcompiled_function_p, Scompiled_function_p, - 1, 1, 0, "T if OBJECT is a compiled function object.") +DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, + 1, 1, 0, "T if OBJECT is a byte-compiled function object.") (obj) Lisp_Object obj; { @@ -308,13 +308,10 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, (obj) Lisp_Object obj; { - if (0 -#ifdef LISP_FLOAT_TYPE - || XTYPE (obj) == Lisp_Float -#endif - || XTYPE (obj) == Lisp_Int) + if (NUMBERP (obj)) return Qt; - return Qnil; + else + return Qnil; } DEFUN ("number-or-marker-p", Fnumber_or_marker_p, @@ -323,10 +320,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, (obj) Lisp_Object obj; { - if (XTYPE (obj) == Lisp_Int -#ifdef LISP_FLOAT_TYPE - || XTYPE (obj) == Lisp_Float -#endif + if (NUMBERP (obj) || XTYPE (obj) == Lisp_Marker) return Qt; return Qnil; @@ -2037,7 +2031,7 @@ syms_of_data () defsubr (&Sbufferp); defsubr (&Smarkerp); defsubr (&Ssubrp); - defsubr (&Scompiled_function_p); + defsubr (&Sbyte_code_function_p); defsubr (&Schar_or_string_p); defsubr (&Scar); defsubr (&Scdr); diff --git a/src/dispnew.c b/src/dispnew.c index edcb7223f0b..5570129c389 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -173,7 +173,22 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; - if (FRAME_VISIBLE_P (XFRAME (frame))) + + /* If we simply redrew all visible frames, whether or not they + were garbaged, then this would make all frames clear and + redraw whenever a new frame is created or an existing frame + is de-iconified; those events set the global frame_garbaged + flag, to which redisplay responds by calling this function. + + This used to redraw all visible frames; the only advantage of + that approach is that if a frame changes from invisible to + visible without setting its garbaged flag, it still gets + redisplayed. But that should never happen; since invisible + frames are not updated, they should always be marked as + garbaged when they become visible again. If that doesn't + happen, it's a bug in the visibility code, not a bug here. */ + if (FRAME_VISIBLE_P (XFRAME (frame)) + && FRAME_GARBAGED_P (XFRAME (frame))) Fredraw_frame (frame); } return Qnil; diff --git a/src/emacs.c b/src/emacs.c index da5916990d5..9209e4f7d6b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -519,10 +519,8 @@ main (argc, argv, envp) #ifdef HAVE_X11 syms_of_xselect (); #endif -#ifdef HAVE_X_WINDOWS -#ifndef NO_X_MENU +#ifdef HAVE_X_MENU syms_of_xmenu (); -#endif /* not NO_X_MENU */ #endif /* HAVE_X_MENU */ #endif /* HAVE_X_WINDOWS */ diff --git a/src/fns.c b/src/fns.c index 144d6ef345e..9f818e886f2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -836,8 +836,12 @@ internal_equal (o1, o2, depth) error ("Stack overflow in equal"); do_cdr: QUIT; + if (EQ (o1, o2)) return Qt; + if (NUMBERP (o1) && NUMBERP (o2)) + { + return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil; + } if (XTYPE (o1) != XTYPE (o2)) return Qnil; - if (XINT (o1) == XINT (o2)) return Qt; if (XTYPE (o1) == Lisp_Cons) { Lisp_Object v1; @@ -853,7 +857,8 @@ internal_equal (o1, o2, depth) && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos) ? Qt : Qnil; } - if (XTYPE (o1) == Lisp_Vector) + if (XTYPE (o1) == Lisp_Vector + || XTYPE (o1) == Lisp_Compiled) { register int index; if (XVECTOR (o1)->size != XVECTOR (o2)->size) diff --git a/src/frame.c b/src/frame.c index 7184c20b797..ca48c73105f 100644 --- a/src/frame.c +++ b/src/frame.c @@ -74,7 +74,7 @@ Lisp_Object Vdefault_frame_alist; /*&&& symbols declared here &&&*/ Lisp_Object Qframep; -Lisp_Object Qlive_frame_p; +Lisp_Object Qframe_live_p; Lisp_Object Qheight; Lisp_Object Qicon; Lisp_Object Qminibuffer; @@ -110,7 +110,7 @@ Also see `live-frame-p'.") } } -DEFUN ("live-frame-p", Flive_frame_p, Slive_frame_p, 1, 1, 0, +DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0, "Return non-nil if OBJECT is a frame which has not been deleted.\n\ Value is nil if OBJECT is not a live frame. If object is a live\n\ frame, the return value indicates what sort of output device it is\n\ @@ -381,14 +381,13 @@ Changing the selected frame can change focus redirections. See\n\ Fselect_window (XFRAME (frame)->selected_window); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS -#ifdef MULTI_FRAME if (FRAME_X_P (XFRAME (frame)) && NILP (no_enter)) { Ffocus_frame (frame); } -#endif #endif choose_minibuf_frame (); @@ -450,8 +449,6 @@ DEFUN ("frame-list", Fframe_list, Sframe_list, return Fcopy_sequence (Vframe_list); } -#ifdef MULTI_FRAME - /* Return the next frame in the frame list after FRAME. If MINIBUF is nil, exclude minibuffer-only frames. If MINIBUF is a window, include only frames using that window for @@ -469,6 +466,10 @@ next_frame (frame, minibuf) if (! CONSP (Vframe_list)) abort (); + /* If this frame is dead, it won't be in Vframe_list, and we'll loop + forever. Forestall that. */ + CHECK_LIVE_FRAME (frame, 0); + while (1) for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { @@ -503,9 +504,6 @@ next_frame (frame, minibuf) } } -#if 0 -/* Nobody seems to be using this code right now. */ - /* Return the previous frame in the frame list before FRAME. If MINIBUF is nil, exclude minibuffer-only frames. If MINIBUF is a window, include only frames using that window for @@ -561,7 +559,6 @@ prev_frame (frame, minibuf) acceptable frame in the list, return it. */ return prev; } -#endif DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0, "Return the next frame in the frame list after FRAME.\n\ @@ -583,7 +580,7 @@ If MINIFRAME is non-nil and not a window, include all frames.") return next_frame (frame, miniframe); } -#endif /* MULTI_FRAME */ + DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 1, "", "Delete FRAME, permanently eliminating it from use.\n\ @@ -659,6 +656,8 @@ A frame may not be deleted if its minibuffer is used by other frames.") now, then we may trip up the event-handling code. Instead, we'll promise that the display of the frame must be valid until we have called the window-system-dependent frame destruction routine. */ + + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) x_destroy_window (f); @@ -739,19 +738,25 @@ to read the mouse position, it returns the selected frame for FRAME\n\ and nil for X and Y.") () { - Lisp_Object x, y, dummy; FRAME_PTR f; + Lisp_Object lispy_dummy; + enum scrollbar_part party_dummy; + Lisp_Object x, y; + unsigned long long_dummy; if (mouse_position_hook) - (*mouse_position_hook) (&f, &x, &y, &dummy); + (*mouse_position_hook) (&f, + &lispy_dummy, &party_dummy, + &x, &y, + &long_dummy); else { f = selected_frame; x = y = Qnil; } - XSET (dummy, Lisp_Frame, f); - return Fcons (dummy, Fcons (make_number (x), make_number (y))); + XSET (lispy_dummy, Lisp_Frame, f); + return Fcons (lispy_dummy, Fcons (make_number (x), make_number (y))); } DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0, @@ -764,6 +769,7 @@ WARNING: If you use this under X, you should do `unfocus-frame' afterwards.") CHECK_NUMBER (x, 2); CHECK_NUMBER (y, 1); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ @@ -842,6 +848,7 @@ If omitted, FRAME defaults to the currently selected frame.") CHECK_LIVE_FRAME (frame, 0); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) x_make_frame_visible (XFRAME (frame)); @@ -862,6 +869,7 @@ If omitted, FRAME defaults to the currently selected frame.") CHECK_LIVE_FRAME (frame, 0); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) x_make_frame_invisible (XFRAME (frame)); @@ -882,6 +890,7 @@ If omitted, FRAME defaults to the currently selected frame.") CHECK_LIVE_FRAME (frame, 0); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) x_iconify_frame (XFRAME (frame)); @@ -931,6 +940,37 @@ DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list, } +DEFUN ("frame-to-front", Fframe_to_front, Sframe_to_front, 1, 1, 0, + "Bring FRAME to the front, so it occludes any frames it overlaps.\n\ +If FRAME is invisible, make it visible.\n\ +If Emacs is displaying on an ordinary terminal or some other device which\n\ +doesn't support multiple overlapping frames, this function does nothing.") + (frame) + Lisp_Object frame; +{ + CHECK_LIVE_FRAME (frame, 0); + + if (frame_raise_lower_hook) + (*frame_raise_lower_hook) (XFRAME (frame), 1); + + return Qnil; +} + +DEFUN ("frame-to-back", Fframe_to_back, Sframe_to_back, 1, 1, 0, + "Send FRAME to the back, so it is occluded by any frames that overlap it.\n\ +If Emacs is displaying on an ordinary terminal or some other device which\n\ +doesn't support multiple overlapping frames, this function does nothing.") + (frame) + Lisp_Object frame; +{ + CHECK_LIVE_FRAME (frame, 0); + + if (frame_raise_lower_hook) + (*frame_raise_lower_hook) (XFRAME (frame), 0); + + return Qnil; +} + DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus, 1, 2, 0, @@ -1075,6 +1115,7 @@ If FRAME is omitted, return information on the currently selected frame.") : FRAME_MINIBUF_WINDOW (f)))); store_in_alist (&alist, Qunsplittable, (f->no_split ? Qt : Qnil)); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) x_report_frame_params (f, &alist); @@ -1102,6 +1143,7 @@ The meaningful PARMs depend on the kind of frame; undefined PARMs are ignored.") f = XFRAME (frame); } + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) #if 1 @@ -1180,6 +1222,7 @@ but that the idea of the actual height of the frame should not be changed.") f = XFRAME (frame); } + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) { @@ -1209,6 +1252,7 @@ but that the idea of the actual width of the frame should not be changed.") f = XFRAME (frame); } + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) { @@ -1234,6 +1278,7 @@ DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0, CHECK_NUMBER (rows, 1); f = XFRAME (frame); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) { @@ -1264,6 +1309,7 @@ off the screen.") CHECK_NUMBER (yoffset, 2); f = XFRAME (frame); + /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) x_set_offset (f, XINT (xoffset), XINT (yoffset)); @@ -1338,8 +1384,8 @@ syms_of_frame () /*&&& init symbols here &&&*/ Qframep = intern ("framep"); staticpro (&Qframep); - Qlive_frame_p = intern ("live-frame-p"); - staticpro (&Qlive_frame_p); + Qframe_live_p = intern ("frame-live-p"); + staticpro (&Qframe_live_p); Qheight = intern ("height"); staticpro (&Qheight); Qicon = intern ("icon"); @@ -1396,7 +1442,7 @@ For values specific to the separate minibuffer frame, see\n\ Vdefault_frame_alist = Qnil; defsubr (&Sframep); - defsubr (&Slive_frame_p); + defsubr (&Sframe_live_p); defsubr (&Sselect_frame); defsubr (&Sselected_frame); defsubr (&Swindow_frame); @@ -1416,6 +1462,8 @@ For values specific to the separate minibuffer frame, see\n\ defsubr (&Siconify_frame); defsubr (&Sframe_visible_p); defsubr (&Svisible_frame_list); + defsubr (&Sframe_to_front); + defsubr (&Sframe_to_back); defsubr (&Sredirect_frame_focus); defsubr (&Sframe_focus); defsubr (&Sframe_parameters); diff --git a/src/frame.h b/src/frame.h index 5a3f45a080d..194b62147da 100644 --- a/src/frame.h +++ b/src/frame.h @@ -306,7 +306,7 @@ typedef struct frame *FRAME_PTR; { \ if (! FRAMEP (x) \ || ! FRAME_LIVE_P (XFRAME (x))) \ - x = wrong_type_argument (Qlive_frame_p, (x)); \ + x = wrong_type_argument (Qframe_live_p, (x)); \ } /* FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a @@ -325,7 +325,7 @@ typedef struct frame *FRAME_PTR; list_var = XCONS (list_var)->cdr) -extern Lisp_Object Qframep, Qlive_frame_p; +extern Lisp_Object Qframep, Qframe_live_p; extern struct frame *selected_frame; extern struct frame *last_nonminibuf_frame; diff --git a/src/insdel.c b/src/insdel.c index 256102dfe9d..7f25a967d46 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -545,10 +545,10 @@ signal_before_change (start, end) { /* If buffer is unmodified, run a special hook for that case. */ if (current_buffer->save_modified >= MODIFF - && !NILP (Vfirst_change_function)) - { - call0 (Vfirst_change_function); - } + && !NILP (Vfirst_change_hook) + && !NILP (Vrun_hooks)) + call1 (Vrun_hooks, Qfirst_change_hook); + /* Now in any case run the before-change-function if any. */ if (!NILP (Vbefore_change_function)) { diff --git a/src/keyboard.c b/src/keyboard.c index 3c139c68644..6585c29a914 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -152,12 +152,12 @@ Lisp_Object last_nonmenu_event; /* Last input character read for any purpose. */ Lisp_Object last_input_char; -/* If not Qnil, an object to be read as the next command input. */ -Lisp_Object unread_command_event; +/* If not Qnil, a list of objects to be read as subsequent command input. */ +Lisp_Object unread_command_events; /* If not Qnil, this is a switch-frame event which we decided to put off until the end of a key sequence. This should be read as the - next command input, after any unread_command_event. + next command input, after any unread_command_events. read_key_sequence uses this to delay switch-frame events until the end of the key sequence; Fread_char uses it to put off switch-frame @@ -867,7 +867,7 @@ command_loop_1 () if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; - unread_command_event = make_number (quit_char); + unread_command_events = Fcons (make_number (quit_char), Qnil); } } @@ -1145,10 +1145,10 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) int count; jmp_buf save_jump; - if (!NILP (unread_command_event)) + if (CONSP (unread_command_events)) { - c = unread_command_event; - unread_command_event = Qnil; + c = XCONS (unread_command_events)->car; + unread_command_events = XCONS (unread_command_events)->cdr; if (this_command_key_count == 0) goto reread_first; @@ -1229,7 +1229,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* After a mouse event, start echoing right away. This is because we are probably about to display a menu, and we don't want to delay before doing so. */ - if (XTYPE (prev_event) == Lisp_Cons) + if (EVENT_HAS_PARAMETERS (prev_event)) echo (); else { @@ -1880,7 +1880,8 @@ make_lispy_event (event) { int button = XFASTINT (event->code); Lisp_Object position; - Lisp_Object *start_pos; + Lisp_Object *start_pos_ptr; + Lisp_Object start_pos; if (button < 0 || button >= NUM_MOUSE_BUTTONS) abort (); @@ -1899,21 +1900,20 @@ make_lispy_event (event) posn = Qnil; else { + XSETINT (event->x, + (XINT (event->x) - XINT (XWINDOW (window)->left))); + XSETINT (event->y, + (XINT (event->y) - XINT (XWINDOW (window)->top))); + if (part == 1) posn = Qmode_line; else if (part == 2) posn = Qvertical_line; else - { - XSETINT (event->x, (XINT (event->x) - - XINT (XWINDOW (window)->left))); - XSETINT (event->y, (XINT (event->y) - - XINT (XWINDOW (window)->top))); - XSET (posn, Lisp_Int, - buffer_posn_from_coords (XWINDOW (window), - XINT (event->x), - XINT (event->y))); - } + XSET (posn, Lisp_Int, + buffer_posn_from_coords (XWINDOW (window), + XINT (event->x), + XINT (event->y))); } position = @@ -1938,29 +1938,43 @@ make_lispy_event (event) Qnil))))); } - start_pos = &XVECTOR (button_down_location)->contents[button]; + start_pos_ptr = &XVECTOR (button_down_location)->contents[button]; + + start_pos = *start_pos_ptr; + *start_pos_ptr = Qnil; /* If this is a button press, squirrel away the location, so we can decide later whether it was a click or a drag. */ if (event->modifiers & down_modifier) - *start_pos = Fcopy_alist (position); + *start_pos_ptr = Fcopy_alist (position); /* Now we're releasing a button - check the co-ordinates to see if this was a click or a drag. */ else if (event->modifiers & up_modifier) { - Lisp_Object down = Fnth (make_number (2), *start_pos); - - /* The third element of every position should be the (x,y) - pair. */ - if (! CONSP (down)) - abort (); + /* Is there a start position stored at all for this + button? + It would be nice if we could assume that if we're + getting a button release, we must therefore have gotten + a button press. Unfortunately, the X menu code thwarts + this assumption, so we'll have to be more robust. We + treat a button release with no stored start position as + a click. */ event->modifiers &= ~up_modifier; - event->modifiers |= ((EQ (event->x, XCONS (down)->car) - && EQ (event->y, XCONS (down)->cdr)) - ? click_modifier - : drag_modifier); + if (XTYPE (start_pos) != Lisp_Cons) + event->modifiers |= click_modifier; + else + { + /* The third element of every position should be the (x,y) + pair. */ + Lisp_Object down = Fnth (make_number (2), start_pos); + + event->modifiers |= ((EQ (event->x, XCONS (down)->car) + && EQ (event->y, XCONS (down)->cdr)) + ? click_modifier + : drag_modifier); + } } else /* Every mouse event should either have the down_modifier or @@ -1978,18 +1992,10 @@ make_lispy_event (event) / sizeof (lispy_mouse_names[0]))); if (event->modifiers & drag_modifier) - { - Lisp_Object lispy_event = - Fcons (head, - Fcons (*start_pos, - Fcons (position, - Qnil))); - - /* Allow this to be GC'd. */ - *start_pos = Qnil; - - return lispy_event; - } + return Fcons (head, + Fcons (start_pos, + Fcons (position, + Qnil))); else return Fcons (head, Fcons (position, @@ -2453,21 +2459,6 @@ modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table, return apply_modifiers (modifiers, *slot); } - -DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0, - "Return non-nil iff OBJECT is a representation of a mouse event.\n\ -A mouse event is a list of five elements whose car is a symbol of the\n\ -form mouse-. I hope this is a temporary hack.") - (object) - Lisp_Object object; -{ - if (EVENT_HAS_PARAMETERS (object) - && EQ (EVENT_HEAD_KIND (EVENT_HEAD (object)), - Qmouse_click)) - return Qt; - else - return Qnil; -} /* Store into *addr a value nonzero if terminal input chars are available. Serves the purpose of ioctl (0, FIONREAD, addr) @@ -2686,7 +2677,9 @@ static int echo_flag; static int echo_now; /* Read a character like read_char but optionally prompt based on maps - in the array MAPS. NMAPS is the length of MAPS. + in the array MAPS. NMAPS is the length of MAPS. Return nil if we + decided not to read a character, because there are no menu items in + MAPS. PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence. @@ -2730,14 +2723,14 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) } /* If we don't have any menus, just read a character normally. */ - if (NILP (name)) + if (mapno >= nmaps) return Qnil; -#ifdef HAVE_X_WINDOW -#ifndef NO_X_MENU +#ifdef HAVE_X_WINDOWS +#ifdef HAVE_X_MENU /* If we got to this point via a mouse click, use a real menu for mouse selection. */ - if (XTYPE (prev_event) == Lisp_Cons) + if (EVENT_HAS_PARAMETERS (prev_event)) { /* Display the menu and get the selection. */ Lisp_Object *realmaps @@ -2757,8 +2750,8 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) *used_mouse_menu = 1; return value; } -#endif /* not NO_X_MENU */ -#endif /* HAVE_X_WINDOW */ +#endif /* HAVE_X_MENU */ +#endif /* HAVE_X_WINDOWS */ /* Prompt string always starts with map's prompt, and a space. */ strcpy (menu, XSTRING (name)->data); @@ -3677,7 +3670,7 @@ DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0, Actually, the value is nil only if we can be sure that no input is available.") () { - if (!NILP (unread_command_event)) + if (!NILP (unread_command_events)) return (Qt); return detect_input_pending () ? Qt : Qnil; @@ -3749,7 +3742,7 @@ Also cancel any kbd macro being defined.") defining_kbd_macro = 0; update_mode_lines++; - unread_command_event = Qnil; + unread_command_events = Qnil; discard_tty_input (); @@ -3997,7 +3990,7 @@ quit_throw_to_read_char () clear_waiting_for_input (); input_pending = 0; - unread_command_event = Qnil; + unread_command_events = Qnil; _longjmp (getcjmp, 1); } @@ -4051,7 +4044,7 @@ init_keyboard () command_loop_level = -1; immediate_quit = 0; quit_char = Ctl ('g'); - unread_command_event = Qnil; + unread_command_events = Qnil; total_keys = 0; recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; @@ -4219,7 +4212,6 @@ syms_of_keyboard () defsubr (&Sread_key_sequence); defsubr (&Srecursive_edit); defsubr (&Strack_mouse); - defsubr (&Smouse_click_p); defsubr (&Sinput_pending_p); defsubr (&Scommand_execute); defsubr (&Srecent_keys); @@ -4250,8 +4242,8 @@ so that you can determine whether the command was run by mouse or not."); DEFVAR_LISP ("last-input-char", &last_input_char, "Last terminal input key."); - DEFVAR_LISP ("unread-command-event", &unread_command_event, - "Object to be read as next input from input stream, or nil if none."); + DEFVAR_LISP ("unread-command-events", &unread_command_events, + "Lisp of object to be read as next input from input stream, or nil if none."); DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char, "Meta-prefix character code. Meta-foo as command input\n\ diff --git a/src/keyboard.h b/src/keyboard.h index c7048fd6c0c..1d4a82256d0 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -1,5 +1,5 @@ /* Declarations useful when processing input. - Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -84,7 +84,6 @@ extern Lisp_Object Qmode_line, Qvertical_line; extern Lisp_Object get_keymap_1 (); extern Lisp_Object Fkeymapp (); extern Lisp_Object reorder_modifiers (); -extern Lisp_Object Fmouse_click_p (); extern Lisp_Object read_char (); /* User-supplied string to translate input characters through. */ extern Lisp_Object Vkeyboard_translate_table; diff --git a/src/keymap.c b/src/keymap.c index 5282711bac0..e1b61f5db90 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -555,8 +555,14 @@ the front of KEYMAP.") keymap = get_keymap_1 (cmd, 0, 1); if (NILP (keymap)) - error ("Key sequence %s uses invalid prefix characters", - XSTRING (key)->data); + { + /* We must use Fkey_description rather than just passing key to + error; key might be a vector, not a string. */ + Lisp_Object description = Fkey_description (key); + + error ("Key sequence %s uses invalid prefix characters", + XSTRING (description)->data); + } } } diff --git a/src/lread.c b/src/lread.c index 0198dda9aca..721955c358b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -203,7 +203,7 @@ If you want to read non-character events, or ignore them, call\n\ /* Only ASCII characters are acceptable. */ if (XTYPE (val) != Lisp_Int) { - unread_command_event = val; + unread_command_events = Fcons (val, Qnil); error ("Object read was not a character"); } } @@ -1045,9 +1045,17 @@ read1 (readcharfun) if (p1 != p) { while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++; +#ifdef LISP_FLOAT_TYPE + /* Integers can have trailing decimal points. */ + if (p1 < p && *p1 == '.') p1++; +#endif if (p1 == p) - /* It is. */ + /* It is an integer. */ { +#ifdef LISP_FLOAT_TYPE + if (p1[-1] == '.') + p1[-1] = '\0'; +#endif XSET (val, Lisp_Int, atoi (read_buffer)); return val; } diff --git a/src/minibuf.c b/src/minibuf.c index c3625565000..bc1074c89d0 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1,5 +1,5 @@ /* Minibuffer input and completion. - Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -930,7 +930,7 @@ temp_echo_area_glyphs (m) if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; - XFASTINT (unread_command_event) = Ctl ('g'); + unread_command_events = Fcons (make_number (Ctl ('g')), Qnil); } Vinhibit_quit = oinhibit; } diff --git a/src/term.c b/src/term.c index f0cb67b8f6d..cd9e5a84a44 100644 --- a/src/term.c +++ b/src/term.c @@ -125,6 +125,18 @@ void (*mouse_position_hook) ( /* FRAME_PTR *f, the highlight. */ void (*frame_rehighlight_hook) ( /* FRAME_PTR f */ ); +/* If we're displaying frames using a window system that can stack + frames on top of each other, this hook allows you to bring a frame + to the front, or bury it behind all the other windows. If this + hook is zero, that means the device we're displaying on doesn't + support overlapping frames, so there's no need to raise or lower + anything. + + If RAISE is non-zero, F is brought to the front, before all other + windows. If RAISE is zero, F is sent to the back, behind all other + windows. */ +void (*frame_raise_lower_hook) ( /* FRAME_PTR f, int raise */ ); + /* Set the vertical scrollbar for WINDOW to have its upper left corner at (TOP, LEFT), and be LENGTH rows high. Set its handle to indicate that we are displaying PORTION characters out of a total diff --git a/src/termhooks.h b/src/termhooks.h index 9b2c0146ce0..ce9e2ed3d45 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -96,6 +96,17 @@ extern int mouse_moved; X, this means that Emacs lies about where the focus is. */ extern void (*frame_rehighlight_hook) ( /* void */ ); +/* If we're displaying frames using a window system that can stack + frames on top of each other, this hook allows you to bring a frame + to the front, or bury it behind all the other windows. If this + hook is zero, that means the device we're displaying on doesn't + support overlapping frames, so there's no need to raise or lower + anything. + + If RAISE is non-zero, F is brought to the front, before all other + windows. If RAISE is zero, F is sent to the back, behind all other + windows. */ +extern void (*frame_raise_lower_hook) ( /* FRAME_PTR f, int raise */ ); /* Scrollbar hooks. */ diff --git a/src/window.c b/src/window.c index a14599bf786..b788c8f3fae 100644 --- a/src/window.c +++ b/src/window.c @@ -60,9 +60,6 @@ Lisp_Object Vminibuf_scroll_window; /* Non-nil means this is the buffer whose window C-M-v should scroll. */ Lisp_Object Vother_window_scroll_buffer; -/* Window that the mouse is over (nil if no mouse support). */ -Lisp_Object Vmouse_window; - /* Last mouse click data structure (nil if no mouse support). */ Lisp_Object Vmouse_event; @@ -811,7 +808,12 @@ minibuffer does not count, only windows from WINDOW's frame count.\n\ \n\ Optional third arg ALL-FRAMES t means include windows on all frames.\n\ ALL-FRAMES nil or omitted means cycle within the frames as specified\n\ -above. If neither nil nor t, restrict to WINDOW's frame.") +above. If neither nil nor t, restrict to WINDOW's frame.\n\ +\n\ +If you use consistent values for MINIBUF and ALL-FRAMES, you can use\n\ +`next-window' to iterate through the entire cycle of acceptable\n\ +windows, eventually ending up back at the window you started with.\n\ +`previous-window' traverses the same cycle, in the reverse order.") (window, minibuf, all_frames) register Lisp_Object window, minibuf, all_frames; { @@ -908,7 +910,12 @@ count.\n\ \n\ Optional third arg ALL-FRAMES t means include windows on all frames.\n\ ALL-FRAMES nil or omitted means cycle within the frames as specified\n\ -above. If neither nil nor t, restrict to WINDOW's frame.") +above. If neither nil nor t, restrict to WINDOW's frame.\n\ +\n\ +If you use consistent values for MINIBUF and ALL-FRAMES, you can use\n\ +`previous-window' to iterate through the entire cycle of acceptable\n\ +windows, eventually ending up back at the window you started with.\n\ +`next-window' traverses the same cycle, in the reverse order.") (window, minibuf, all_frames) register Lisp_Object window, minibuf, all_frames; { @@ -955,7 +962,16 @@ above. If neither nil nor t, restrict to WINDOW's frame.") tem = WINDOW_FRAME (XWINDOW (window)); #ifdef MULTI_FRAME if (! NILP (all_frames)) - tem = next_frame (tem, all_frames); + /* It's actually important that we use prev_frame here, + rather than next_frame. All the windows acceptable + according to the given parameters should form a ring; + Fnext_window and Fprevious_window should go back and + forth around the ring. If we use next_frame here, + then Fnext_window and Fprevious_window take different + paths through the set of acceptable windows. + window_loop assumes that these `ring' requirement are + met. */ + tem = prev_frame (tem, all_frames); #endif tem = FRAME_ROOT_WINDOW (XFRAME (tem)); @@ -2205,8 +2221,20 @@ showing that buffer, popping the buffer up if necessary.") window = Fdisplay_buffer (Vother_window_scroll_buffer, Qt); } else - /* Nothing specified; pick a neighboring window. */ - window = Fnext_window (selected_window, Qnil, Qt); + { + /* Nothing specified; look for a neighboring window on the same + frame. */ + window = Fnext_window (selected_window, Qnil, Qnil); + + if (EQ (window, selected_window)) + /* That didn't get us anywhere; look for a window on another + visible frame. */ + do + window = Fnext_window (window, Qnil, Qt); + while (! FRAME_VISIBLE_P (XFRAME (WINDOW_FRAME (XWINDOW (window)))) + && ! EQ (window, selected_window)); + } + CHECK_LIVE_WINDOW (window, 0); if (EQ (window, selected_window)) @@ -2866,10 +2894,6 @@ Commands such as `switch-to-buffer-other-window' and `find-file-other-window'\n\ work using this function."); Vdisplay_buffer_function = Qnil; - DEFVAR_LISP ("mouse-window", &Vmouse_window, - "Window that the last mouse click occurred on."); - Vmouse_window = Qnil; - DEFVAR_LISP ("mouse-event", &Vmouse_event, "The last mouse-event object. A list of four elements:\n\ ((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ).\n\ diff --git a/src/xfns.c b/src/xfns.c index cb5aaca7af7..5b9f7da731f 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -37,6 +37,8 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef HAVE_X_WINDOWS extern void abort (); +#include + #define min(a,b) ((a) < (b) ? (a) : (b)) #define max(a,b) ((a) > (b) ? (a) : (b)) @@ -58,9 +60,6 @@ Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape; /* Color of chars displayed in cursor box. */ Lisp_Object Vx_cursor_fore_pixel; -/* If non-nil, use vertical bar cursor. */ -Lisp_Object Vbar_cursor; - /* The X Visual we are using for X windows (the default) */ Visual *screen_visual; @@ -115,7 +114,6 @@ static char *x_visual_strings[] = Lisp_Object Vmouse_depressed; extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed; -extern Lisp_Object unread_command_event; /* Atom for indicating window state to the window manager. */ Atom Xatom_wm_change_state; @@ -123,9 +121,6 @@ Atom Xatom_wm_change_state; /* When emacs became the selection owner. */ extern Time x_begin_selection_own; -/* The value of the current emacs selection. */ -extern Lisp_Object Vx_selection_value; - /* Emacs' selection property identifier. */ extern Atom Xatom_emacs_selection; @@ -228,9 +223,12 @@ Time mouse_timestamp; Lisp_Object Qauto_raise; Lisp_Object Qauto_lower; Lisp_Object Qbackground_color; +Lisp_Object Qbar; Lisp_Object Qborder_color; Lisp_Object Qborder_width; +Lisp_Object Qbox; Lisp_Object Qcursor_color; +Lisp_Object Qcursor_type; Lisp_Object Qfont; Lisp_Object Qforeground_color; Lisp_Object Qgeometry; @@ -261,14 +259,6 @@ extern Lisp_Object Vglobal_mouse_map; /* Points to table of defined typefaces. */ struct face *x_face_table[MAX_FACES_AND_GLYPHS]; - -static char gray_bits[] = - { - 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, - 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, - 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, - 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa - }; /* Return the Emacs frame-object corresponding to an X window. It could be the frame's main window or an icon window. */ @@ -330,6 +320,7 @@ void x_set_background_color (); void x_set_mouse_color (); void x_set_cursor_color (); void x_set_border_color (); +void x_set_cursor_type (); void x_set_icon_type (); void x_set_font (); void x_set_border_width (); @@ -346,6 +337,7 @@ static struct x_frame_parm_table x_frame_parms[] = "mouse-color", x_set_mouse_color, "cursor-color", x_set_cursor_color, "border-color", x_set_border_color, + "cursor-type", x_set_cursor_type, "icon-type", x_set_icon_type, "font", x_set_font, "border-width", x_set_border_width, @@ -808,7 +800,8 @@ x_set_border_pixel (f, pix) pix); #else if (pix < 0) - temp = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits), + temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height, + gray_bits), BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT); else temp = XMakeTile (pix); @@ -822,6 +815,24 @@ x_set_border_pixel (f, pix) } } +void +x_set_cursor_type (f, arg, oldval) + FRAME_PTR f; + Lisp_Object arg, oldval; +{ + if (EQ (arg, Qbar)) + FRAME_DESIRED_CURSOR (f) = bar_cursor; + else if (EQ (arg, Qbox)) + FRAME_DESIRED_CURSOR (f) = filled_box_cursor; + else + error + ("the `cursor-type' frame parameter should be either `bar' or `box'"); + + /* Make sure the cursor gets redrawn. This is overkill, but how + often do people change cursor types? */ + update_mode_lines++; +} + void x_set_icon_type (f, arg, oldval) struct frame *f; @@ -1796,31 +1807,12 @@ x_make_gc (f) the frame. Since this depends on the frame's pixel values, this must be done on a per-frame basis. */ f->display.x->border_tile = - XCreatePixmap (x_current_display, ROOT_WINDOW, 16, 16, - DefaultDepth (x_current_display, - XDefaultScreen (x_current_display))); - gc_values.foreground = f->display.x->foreground_pixel; - gc_values.background = f->display.x->background_pixel; - temp_gc = XCreateGC (x_current_display, - (Drawable) f->display.x->border_tile, - GCForeground | GCBackground, &gc_values); - - /* These are things that should be determined by the server, in - Fx_open_connection */ - tileimage.height = 16; - tileimage.width = 16; - tileimage.xoffset = 0; - tileimage.format = XYBitmap; - tileimage.data = gray_bits; - tileimage.byte_order = LSBFirst; - tileimage.bitmap_unit = 8; - tileimage.bitmap_bit_order = LSBFirst; - tileimage.bitmap_pad = 8; - tileimage.bytes_per_line = (16 + 7) >> 3; - tileimage.depth = 1; - XPutImage (x_current_display, f->display.x->border_tile, temp_gc, - &tileimage, 0, 0, 0, 0, 16, 16); - XFreeGC (x_current_display, temp_gc); + XCreatePixmapFromBitmapData + (x_current_display, ROOT_WINDOW, + gray_bits, gray_width, gray_height, + f->display.x->foreground_pixel, + f->display.x->background_pixel, + DefaultDepth (x_current_display, XDefaultScreen (x_current_display))); } #endif /* HAVE_X11 */ @@ -1930,6 +1922,8 @@ be shared by the new frame.") "autoRaise", "AutoRaiseLower", boolean); x_default_parameter (f, parms, Qauto_lower, Qnil, "autoLower", "AutoRaiseLower", boolean); + x_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", symbol); /* Dimensions, especially f->height, must be done via change_frame_size. Change will not be effected unless different from the current @@ -3784,12 +3778,18 @@ syms_of_xfns () staticpro (&Qauto_lower); Qbackground_color = intern ("background-color"); staticpro (&Qbackground_color); + Qbar = intern ("bar"); + staticpro (&Qbar); Qborder_color = intern ("border-color"); staticpro (&Qborder_color); Qborder_width = intern ("border-width"); staticpro (&Qborder_width); + Qbox = intern ("box"); + staticpro (&Qbox); Qcursor_color = intern ("cursor-color"); staticpro (&Qcursor_color); + Qcursor_type = intern ("cursor-type"); + staticpro (&Qcursor_type); Qfont = intern ("font"); staticpro (&Qfont); Qforeground_color = intern ("foreground-color"); @@ -3851,10 +3851,6 @@ syms_of_xfns () "The shape of the pointer when over the mode line."); Vx_mode_pointer_shape = Qnil; - DEFVAR_LISP ("x-bar-cursor", &Vbar_cursor, - "*If non-nil, use a vertical bar cursor. Otherwise, use the traditional box."); - Vbar_cursor = Qnil; - DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel, "A string indicating the foreground color of the cursor box."); Vx_cursor_fore_pixel = Qnil; diff --git a/src/xmenu.c b/src/xmenu.c index 025b61e4084..70f635ac2f5 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -103,7 +103,7 @@ Alternatively, you can specify a menu of multiple panes\n\ with a list of the form\n\ \(TITLE PANE1 PANE2...), where each pane is a list of form\n\ \(TITLE (LINE ITEM)...). Each line should be a string, and item should\n\ -be the return value for that line (i.e. if it is selected.") +be the return value for that line (i.e. if it is selected).") (position, menu) Lisp_Object position, menu; { diff --git a/src/xselect.c.old b/src/xselect.c.old index fcbae4b4203..8a3e0443270 100644 --- a/src/xselect.c.old +++ b/src/xselect.c.old @@ -1,5 +1,5 @@ /* X Selection processing for emacs - Copyright (C) 1990, 1992 Free Software Foundation. + Copyright (C) 1990, 1992, 1993 Free Software Foundation. This file is part of GNU Emacs. @@ -188,17 +188,41 @@ own_selection (selection_type, time) If we are already the owner, merely change data and timestamp values. This avoids generating SelectionClear events for ourselves. */ -DEFUN ("x-own-selection", Fx_own_selection, Sx_own_selection, - 1, 2, "", - "Make STRING the selection value. Default is the primary selection,\n\ -but optional second argument TYPE may specify secondary or clipboard.\n\ +DEFUN ("x-set-selection", Fx_set_selection, Sx_set_selection, + 2, 2, "", + "Set the value of SELECTION to STRING.\n\ +SELECTION may be `primary', `secondary', or `clipboard'.\n\ \n\ -TYPE may also be cut-buffer0, indicating that Emacs should set the X\n\ -cut buffer 0 to STRING. This is for compatibility with older X\n\ -applications which still use the cut buffers; new applications should\n\ -use X selections.") - (string, type) - register Lisp_Object string, type; +Selections are a mechanism for cutting and pasting information between\n\ +X Windows clients. Emacs's kill ring commands set the `primary'\n\ +selection to the top string of the kill ring, making it available to\n\ +other clients, like xterm. Those commands also use the `primary'\n\ +selection to retrieve information from other clients.\n\ +\n\ +According to the Inter-Client Communications Conventions Manual:\n\ +\n\ +The `primary' selection \"... is used for all commands that take only a\n\ + single argument and is the principal means of communication between\n\ + clients that use the selection mechanism.\" In Emacs, this means\n\ + that the kill ring commands set the primary selection to the text\n\ + put in the kill ring.\n\ +\n\ +The `secondary' selection \"... is used as the second argument to\n\ + commands taking two arguments (for example, `exchange primary and\n\ + secondary selections'), and as a means of obtaining data when there\n\ + is a primary selection and the user does not want to disturb it.\"\n\ + I am not sure how Emacs should use the secondary selection; if you\n\ + come up with ideas, this function will at least let you get at it.\n\ +\n\ +The `clipboard' selection \"... is used to hold data that is being\n\ + transferred between clients, that is, data that usually is being\n\ + cut or copied, and then pasted.\" It seems that the `clipboard'\n\ + selection is for the most part equivalent to the `primary'\n\ + selection, so Emacs sets them both.\n\ +\n\ +Also see `x-selection', and the `interprogram-cut-function' variable.") + (selection, string) + register Lisp_Object selection, string; { Atom selection_type; Lisp_Object val; @@ -207,7 +231,7 @@ use X selections.") val = Qnil; - if (NILP (type) || EQ (type, Qprimary)) + if (NILP (selection) || EQ (selection, Qprimary)) { BLOCK_INPUT; if (own_selection (XA_PRIMARY, event_time)) @@ -217,7 +241,7 @@ use X selections.") } UNBLOCK_INPUT; } - else if (EQ (type, Qsecondary)) + else if (EQ (selection, Qsecondary)) { BLOCK_INPUT; if (own_selection (XA_SECONDARY, event_time)) @@ -227,7 +251,7 @@ use X selections.") } UNBLOCK_INPUT; } - else if (EQ (type, Qclipboard)) + else if (EQ (selection, Qclipboard)) { BLOCK_INPUT; if (own_selection (Xatom_clipboard, event_time)) @@ -237,33 +261,6 @@ use X selections.") } UNBLOCK_INPUT; } -#if 0 - else if (EQ (type, Qcut_buffer0)) - { - /* DECwindows and some other servers don't seem to like setting - properties to values larger than about 20k. For very large - values, they signal an error, but for intermediate values - they just seem to hang. - - We could just truncate the request, but it's better to let - the user know that the strategy he/she's using isn't going to - work than to have it work partially, but incorrectly. */ - BLOCK_INPUT; - if (XSTRING (string)->size > MAX_SELECTION (x_current_display)) - { - XStoreBytes (x_current_display, (char *) 0, 0); - val = Qnil; - } - else - { - XStoreBytes (x_current_display, - (char *) XSTRING (string)->data, - XSTRING (string)->size); - val = string; - } - UNBLOCK_INPUT; - } -#endif else error ("Invalid X selection type"); @@ -621,54 +618,45 @@ get_selection_value (type) simply return our selection value. If we are not the owner, this will block until all of the data has arrived. */ -DEFUN ("x-selection-value", Fx_selection_value, Sx_selection_value, - 0, 1, "", - "Return the value of one of the selections. Default is the primary\n\ -selection, but optional argument TYPE may specify secondary or clipboard.") - (type) - register Lisp_Object type; +DEFUN ("x-selection", Fx_selection, Sx_selection, + 1, 1, "", + "Return the value of SELECTION.\n\ +SELECTION is one of `primary', `secondary', or `clipboard'.\n\ +\n\ +Selections are a mechanism for cutting and pasting information between\n\ +X Windows clients. When the user selects text in an X application,\n\ +the application should set the primary selection to that text; Emacs's\n\ +kill ring commands will then check the value of the `primary'\n\ +selection, and return it as the most recent kill.\n\ +The documentation for `x-set-selection' gives more information on how\n\ +the different selection types are intended to be used.\n\ +Also see the `interprogram-paste-function' variable.") + (selection) + register Lisp_Object selection; { Atom selection_type; - if (NILP (type) || EQ (type, Qprimary)) + if (NILP (selection) || EQ (selection, Qprimary)) { if (!NILP (Vx_selection_value)) return Vx_selection_value; return get_selection_value (XA_PRIMARY); } - else if (EQ (type, Qsecondary)) + else if (EQ (selection, Qsecondary)) { if (!NILP (Vx_secondary_selection_value)) return Vx_secondary_selection_value; return get_selection_value (XA_SECONDARY); } - else if (EQ (type, Qclipboard)) + else if (EQ (selection, Qclipboard)) { if (!NILP (Vx_clipboard_value)) return Vx_clipboard_value; return get_selection_value (Xatom_clipboard); } -#if 0 - else if (EQ (type, Qcut_buffer0)) - { - char *data; - int size; - Lisp_Object string; - - BLOCK_INPUT; - data = XFetchBytes (x_current_display, &size); - if (data == 0) - string = Qnil; - else - string = make_string (data, size); - UNBLOCK_INPUT; - - return string; - } -#endif else error ("Invalid X selection type"); } @@ -950,8 +938,8 @@ syms_of_xselect () Qclipboard = intern ("clipboard"); staticpro (&Qclipboard); - defsubr (&Sx_own_selection); - defsubr (&Sx_selection_value); + defsubr (&Sx_set_selection); + defsubr (&Sx_selection); cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil); staticpro (&cut_buffer_value); diff --git a/src/xterm.c b/src/xterm.c index b534751dbf7..712a64ac26d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -657,94 +657,127 @@ XTclear_frame () curs_y = 0; BLOCK_INPUT; + XClear (FRAME_X_WINDOW (f)); + + /* We have to clear the scrollbars, too. If we have changed + colors or something like that, then they should be notified. */ + x_scrollbar_clear (f); + #ifndef HAVE_X11 dumpborder (f, 0); #endif /* HAVE_X11 */ + XFlushQueue (); UNBLOCK_INPUT; } -/* Paint horzontal bars down the frame for a visible bell. - Note that this may be way too slow on some machines. */ +/* Invert the middle quarter of the frame for .15 sec. */ + +/* We use the select system call to do the waiting, so we have to make sure + it's avaliable. If it isn't, we just won't do visual bells. */ +#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) + +/* Subtract the `struct timeval' values X and Y, + storing the result in RESULT. + Return 1 if the difference is negative, otherwise 0. */ + +static int +timeval_subtract (result, x, y) + struct timeval *result, x, y; +{ + /* Perform the carry for the later subtraction by updating y. + This is safer because on some systems + the tv_sec member is unsigned. */ + if (x.tv_usec < y.tv_usec) + { + int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1; + y.tv_usec -= 1000000 * nsec; + y.tv_sec += nsec; + } + if (x.tv_usec - y.tv_usec > 1000000) + { + int nsec = (y.tv_usec - x.tv_usec) / 1000000; + y.tv_usec += 1000000 * nsec; + y.tv_sec -= nsec; + } + + /* Compute the time remaining to wait. tv_usec is certainly positive. */ + result->tv_sec = x.tv_sec - y.tv_sec; + result->tv_usec = x.tv_usec - y.tv_usec; + + /* Return indication of whether the result should be considered negative. */ + return x.tv_sec < y.tv_sec; +} XTflash (f) struct frame *f; { - register struct frame_glyphs *active_frame = FRAME_CURRENT_GLYPHS (f); - register int i; - int x, y; - - if (updating_frame != 0) - abort (); - BLOCK_INPUT; -#ifdef HAVE_X11 -#if 0 - for (i = f->height * FONT_HEIGHT (f->display.x->font) - 10; - i >= 0; - i -= 100) /* Should be NO LOWER than 75 for speed reasons. */ - XFillRectangle (x_current_display, FRAME_X_WINDOW (f), - f->display.x->cursor_gc, - 0, i, f->width * FONT_WIDTH (f->display.x->font) - + 2 * f->display.x->internal_border_width, 25); -#endif /* ! 0 */ - x = (f->width * FONT_WIDTH (f->display.x->font)) / 4; - y = (f->height * FONT_HEIGHT (f->display.x->font)) / 4; - XFillRectangle (x_current_display, FRAME_X_WINDOW (f), - f->display.x->cursor_gc, - x, y, 2 * x, 2 * y); - dumpglyphs (f, (x + f->display.x->internal_border_width), - (y + f->display.x->internal_border_width), - &active_frame->glyphs[(f->height / 4) + 1][(f->width / 4)], - 1, 0, f->display.x->font); + { + GC gc; -#else /* ! defined (HAVE_X11) */ - for (i = f->height * FONT_HEIGHT (f->display.x->font) - 10; - i >= 0; - i -= 50) - XPixFill (FRAME_X_WINDOW (f), 0, i, - f->width * FONT_WIDTH (f->display.x->font) - + 2 * f->display.x->internal_border_width, 10, - WHITE_PIX_DEFAULT, ClipModeClipped, GXinvert, AllPlanes); -#endif /* ! defined (HAVE_X11) */ + /* Create a GC that will use the GXxor function to flip foreground pixels + into background pixels. */ + { + XGCValues values; + + values.function = GXxor; + values.foreground = (f->display.x->foreground_pixel + ^ f->display.x->background_pixel); + + gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), + GCFunction | GCForeground, &values); + } + + { + int width = PIXEL_WIDTH (f); + int height = PIXEL_HEIGHT (f); + + XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc, + width/4, height/4, width/2, height/2); + XFlush (x_current_display); + + { + struct timeval wakeup, now; + + gettimeofday (&wakeup, (struct timezone *) 0); + + /* Compute time to wait until, propagating carry from usecs. */ + wakeup.tv_usec += 150000; + wakeup.tv_sec += (wakeup.tv_usec / 1000000); + wakeup.tv_usec %= 1000000; + + /* Keep waiting until past the time wakeup. */ + while (1) + { + struct timeval timeout; + + gettimeofday (&timeout, (struct timezone *)0); + + /* In effect, timeout = wakeup - timeout. + Break if result would be negative. */ + if (timeval_subtract (&timeout, wakeup, timeout)) + break; + + /* Try to wait that long--but we might wake up sooner. */ + select (0, 0, 0, 0, &timeout); + } + } + + XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc, + width/4, height/4, width/2, height/2); + XFreeGC (x_current_display, gc); + XFlush (x_current_display); + } + } - XFlushQueue (); UNBLOCK_INPUT; } -/* Flip background and forground colors of the frame. */ +#endif -x_invert_frame (f) - struct frame *f; -{ -#ifdef HAVE_X11 - GC temp; - unsigned long pix_temp; - - x_display_cursor (f, 0); - XClearWindow (x_current_display, FRAME_X_WINDOW (f)); - temp = f->display.x->normal_gc; - f->display.x->normal_gc = f->display.x->reverse_gc; - f->display.x->reverse_gc = temp; - pix_temp = f->display.x->foreground_pixel; - f->display.x->foreground_pixel = f->display.x->background_pixel; - f->display.x->background_pixel = pix_temp; - - XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f), - f->display.x->background_pixel); - if (f->display.x->background_pixel == f->display.x->cursor_pixel) - { - f->display.x->cursor_pixel = f->display.x->foreground_pixel; - XSetBackground (x_current_display, f->display.x->cursor_gc, - f->display.x->cursor_pixel); - XSetForeground (x_current_display, f->display.x->cursor_gc, - f->display.x->background_pixel); - } - redraw_frame (f); -#endif /* ! defined (HAVE_X11) */ -} /* Make audible bell. */ @@ -756,15 +789,11 @@ x_invert_frame (f) XTring_bell () { +#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) if (visible_bell) -#if 0 XTflash (selected_frame); -#endif /* ! 0 */ - { - x_invert_frame (selected_frame); - x_invert_frame (selected_frame); - } else +#endif { BLOCK_INPUT; XRINGBELL; @@ -1758,9 +1787,8 @@ x_scrollbar_create (window, top, left, width, height) | ButtonMotionMask | PointerMotionHintMask | ExposureMask); a.cursor = x_vertical_scrollbar_cursor; - a.win_gravity = EastGravity; - mask = (CWBackPixel | CWEventMask | CWCursor | CWWinGravity); + mask = (CWBackPixel | CWEventMask | CWCursor); SET_SCROLLBAR_X_WINDOW (bar, @@ -2321,6 +2349,24 @@ x_scrollbar_report_motion (f, bar_window, part, x, y, time) } +/* The screen has been cleared so we may have changed foreground or + background colors, and the scrollbars may need to be redrawn. + Clear out the scrollbars, and ask for expose events, so we can + redraw them. */ + +x_scrollbar_clear (f) + FRAME_PTR f; +{ + Lisp_Object bar; + + for (bar = FRAME_SCROLLBARS (f); + XTYPE (bar) == Lisp_Vector; + bar = XSCROLLBAR (bar)->next) + XClearArea (x_current_display, SCROLLBAR_X_WINDOW (XSCROLLBAR (bar)), + 0, 0, 0, 0, True); +} + + /* The main X event-reading loop - XTread_socket. */ @@ -2865,33 +2911,30 @@ XTread_socket (sd, bufp, numchars, waitp, expected) break; case ConfigureNotify: - { - int rows, columns; - f = x_window_to_frame (event.xconfigure.window); - if (!f) - break; + f = x_window_to_frame (event.xconfigure.window); + if (f) + { + int rows = PIXEL_TO_CHAR_HEIGHT (f, event.xconfigure.height); + int columns = PIXEL_TO_CHAR_WIDTH (f, event.xconfigure.width); - columns = PIXEL_TO_CHAR_WIDTH (f, event.xconfigure.width); - rows = PIXEL_TO_CHAR_HEIGHT (f, event.xconfigure.height); + /* Even if the number of character rows and columns has + not changed, the font size may have changed, so we need + to check the pixel dimensions as well. */ + if (columns != f->width + || rows != f->height + || event.xconfigure.width != f->display.x->pixel_width + || event.xconfigure.height != f->display.x->pixel_height) + { + change_frame_size (f, rows, columns, 0, 1); + SET_FRAME_GARBAGED (f); + } - /* Even if the number of character rows and columns has - not changed, the font size may have changed, so we need - to check the pixel dimensions as well. */ - if (columns != f->width - || rows != f->height - || event.xconfigure.width != f->display.x->pixel_width - || event.xconfigure.height != f->display.x->pixel_height) - { - change_frame_size (f, rows, columns, 0, 1); - SET_FRAME_GARBAGED (f); - } - - f->display.x->pixel_width = event.xconfigure.width; - f->display.x->pixel_height = event.xconfigure.height; - f->display.x->left_pos = event.xconfigure.x; - f->display.x->top_pos = event.xconfigure.y; - break; - } + f->display.x->pixel_width = event.xconfigure.width; + f->display.x->pixel_height = event.xconfigure.height; + f->display.x->left_pos = event.xconfigure.x; + f->display.x->top_pos = event.xconfigure.y; + } + break; case ButtonPress: case ButtonRelease: @@ -3153,52 +3196,6 @@ clear_cursor (f) f->phys_cursor_x = -1; } -static void -x_display_bar_cursor (f, on) - struct frame *f; - int on; -{ - register int phys_x = f->phys_cursor_x; - register int phys_y = f->phys_cursor_y; - register int x1; - register int y1; - register int y2; - - if (! FRAME_VISIBLE_P (f) || (! on && f->phys_cursor_x < 0)) - return; - -#ifdef HAVE_X11 - if (phys_x >= 0 && - (!on || phys_x != f->cursor_x || phys_y != f->cursor_y)) - { - x1 = CHAR_TO_PIXEL_COL (f, phys_x); - y1 = CHAR_TO_PIXEL_ROW (f, phys_y) - 1; - y2 = y1 + FONT_HEIGHT (f->display.x->font) + 1; - - XDrawLine (x_current_display, FRAME_X_WINDOW (f), - f->display.x->reverse_gc, x1, y1, x1, y2); - - f->phys_cursor_x = phys_x = -1; - } - - if (on && f == x_highlight_frame) - { - x1 = CHAR_TO_PIXEL_COL (f, f->cursor_x); - y1 = CHAR_TO_PIXEL_ROW (f, f->cursor_y) - 1; - y2 = y1 + FONT_HEIGHT (f->display.x->font) + 1; - - XDrawLine (x_current_display, FRAME_X_WINDOW (f), - f->display.x->cursor_gc, x1, y1, x1, y2); - - f->phys_cursor_x = f->cursor_x; - f->phys_cursor_y = f->cursor_y; - } -#else /* ! defined (HAVE_X11) */ - Give it up, dude. -#endif /* ! defined (HAVE_X11) */ -} - - /* Redraw the glyph at ROW, COLUMN on frame F, in the style HIGHLIGHT. HIGHLIGHT is as defined for dumpglyphs. Return the glyph drawn. */ @@ -3216,6 +3213,68 @@ x_draw_single_glyph (f, row, column, glyph, highlight) &glyph, 1, highlight, f->display.x->font); } +static void +x_display_bar_cursor (f, on) + struct frame *f; + int on; +{ + struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f); + + if (! FRAME_VISIBLE_P (f)) + return; + + if (! on && f->phys_cursor_x < 0) + return; + + /* If we're not updating, then we want to use the current frame's + cursor position, not our local idea of where the cursor ought to be. */ + if (f != updating_frame) + { + curs_x = FRAME_CURSOR_X (f); + curs_y = FRAME_CURSOR_Y (f); + } + + /* If there is anything wrong with the current cursor state, remove it. */ + if (f->phys_cursor_x >= 0 + && (!on + || f->phys_cursor_x != curs_x + || f->phys_cursor_y != curs_y + || f->display.x->current_cursor != bar_cursor)) + { + /* Erase the cursor by redrawing the character underneath it. */ + x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x, + f->phys_cursor_glyph, + current_glyphs->highlight[f->phys_cursor_y]); + f->phys_cursor_x = -1; + } + + /* If we now need a cursor in the new place or in the new form, do it so. */ + if (on + && (f->phys_cursor_x < 0 + || (f->display.x->current_cursor != bar_cursor))) + { + f->phys_cursor_glyph + = ((current_glyphs->enable[curs_y] + && curs_x < current_glyphs->used[curs_y]) + ? current_glyphs->glyphs[curs_y][curs_x] + : SPACEGLYPH); + XFillRectangle (x_current_display, FRAME_X_WINDOW (f), + f->display.x->cursor_gc, + CHAR_TO_PIXEL_COL (f, curs_x), + CHAR_TO_PIXEL_ROW (f, curs_y), + 1, FONT_HEIGHT (f->display.x->font)); + + f->phys_cursor_x = curs_x; + f->phys_cursor_y = curs_y; + + f->display.x->current_cursor = bar_cursor; + } + + if (updating_frame != f) + XFlushQueue (); +} + + /* Turn the displayed cursor of frame F on or off according to ON. If ON is nonzero, where to put the cursor is specified by F->cursor_x and F->cursor_y. */ @@ -3227,6 +3286,13 @@ x_display_box_cursor (f, on) { struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f); + if (! FRAME_VISIBLE_P (f)) + return; + + /* If cursor is off and we want it off, return quickly. */ + if (!on && f->phys_cursor_x < 0) + return; + /* If we're not updating, then we want to use the current frame's cursor position, not our local idea of where the cursor ought to be. */ if (f != updating_frame) @@ -3235,13 +3301,6 @@ x_display_box_cursor (f, on) curs_y = FRAME_CURSOR_Y (f); } - if (! FRAME_VISIBLE_P (f)) - return; - - /* If cursor is off and we want it off, return quickly. */ - if (!on && f->phys_cursor_x < 0) - return; - /* If cursor is currently being shown and we don't want it to be or it is in the wrong place, or we want a hollow box and it's not so, (pout!) @@ -3250,7 +3309,7 @@ x_display_box_cursor (f, on) && (!on || f->phys_cursor_x != curs_x || f->phys_cursor_y != curs_y - || (f->display.x->text_cursor_kind != hollow_box_cursor + || (f->display.x->current_cursor != hollow_box_cursor && (f != x_highlight_frame)))) { /* Erase the cursor by redrawing the character underneath it. */ @@ -3265,7 +3324,7 @@ x_display_box_cursor (f, on) write it in the right place. */ if (on && (f->phys_cursor_x < 0 - || (f->display.x->text_cursor_kind != filled_box_cursor + || (f->display.x->current_cursor != filled_box_cursor && f == x_highlight_frame))) { f->phys_cursor_glyph @@ -3276,13 +3335,13 @@ x_display_box_cursor (f, on) if (f != x_highlight_frame) { x_draw_box (f); - f->display.x->text_cursor_kind = hollow_box_cursor; + f->display.x->current_cursor = hollow_box_cursor; } else { x_draw_single_glyph (f, curs_y, curs_x, f->phys_cursor_glyph, 2); - f->display.x->text_cursor_kind = filled_box_cursor; + f->display.x->current_cursor = filled_box_cursor; } f->phys_cursor_x = curs_x; @@ -3293,16 +3352,17 @@ x_display_box_cursor (f, on) XFlushQueue (); } -extern Lisp_Object Vbar_cursor; - x_display_cursor (f, on) struct frame *f; int on; { - if (EQ (Vbar_cursor, Qnil)) + if (FRAME_DESIRED_CURSOR (f) == filled_box_cursor) x_display_box_cursor (f, on); - else + else if (FRAME_DESIRED_CURSOR (f) == bar_cursor) x_display_bar_cursor (f, on); + else + /* Those are the only two we have implemented! */ + abort (); } /* Icons. */ @@ -3347,8 +3407,7 @@ refreshicon (f) #endif /* ! defined (HAVE_X11) */ } -/* Make the x-window of frame F use the kitchen-sink icon - that's a window generated by Emacs. */ +/* Make the x-window of frame F use the gnu icon bitmap. */ int x_bitmap_icon (f) @@ -3424,12 +3483,6 @@ x_text_icon (f, icon_name) if (FRAME_X_WINDOW (f) == 0) return 1; - if (icon_font_info == 0) - icon_font_info - = XGetFont (XGetDefault (XDISPLAY - (char *) XSTRING (invocation_name)->data, - "BodyFont")); - #ifdef HAVE_X11 if (icon_name) f->display.x->icon_label = icon_name; @@ -3443,6 +3496,12 @@ x_text_icon (f, icon_name) f->display.x->icon_bitmap_flag = 0; x_wm_set_icon_pixmap (f, 0); #else /* ! defined (HAVE_X11) */ + if (icon_font_info == 0) + icon_font_info + = XGetFont (XGetDefault (XDISPLAY + (char *) XSTRING (invocation_name)->data, + "BodyFont")); + if (f->display.x->icon_desc) { XClearIconWindow (XDISPLAY FRAME_X_WINDOW (f)); @@ -3801,12 +3860,24 @@ x_set_window_size (f, cols, rows) /* Now, strictly speaking, we can't be sure that this is accurate, but the window manager will get around to dealing with the size change request eventually, and we'll hear how it went when the - ConfigureNotify event gets here. */ + ConfigureNotify event gets here. + + We could just not bother storing any of this information here, + and let the ConfigureNotify event set everything up, but that + might be kind of confusing to the lisp code, since size changes + wouldn't be reported in the frame parameters until some random + point in the future when the ConfigureNotify event arrives. */ FRAME_WIDTH (f) = cols; FRAME_HEIGHT (f) = rows; PIXEL_WIDTH (f) = pixelwidth; PIXEL_HEIGHT (f) = pixelheight; + /* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to + receive in the ConfigureNotify event; if we get what we asked + for, then the event won't cause the screen to become garbaged, so + we have to make sure to do it here. */ + SET_FRAME_GARBAGED (f); + XFlushQueue (); UNBLOCK_INPUT; } @@ -3903,6 +3974,18 @@ x_lower_frame (f) } } +static void +XTframe_raise_lower (f, raise) + FRAME_PTR f; + int raise; +{ + if (raise) + x_raise_frame (f); + else + x_lower_frame (f); +} + + /* Change from withdrawn state to mapped state. */ x_make_frame_visible (f) @@ -4259,8 +4342,13 @@ x_wm_set_icon_pixmap (f, icon_pixmap) { Window window = FRAME_X_WINDOW (f); - f->display.x->wm_hints.flags |= IconPixmapHint; - f->display.x->wm_hints.icon_pixmap = icon_pixmap ? icon_pixmap : None; + if (icon_pixmap) + { + f->display.x->wm_hints.icon_pixmap = icon_pixmap; + f->display.x->wm_hints.flags |= IconPixmapHint; + } + else + f->display.x->wm_hints.flags &= ~IconPixmapHint; XSetWMHints (x_current_display, window, &f->display.x->wm_hints); } @@ -4395,6 +4483,7 @@ x_term_init (display_name) reassert_line_highlight_hook = XTreassert_line_highlight; mouse_position_hook = XTmouse_position; frame_rehighlight_hook = XTframe_rehighlight; + frame_raise_lower_hook = XTframe_raise_lower; set_vertical_scrollbar_hook = XTset_vertical_scrollbar; condemn_scrollbars_hook = XTcondemn_scrollbars; redeem_scrollbar_hook = XTredeem_scrollbar; diff --git a/src/xterm.h b/src/xterm.h index 9bf083fa788..025e277a22f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -239,9 +239,6 @@ enum text_cursor_kinds { filled_box_cursor, hollow_box_cursor, bar_cursor }; -#define PIXEL_WIDTH(f) ((f)->display.x->pixel_width) -#define PIXEL_HEIGHT(f) ((f)->display.x->pixel_height) - /* Each X frame object points to its own struct x_display object in the display.x field. The x_display structure contains all the information that is specific to X windows. */ @@ -316,9 +313,13 @@ struct x_display /* Flag to set when the X window needs to be completely repainted. */ int needs_exposure; - /* What kind of text cursor is drawn in this window right now? (If - there is no cursor (phys_cursor_x < 0), then this means nothing. */ - enum text_cursor_kinds text_cursor_kind; + /* What kind of text cursor is drawn in this window right now? + (If there is no cursor (phys_cursor_x < 0), then this means nothing.) */ + enum text_cursor_kinds current_cursor; + + /* What kind of text cursor should we draw in the future? + This should always be filled_box_cursor or bar_cursor. */ + enum text_cursor_kinds desired_cursor; /* These are the current window manager hints. It seems that XSetWMHints, when presented with an unset bit in the `flags' @@ -341,6 +342,12 @@ struct x_display /* Return the window associated with the frame F. */ #define FRAME_X_WINDOW(f) ((f)->display.x->window_desc) +/* These two really ought to be called FRAME_PIXEL_{WIDTH,HEIGHT}. */ +#define PIXEL_WIDTH(f) ((f)->display.x->pixel_width) +#define PIXEL_HEIGHT(f) ((f)->display.x->pixel_height) + +#define FRAME_DESIRED_CURSOR(f) ((f)->display.x->desired_cursor) + /* When X windows are used, a glyf may be a 16 bit unsigned datum. The high order byte is the face number and is used as an index