-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
-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
# ==================== 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 \
-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 \
-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 \
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 \
(let ((ch (read-char)))
(if (= ch ?\ )
(set-window-configuration conf)
- (setq unread-command-event ch))))))))
+ (setq unread-command-events (list ch)))))))))
\f
;;; Converting process modes to use comint mode
;;; ===========================================================================
(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)
(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)
(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 " ")
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)
(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")
(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
(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: ")
(setq arg (car arg))
;; but if the value of the constant is compiled code, then
;; recursively disassemble it.
- (cond ((or (compiled-function-p arg)
+ (cond ((or (byte-code-function-p arg)
(and (eq (car-safe arg) 'lambda)
(assq 'byte-code arg))
(and (eq (car-safe arg) 'macro)
- (or (compiled-function-p (cdr arg))
+ (or (byte-code-function-p (cdr arg))
(and (eq (car-safe (cdr arg)) 'lambda)
(assq 'byte-code (cdr arg))))))
- (cond ((compiled-function-p arg)
+ (cond ((byte-code-function-p arg)
(insert "<compiled-function>\n"))
((eq (car-safe arg) 'lambda)
(insert "<compiled lambda>"))
(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)
(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:
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)
(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."
(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.
;;; 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
(let ((char (read-char)))
(if (= char cmd)
(gnus-Subject-next-group nil)
- (setq unread-command-event char))))
+ (setq unread-command-events (list char)))))
)
))
)))
(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))
(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)))))
\f
;; 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.
;;;====================================================================
;;; 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...
(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))
;; To quiet the byte-compiler.
(defvar unread-command-event)
+(defvar unread-command-events)
(defvar last-command-event)
(defun isearch-char-to-string (c)
(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))))
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 ()
(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)))))
;;; 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
(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.
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.
(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
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.
(select-window window)
(switch-to-buffer buf))))))
\f
-;; Commands for the scroll bar.
-
-(defun mouse-scroll-down (click)
- (interactive "@e")
- (scroll-down (1+ (cdr (mouse-coords click)))))
-
-(defun mouse-scroll-up (click)
- (interactive "@e")
- (scroll-up (1+ (cdr (mouse-coords click)))))
-
-(defun mouse-scroll-down-full ()
- (interactive "@")
- (scroll-down nil))
-
-(defun mouse-scroll-up-full ()
- (interactive "@")
- (scroll-up nil))
-
-(defun mouse-scroll-move-cursor (click)
- (interactive "@e")
- (move-to-window-line (1+ (cdr (mouse-coords click)))))
-
-(defun mouse-scroll-absolute (event)
- (interactive "@e")
- (let* ((pos (car event))
- (position (car pos))
- (length (car (cdr pos))))
- (if (<= length 0) (setq length 1))
- (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
- (newpos (* (/ (* (/ (buffer-size) scale-factor)
- position)
- length)
- scale-factor)))
- (goto-char newpos)
- (recenter '(4)))))
-
-(defun mouse-scroll-left (click)
- (interactive "@e")
- (scroll-left (1+ (car (mouse-coords click)))))
-
-(defun mouse-scroll-right (click)
- (interactive "@e")
- (scroll-right (1+ (car (mouse-coords click)))))
-
-(defun mouse-scroll-left-full ()
- (interactive "@")
- (scroll-left nil))
-
-(defun mouse-scroll-right-full ()
- (interactive "@")
- (scroll-right nil))
-
-(defun mouse-scroll-move-cursor-horizontally (click)
- (interactive "@e")
- (move-to-column (1+ (car (mouse-coords click)))))
-
-(defun mouse-scroll-absolute-horizontally (event)
- (interactive "@e")
- (let* ((pos (car event))
- (position (car pos))
- (length (car (cdr pos))))
- (set-window-hscroll (selected-window) 33)))
-
-(global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
-(global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
-(global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
-
-(global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
-(global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
-(global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
-
-(global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
-(global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
-(global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
-
-(global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
-(global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
-(global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
-
-(global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
-(global-set-key [horizontal-scroll-bar mouse-2]
- 'mouse-scroll-absolute-horizontally)
-(global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
-
-(global-set-key [horizontal-slider mouse-1]
- 'mouse-scroll-move-cursor-horizontally)
-(global-set-key [horizontal-slider mouse-2]
- 'mouse-scroll-move-cursor-horizontally)
-(global-set-key [horizontal-slider mouse-3]
- 'mouse-scroll-move-cursor-horizontally)
-
-(global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
-(global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
-(global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
-
-(global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
-(global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
-(global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
-
-(global-set-key [horizontal-scroll-bar S-mouse-2]
- 'mouse-split-window-horizontally)
-(global-set-key [mode-line S-mouse-2]
- 'mouse-split-window-horizontally)
-(global-set-key [vertical-scroll-bar S-mouse-2]
- 'mouse-split-window)
+;;; These need to be rewritten for the new scrollbar implementation.
+
+;;;!! ;; Commands for the scroll bar.
+;;;!!
+;;;!! (defun mouse-scroll-down (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-up (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-down-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-down nil))
+;;;!!
+;;;!! (defun mouse-scroll-up-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-up nil))
+;;;!!
+;;;!! (defun mouse-scroll-move-cursor (click)
+;;;!! (interactive "@e")
+;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-absolute (event)
+;;;!! (interactive "@e")
+;;;!! (let* ((pos (car event))
+;;;!! (position (car pos))
+;;;!! (length (car (cdr pos))))
+;;;!! (if (<= length 0) (setq length 1))
+;;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
+;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
+;;;!! position)
+;;;!! length)
+;;;!! scale-factor)))
+;;;!! (goto-char newpos)
+;;;!! (recenter '(4)))))
+;;;!!
+;;;!! (defun mouse-scroll-left (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-left (1+ (car (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-right (click)
+;;;!! (interactive "@e")
+;;;!! (scroll-right (1+ (car (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-left-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-left nil))
+;;;!!
+;;;!! (defun mouse-scroll-right-full ()
+;;;!! (interactive "@")
+;;;!! (scroll-right nil))
+;;;!!
+;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
+;;;!! (interactive "@e")
+;;;!! (move-to-column (1+ (car (mouse-coords click)))))
+;;;!!
+;;;!! (defun mouse-scroll-absolute-horizontally (event)
+;;;!! (interactive "@e")
+;;;!! (let* ((pos (car event))
+;;;!! (position (car pos))
+;;;!! (length (car (cdr pos))))
+;;;!! (set-window-hscroll (selected-window) 33)))
+;;;!!
+;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
+;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
+;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
+;;;!!
+;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
+;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
+;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
+;;;!!
+;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
+;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
+;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
+;;;!!
+;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
+;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
+;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
+;;;!!
+;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
+;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
+;;;!! 'mouse-scroll-absolute-horizontally)
+;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
+;;;!!
+;;;!! (global-set-key [horizontal-slider mouse-1]
+;;;!! 'mouse-scroll-move-cursor-horizontally)
+;;;!! (global-set-key [horizontal-slider mouse-2]
+;;;!! 'mouse-scroll-move-cursor-horizontally)
+;;;!! (global-set-key [horizontal-slider mouse-3]
+;;;!! 'mouse-scroll-move-cursor-horizontally)
+;;;!!
+;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
+;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
+;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
+;;;!!
+;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
+;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
+;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
+;;;!!
+;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
+;;;!! 'mouse-split-window-horizontally)
+;;;!! (global-set-key [mode-line S-mouse-2]
+;;;!! 'mouse-split-window-horizontally)
+;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
+;;;!! 'mouse-split-window)
\f
-;;;;
-;;;; 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))))))
\f
;; Font selection.
)
"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)))))
\f
;;; Bindings for mouse commands.
;; This won't be needed once the drag and down events
;; are properly implemented.
-(global-set-key [mouse-1] 'mouse-set-point)
-
-(global-set-key [drag-mouse-1] 'mouse-set-region)
-(global-set-key [mouse-2] 'mouse-yank-at-click)
-(global-set-key [mouse-3] 'mouse-save-then-kill)
+(global-set-key [mouse-1] 'mouse-set-point)
-(global-set-key [C-mouse-1] 'mouse-buffer-menu)
+(global-set-key [drag-mouse-1] 'mouse-set-region)
+(global-set-key [mouse-2] 'mouse-yank-at-click)
+(global-set-key [mouse-3] 'mouse-save-then-kill)
-(global-set-key [C-mouse-3] 'mouse-set-font)
+;; By binding these to down-going events, we let the user use the up-going
+;; event to make the selection, saving a click.
+(global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
+(global-set-key [C-down-mouse-3] 'mouse-set-font)
;; Replaced with dragging mouse-1
;; (global-set-key [S-mouse-1] 'mouse-set-mark)
-(global-set-key [mode-line mouse-1] 'mouse-delete-other-windows)
-(global-set-key [mode-line mouse-3] 'mouse-delete-window)
+(global-set-key [mode-line mouse-1] 'mouse-delete-other-windows)
+(global-set-key [mode-line mouse-3] 'mouse-delete-window)
+(global-set-key [mode-line S-mouse-2] 'mouse-split-window-horizontally)
\f
;; Define the mouse help menu tree.
(defvar help-menu-map '(keymap "Help"))
-(global-set-key [C-mouse-2] help-menu-map)
-
-(defvar help-apropos-map '(keymap "Is there a command that..."))
-(defvar help-keys-map '(keymap "Key Commands <==> Functions"))
-(defvar help-manual-map '(keymap "Manual and tutorial"))
-(defvar help-misc-map '(keymap "Odds and ends"))
-(defvar help-modes-map '(keymap "Modes"))
-(defvar help-admin-map '(keymap "Administrivia"))
+(global-set-key [C-down-mouse-2] help-menu-map)
+
+(defvar help-apropos-map (make-sparse-keymap "Is there a command that..."))
+(defvar help-keys-map (make-sparse-keymap "Key Commands <==> Functions"))
+(defvar help-manual-map (make-sparse-keymap "Manual and tutorial"))
+(defvar help-misc-map (make-sparse-keymap "Odds and ends"))
+(defvar help-modes-map (make-sparse-keymap "Modes"))
+(defvar help-admin-map (make-sparse-keymap "Administrivia"))
(define-key help-menu-map [apropos]
(cons "@Is there a command that..." help-apropos-map))
(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.
;;; 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
(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."
(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 ()
(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
;;; 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)
+
\f
;;;; Utilities.
"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
(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)
(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)
(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)
(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)
(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)))
(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)
(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
(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)))
(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.
;; 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)
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 /' \
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;
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\
/* 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.
/* 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,
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,
/* 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;
/* 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)
{
}
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;
}
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
: "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. */
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
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;
{
(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,
(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;
defsubr (&Sbufferp);
defsubr (&Smarkerp);
defsubr (&Ssubrp);
- defsubr (&Scompiled_function_p);
+ defsubr (&Sbyte_code_function_p);
defsubr (&Schar_or_string_p);
defsubr (&Scar);
defsubr (&Scdr);
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;
#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 */
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;
&& 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)
/*&&& 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;
}
}
-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\
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 ();
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
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)
{
}
}
-#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
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\
return next_frame (frame, miniframe);
}
-#endif /* MULTI_FRAME */
+
\f
DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 1, "",
"Delete FRAME, permanently eliminating it from use.\n\
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);
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,
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. */
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));
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));
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));
}
+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;
+}
+
\f
DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1, 2, 0,
: 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);
f = XFRAME (frame);
}
+ /* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
#if 1
f = XFRAME (frame);
}
+ /* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
{
f = XFRAME (frame);
}
+ /* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
{
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))
{
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));
/*&&& 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");
Vdefault_frame_alist = Qnil;
defsubr (&Sframep);
- defsubr (&Slive_frame_p);
+ defsubr (&Sframe_live_p);
defsubr (&Sselect_frame);
defsubr (&Sselected_frame);
defsubr (&Swindow_frame);
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);
{ \
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
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;
{
/* 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))
{
/* 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
if (!NILP (Vquit_flag))
{
Vquit_flag = Qnil;
- unread_command_event = make_number (quit_char);
+ unread_command_events = Fcons (make_number (quit_char), Qnil);
}
}
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;
/* 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
{
{
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 ();
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 =
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
/ 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,
}
\f
-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 <MODIFIERS>mouse-<DIGIT>. 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;
-}
-\f
/* Store into *addr a value nonzero if terminal input chars are available.
Serves the purpose of ioctl (0, FIONREAD, addr)
but works even if FIONREAD does not exist.
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.
}
/* 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
*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);
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;
defining_kbd_macro = 0;
update_mode_lines++;
- unread_command_event = Qnil;
+ unread_command_events = Qnil;
discard_tty_input ();
clear_waiting_for_input ();
input_pending = 0;
- unread_command_event = Qnil;
+ unread_command_events = Qnil;
_longjmp (getcjmp, 1);
}
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;
defsubr (&Sread_key_sequence);
defsubr (&Srecursive_edit);
defsubr (&Strack_mouse);
- defsubr (&Smouse_click_p);
defsubr (&Sinput_pending_p);
defsubr (&Scommand_execute);
defsubr (&Srecent_keys);
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\
/* 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.
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;
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);
+ }
}
}
/* 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");
}
}
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;
}
/* 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.
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;
}
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
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 */ );
\f
/* Scrollbar hooks. */
/* 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;
\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;
{
\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;
{
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));
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))
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\
#ifdef HAVE_X_WINDOWS
extern void abort ();
+#include <X11/bitmaps/gray>
+
#define min(a,b) ((a) < (b) ? (a) : (b))
#define max(a,b) ((a) > (b) ? (a) : (b))
/* 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;
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;
/* 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;
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;
/* 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
- };
\f
/* Return the Emacs frame-object corresponding to an X window.
It could be the frame's main window or an icon window. */
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 ();
"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,
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);
}
}
+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;
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 */
"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
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");
"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;
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;
{
/* 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.
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;
val = Qnil;
- if (NILP (type) || EQ (type, Qprimary))
+ if (NILP (selection) || EQ (selection, Qprimary))
{
BLOCK_INPUT;
if (own_selection (XA_PRIMARY, event_time))
}
UNBLOCK_INPUT;
}
- else if (EQ (type, Qsecondary))
+ else if (EQ (selection, Qsecondary))
{
BLOCK_INPUT;
if (own_selection (XA_SECONDARY, event_time))
}
UNBLOCK_INPUT;
}
- else if (EQ (type, Qclipboard))
+ else if (EQ (selection, Qclipboard))
{
BLOCK_INPUT;
if (own_selection (Xatom_clipboard, event_time))
}
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");
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");
}
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);
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;
}
\f
-/* 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;
+ BLOCK_INPUT;
- if (updating_frame != 0)
- abort ();
+ {
+ GC gc;
- 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 */
+ /* Create a GC that will use the GXxor function to flip foreground pixels
+ into background pixels. */
+ {
+ XGCValues values;
- 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);
+ 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);
+ }
-#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) */
+ {
+ int width = PIXEL_WIDTH (f);
+ int height = PIXEL_HEIGHT (f);
- XFlushQueue ();
- UNBLOCK_INPUT;
-}
+ XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc,
+ width/4, height/4, width/2, height/2);
+ XFlush (x_current_display);
-/* Flip background and forground colors of the frame. */
+ {
+ struct timeval wakeup, now;
-x_invert_frame (f)
- struct frame *f;
-{
-#ifdef HAVE_X11
- GC temp;
- unsigned long pix_temp;
+ gettimeofday (&wakeup, (struct timezone *) 0);
- 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);
+ /* 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);
}
- redraw_frame (f);
-#endif /* ! defined (HAVE_X11) */
+ }
+
+ UNBLOCK_INPUT;
}
+#endif
+
+
/* Make audible bell. */
#ifdef HAVE_X11
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;
| 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,
}
+/* 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);
+}
+
+
\f
/* The main X event-reading loop - XTread_socket. */
break;
case ConfigureNotify:
- {
- int rows, columns;
- f = x_window_to_frame (event.xconfigure.window);
- if (!f)
- break;
-
- 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);
- }
+ 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);
+
+ /* 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:
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. */
&glyph, 1, highlight, f->display.x->font);
}
-/* 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. */
-
static void
-x_display_box_cursor (f, on)
+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_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. */
+
+static void
+x_display_box_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 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!)
&& (!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. */
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
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;
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 ();
}
\f
/* Icons. */
#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)
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;
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));
/* 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;
}
}
}
+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)
{
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);
}
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;
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. */
/* 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'
/* 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)
+
\f
/* 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
HCoop / bpt / emacs.git / commitdiff