mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00
Code Issues Releases Activity

JimB's changes since January 18th

Browse Source
This commit is contained in:
Jim Blandy 1993-01-26 01:58:16 +00:00
parent 7276614481
commit dbc4e1c129
49 changed files with 1120 additions and 876 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Makefile.in
View File

@ -231,7 +231,6 @@ lib-src/Makefile: ${srcdir}/lib-src/Makefile.in Makefile
-e 's|^LOADLIBES *=.*$$|LOADLIBES='"${libsrc_libs}"'|' \
-e '/^# DIST: /d') > lib-src/Makefile.tmp
${srcdir}/move-if-change lib-src/Makefile.tmp lib-src/Makefile
# Remind people not to edit this.
chmod -w lib-src/Makefile
src/Makefile: ${srcdir}/src/Makefile.in Makefile
@ -248,7 +247,6 @@ src/Makefile: ${srcdir}/src/Makefile.in Makefile
-e 's|^CONFIG_CFLAGS *=.*$$|CONFIG_CFLAGS='"${CONFIG_CFLAGS}"'|' \
-e '/^# DIST: /d') > src/Makefile.tmp
${srcdir}/move-if-change src/Makefile.tmp src/Makefile
# Remind people not to edit this.
chmod -w src/Makefile
oldXMenu/Makefile: ${srcdir}/oldXMenu/Makefile Makefile
@ -262,10 +260,10 @@ Makefile:
# ==================== Installation ====================
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
install: all mkdir
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
(cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir})
-set ${COPYDESTS} ; \
for dir in ${COPYDIR} ; do \
@ -297,10 +295,10 @@ install: all mkdir
-rm -f ${bindir}/emacs
ln ${bindir}/emacs-${version} ${bindir}/emacs
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
install.sysv: all mkdir
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
(cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir})
-set ${COPYDESTS} ; \
for dir in ${COPYDIR} ; do \
@ -330,10 +328,10 @@ install.sysv: all mkdir
-cpset src/emacs ${bindir}/emacs-${version} 1755 bin bin
-ln ${bindir}/emacs-${version} ${bindir}/emacs
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
install.xenix: all mkdir
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
(cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir})
-set ${COPYDESTS} ; \
for dir in ${COPYDIR} ; do \
@ -368,10 +366,10 @@ install.xenix: all mkdir
chmod 1755 ${bindir}/emacs
-rm -f ${bindir}/emacs.old
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
install.aix: all mkdir
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
(cd lib-src; $(MAKE) install ${MFLAGS} bindir=${bindir} libdir=${libdir})
-set ${COPYDESTS} ; \
for dir in ${COPYDIR} ; do \

2
lisp/comint.el
View File

@ -1091,7 +1091,7 @@ it just adds completion characters to the end of the filename."
(let ((ch (read-char)))
(if (= ch ?\ )
(set-window-configuration conf)
(setq unread-command-event ch))))))))
(setq unread-command-events (list ch)))))))))
;;; Converting process modes to use comint mode
;;; ===========================================================================

6
lisp/ebuff-menu.el
View File

@ -63,8 +63,8 @@ Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
(setq select
(catch 'electric-buffer-menu-select
(message "<<< Press Space to bury the buffer list >>>")
(if (= (setq unread-command-event (read-char)) ?\ )
(progn (setq unread-command-event nil)
(if (= (setq unread-command-events (list (read-char))) ?\ )
(progn (setq unread-command-events nil)
(throw 'electric-buffer-menu-select nil)))
(let ((first (progn (goto-char (point-min))
(forward-line 2)
@ -196,7 +196,7 @@ electric-buffer-menu-mode-hook if it is non-nil."
(defun Electric-buffer-menu-exit ()
(interactive)
(setq unread-command-event last-input-char)
(setq unread-command-events (list last-input-char))
;; for robustness
(condition-case ()
(throw 'electric-buffer-menu-select nil)

4
lisp/ehelp.el
View File

@ -119,8 +119,8 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit"
(catch 'exit
(if (pos-visible-in-window-p (point-max))
(progn (message "<<< Press Space to bury the help buffer >>>")
(if (= (setq unread-command-event (read-char)) ?\ )
(progn (setq unread-command-event nil)
(if (= (setq unread-command-events (list (read-char))) ?\ )
(progn (setq unread-command-events nil)
(throw 'exit t)))))
(let (up down both neither
(standard (and (eq (key-binding " ")

4
lisp/electric.el
View File

@ -85,7 +85,7 @@
cmd this-command)
(if (or (prog1 quit-flag (setq quit-flag nil))
(= last-input-char ?\C-g))
(progn (setq unread-command-event nil
(progn (setq unread-command-events nil
prefix-arg nil)
;; If it wasn't cancelling a prefix character, then quit.
(if (or (= (length (this-command-keys)) 1)
@ -101,7 +101,7 @@
(setq last-command this-command)
(if (or (prog1 quit-flag (setq quit-flag nil))
(= last-input-char ?\C-g))
(progn (setq unread-command-event nil)
(progn (setq unread-command-events nil)
(if (not inhibit-quit)
(progn (ding)
(message "Quit")

9
lisp/emacs-lisp/disass.el
View File

@ -41,6 +41,7 @@
(defvar disassemble-recursive-indent 3 "*")
;;;###autoload
(defun disassemble (object &optional buffer indent interactive-p)
"Print disassembled code for OBJECT in (optional) BUFFER.
OBJECT can be a symbol defined as a function, or a function itself
@ -136,7 +137,7 @@ redefine OBJECT if it is a symbol."
(insert "\n"))))
(cond ((and (consp obj) (assq 'byte-code obj))
(disassemble-1 (assq 'byte-code obj) indent))
((compiled-function-p obj)
((byte-code-function-p obj)
(disassemble-1 obj indent))
(t
(insert "Uncompiled body: ")
@ -195,14 +196,14 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
(setq arg (car arg))
;; but if the value of the constant is compiled code, then
;; recursively disassemble it.
(cond ((or (compiled-function-p arg)
(cond ((or (byte-code-function-p arg)
(and (eq (car-safe arg) 'lambda)
(assq 'byte-code arg))
(and (eq (car-safe arg) 'macro)
(or (compiled-function-p (cdr arg))
(or (byte-code-function-p (cdr arg))
(and (eq (car-safe (cdr arg)) 'lambda)
(assq 'byte-code (cdr arg))))))
(cond ((compiled-function-p arg)
(cond ((byte-code-function-p arg)
(insert "<compiled-function>\n"))
((eq (car-safe arg) 'lambda)
(insert "<compiled lambda>"))

2
lisp/emacs-lisp/edebug.el
View File

@ -1480,7 +1480,7 @@ Should be 0 at the top level.")
(last-command last-command)
(this-command this-command)
(last-input-char last-input-char)
;; Assume no edebug command sets unread-command-char.
;; Assume no edebug command sets unread-command-events.
;; (unread-command-char -1)
(debug-on-error debug-on-error)

2
lisp/emerge.el
View File

@ -2910,7 +2910,7 @@ SPC, it is ignored; if it is anything else, it is processed as a command."
(enlarge-window 1))
(let ((c (read-char)))
(if (/= c 32)
(setq unread-command-event c))))))))
(setq unread-command-events (list c)))))))))
;; Improved auto-save file names.
;; This function fixes many problems with the standard auto-save file names:

8
lisp/emulation/vip.el
View File

@ -333,9 +333,9 @@ vi mode. ARG is used as the prefix value for the executed command. If
CHAR is given it becomes the first character of the command."
(interactive "P")
(let (com (buff (current-buffer)) (first t))
(if char (setq unread-command-event char))
(if char (setq unread-command-events (list char)))
(setq prefix-arg arg)
(while (or first unread-command-event)
(while (or first unread-command-events)
;; this while loop is executed until unread command char will be
;; exhausted.
(setq first nil)
@ -393,7 +393,7 @@ obtained so far, and COM is the command part obtained so far."
(while (= char ?U)
(vip-describe-arg prefix-arg)
(setq char (read-char)))
(setq unread-command-event char))
(setq unread-command-events (list char)))
(defun vip-prefix-arg-com (char value com)
"Vi operator as prefix argument."
@ -447,7 +447,7 @@ obtained so far, and COM is the command part obtained so far."
(while (= char ?U)
(vip-describe-arg prefix-arg)
(setq char (read-char)))
(setq unread-command-event char))
(setq unread-command-events (list char)))
;; as com is non-nil, this means that we have a command to execute
(if (or (= (car com) ?r) (= (car com) ?R))
;; execute apropriate region command.

2
lisp/frame.el
View File

@ -113,7 +113,7 @@ These supercede the values given in default-frame-alist.")
;;; need to see if it should go away or change. Create a text frame
;;; here.
(defun frame-notice-user-settings ()
(if (live-frame-p frame-initial-frame)
(if (frame-live-p frame-initial-frame)
(progn
;; If the user wants a minibuffer-only frame, we'll have to
;; make a new one; you can't remove or add a root window to/from

2
lisp/gnus.el
View File

@ -2287,7 +2287,7 @@ If argument UNREAD is non-nil, only unread article is selected."
(let ((char (read-char)))
(if (= char cmd)
(gnus-Subject-next-group nil)
(setq unread-command-event char))))
(setq unread-command-events (list char)))))
)
))
)))

2
lisp/help.el
View File

@ -293,7 +293,7 @@ C-w print information on absence of warranty for GNU Emacs."
(princ (cond ((stringp def) "a keyboard macro.")
((subrp def)
(concat beg "built-in function."))
((compiled-function-p def)
((byte-code-function-p def)
(concat beg "compiled Lisp function."))
((symbolp def)
(format "alias for `%s'." def))

2
lisp/info.el
View File

@ -768,7 +768,7 @@ N is the digit argument used to invoke this command."
(message (if flag "Type Space to see more"
"Type Space to return to Info"))
(if (/= ?\ (setq ch (read-char)))
(progn (setq unread-command-event ch) nil)
(progn (setq unread-command-events (list ch)) nil)
flag))
(scroll-up)))))

16
lisp/isearch.el
View File

@ -4,7 +4,7 @@
;; LCD Archive Entry:
;; isearch-mode|Daniel LaLiberte|liberte@cs.uiuc.edu
;; |A minor mode replacement for isearch.el.
;; |$Date: 1992/11/07 06:17:04 $|$Revision: 1.15 $|~/modes/isearch-mode.el
;; |$Date: 1992/11/16 01:37:06 $|$Revision: 1.16 $|~/modes/isearch-mode.el
;; This file is not yet part of GNU Emacs, but it is based almost
;; entirely on isearch.el which is part of GNU Emacs.
@ -88,8 +88,15 @@
;;;====================================================================
;;; Change History
;;; $Header: /home/gd/gnu/emacs/19.0/lisp/RCS/isearch-mode.el,v 1.15 1992/11/07 06:17:04 jimb Exp jimb $
;;; $Header: /home/gd/gnu/emacs/19.0/lisp/RCS/isearch-mode.el,v 1.16 1992/11/16 01:37:06 jimb Exp jimb $
;;; $Log: isearch-mode.el,v $
; Revision 1.16 1992/11/16 01:37:06 jimb
; * bytecomp.el: Declare unread-command-char an obsolete variable.
; * vip.el (vip-escape-to-emacs, vip-prefix-arg-value,
; vip-prefix-arg-com): Use unread-command-event instead of
; unread-command-char; respect its new semantics.
; * isearch-mode.el (isearch-update, isearch-unread): Same.
;
; Revision 1.15 1992/11/07 06:17:04 jimb
; * isearch.el (isearch-frames-exist): This isn't what we want -
; replaced by...
@ -557,7 +564,7 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(if (if isearch-event-data-type
(null unread-command-event)
(if isearch-gnu-emacs-events
(null unread-command-event)
(null unread-command-events)
(< unread-command-char 0)))
(progn
(if (not (input-pending-p))
@ -1413,6 +1420,7 @@ have special meaning in a regexp."
;; To quiet the byte-compiler.
(defvar unread-command-event)
(defvar unread-command-events)
(defvar last-command-event)
(defun isearch-char-to-string (c)
@ -1429,7 +1437,7 @@ have special meaning in a regexp."
(isearch-event-data-type
(setq unread-command-event char-or-event))
(isearch-gnu-emacs-events
(setq unread-command-event char-or-event))
(setq unread-command-events (list char-or-event)))
(t
(setq unread-command-char char-or-event))))

4
lisp/map-ynp.el
View File

@ -100,7 +100,7 @@ the current %s and exit."
prompt char elt tail
(next (if (or (symbolp list)
(subrp list)
(compiled-function-p list)
(byte-code-function-p list)
(and (consp list)
(eq (car list) 'lambda)))
(function (lambda ()
@ -157,7 +157,7 @@ the current %s and exit."
(funcall actor elt)
(setq actions (1+ actions))))))
((= ?? char)
(setq unread-command-event help-char)
(setq unread-command-events (list help-char))
(setq next (` (lambda ()
(setq next '(, next))
'(, elt)))))

720
lisp/mouse.el
View File

@ -1,6 +1,6 @@
;;; mouse.el --- window system-independent mouse support.
;;; Copyright (C) 1988, 1992 Free Software Foundation, Inc.
;;; Copyright (C) 1988, 1992, 1993 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware
@ -40,11 +40,12 @@ The `posn-' functions access elements of such lists."
(nth 1 event))
(defsubst event-end (event)
"Return the ending location of EVENT. EVENT should be a drag event.
"Return the ending location of EVENT. EVENT should be a click or drag event.
If EVENT is a click event, this function is the same as `event-start'.
The return value is of the form
(WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
The `posn-' functions access elements of such lists."
(nth 2 event))
(nth (1- (length event)) event))
(defsubst posn-window (position)
"Return the window in POSITION.
@ -113,7 +114,7 @@ This command must be bound to a mouse click."
The window is split at the column clicked on.
This command must be bound to a mouse click."
(interactive "@e")
(split-window-horizontally (1+ (car (mouse-coords click)))))
(split-window-horizontally (1+ (car (posn-col-row (event-end click))))))
(defun mouse-set-point (click)
"Move point to the position clicked on with the mouse.
@ -173,6 +174,14 @@ This does not delete the region; it acts like \\[kill-ring-save]."
(mouse-set-mark click)
(call-interactively 'kill-ring-save))
;;; This function used to delete the text between point and the mouse
;;; whenever it was equal to the front of the kill ring, but some
;;; people found that confusing.
;;; A list (TEXT START END), describing the text and position of the last
;;; invocation of mouse-save-then-kill.
(defvar mouse-save-then-kill-posn nil)
(defun mouse-save-then-kill (click)
"Save text to point in kill ring; the second time, kill the text.
If the text between point and the mouse is the same as what's
@ -181,18 +190,24 @@ Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
which prepares for a second click to delete the text."
(interactive "e")
(let ((click-posn (posn-point (event-start click))))
(if (string= (buffer-substring (point) click-posn) (car kill-ring))
;; If this text was already saved in kill ring,
;; now delete it from the buffer.
(if (and (eq last-command 'kill-region)
mouse-save-then-kill-posn
(eq (car mouse-save-then-kill-posn) (car kill-ring))
(equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
;; If this is the second time we've called
;; mouse-save-then-kill, delete the text from the buffer.
(progn
(let ((buffer-undo-list t))
(delete-region (point) (mark)))
;; Make the undo list by hand so it is shared.
(setq buffer-undo-list
(cons (cons (car kill-ring) (point)) buffer-undo-list)))
(if (not (eq buffer-undo-list t))
(setq buffer-undo-list
(cons (cons (car kill-ring) (point)) buffer-undo-list))))
;; Otherwise, save this region.
(mouse-set-mark click)
(call-interactively 'kill-ring-save))))
(call-interactively 'kill-ring-save)
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))))
(defun mouse-buffer-menu (event)
"Pop up a menu of buffers for selection with the mouse.
@ -225,329 +240,331 @@ and selects that window."
(select-window window)
(switch-to-buffer buf))))))
;; Commands for the scroll bar.
;;; These need to be rewritten for the new scrollbar implementation.
(defun mouse-scroll-down (click)
(interactive "@e")
(scroll-down (1+ (cdr (mouse-coords click)))))
(defun mouse-scroll-up (click)
(interactive "@e")
(scroll-up (1+ (cdr (mouse-coords click)))))
(defun mouse-scroll-down-full ()
(interactive "@")
(scroll-down nil))
(defun mouse-scroll-up-full ()
(interactive "@")
(scroll-up nil))
(defun mouse-scroll-move-cursor (click)
(interactive "@e")
(move-to-window-line (1+ (cdr (mouse-coords click)))))
(defun mouse-scroll-absolute (event)
(interactive "@e")
(let* ((pos (car event))
(position (car pos))
(length (car (cdr pos))))
(if (<= length 0) (setq length 1))
(let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
(newpos (* (/ (* (/ (buffer-size) scale-factor)
position)
length)
scale-factor)))
(goto-char newpos)
(recenter '(4)))))
(defun mouse-scroll-left (click)
(interactive "@e")
(scroll-left (1+ (car (mouse-coords click)))))
(defun mouse-scroll-right (click)
(interactive "@e")
(scroll-right (1+ (car (mouse-coords click)))))
(defun mouse-scroll-left-full ()
(interactive "@")
(scroll-left nil))
(defun mouse-scroll-right-full ()
(interactive "@")
(scroll-right nil))
(defun mouse-scroll-move-cursor-horizontally (click)
(interactive "@e")
(move-to-column (1+ (car (mouse-coords click)))))
(defun mouse-scroll-absolute-horizontally (event)
(interactive "@e")
(let* ((pos (car event))
(position (car pos))
(length (car (cdr pos))))
(set-window-hscroll (selected-window) 33)))
(global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
(global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
(global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
(global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
(global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
(global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
(global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
(global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
(global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
(global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
(global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
(global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
(global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
(global-set-key [horizontal-scroll-bar mouse-2]
'mouse-scroll-absolute-horizontally)
(global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
(global-set-key [horizontal-slider mouse-1]
'mouse-scroll-move-cursor-horizontally)
(global-set-key [horizontal-slider mouse-2]
'mouse-scroll-move-cursor-horizontally)
(global-set-key [horizontal-slider mouse-3]
'mouse-scroll-move-cursor-horizontally)
(global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
(global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
(global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
(global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
(global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
(global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
(global-set-key [horizontal-scroll-bar S-mouse-2]
'mouse-split-window-horizontally)
(global-set-key [mode-line S-mouse-2]
'mouse-split-window-horizontally)
(global-set-key [vertical-scroll-bar S-mouse-2]
'mouse-split-window)
;;;!! ;; Commands for the scroll bar.
;;;!!
;;;!! (defun mouse-scroll-down (click)
;;;!! (interactive "@e")
;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
;;;!!
;;;!! (defun mouse-scroll-up (click)
;;;!! (interactive "@e")
;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
;;;!!
;;;!! (defun mouse-scroll-down-full ()
;;;!! (interactive "@")
;;;!! (scroll-down nil))
;;;!!
;;;!! (defun mouse-scroll-up-full ()
;;;!! (interactive "@")
;;;!! (scroll-up nil))
;;;!!
;;;!! (defun mouse-scroll-move-cursor (click)
;;;!! (interactive "@e")
;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
;;;!!
;;;!! (defun mouse-scroll-absolute (event)
;;;!! (interactive "@e")
;;;!! (let* ((pos (car event))
;;;!! (position (car pos))
;;;!! (length (car (cdr pos))))
;;;!! (if (<= length 0) (setq length 1))
;;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
;;;!! position)
;;;!! length)
;;;!! scale-factor)))
;;;!! (goto-char newpos)
;;;!! (recenter '(4)))))
;;;!!
;;;!! (defun mouse-scroll-left (click)
;;;!! (interactive "@e")
;;;!! (scroll-left (1+ (car (mouse-coords click)))))
;;;!!
;;;!! (defun mouse-scroll-right (click)
;;;!! (interactive "@e")
;;;!! (scroll-right (1+ (car (mouse-coords click)))))
;;;!!
;;;!! (defun mouse-scroll-left-full ()
;;;!! (interactive "@")
;;;!! (scroll-left nil))
;;;!!
;;;!! (defun mouse-scroll-right-full ()
;;;!! (interactive "@")
;;;!! (scroll-right nil))
;;;!!
;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
;;;!! (interactive "@e")
;;;!! (move-to-column (1+ (car (mouse-coords click)))))
;;;!!
;;;!! (defun mouse-scroll-absolute-horizontally (event)
;;;!! (interactive "@e")
;;;!! (let* ((pos (car event))
;;;!! (position (car pos))
;;;!! (length (car (cdr pos))))
;;;!! (set-window-hscroll (selected-window) 33)))
;;;!!
;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
;;;!!
;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
;;;!!
;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
;;;!!
;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
;;;!!
;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
;;;!! 'mouse-scroll-absolute-horizontally)
;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
;;;!!
;;;!! (global-set-key [horizontal-slider mouse-1]
;;;!! 'mouse-scroll-move-cursor-horizontally)
;;;!! (global-set-key [horizontal-slider mouse-2]
;;;!! 'mouse-scroll-move-cursor-horizontally)
;;;!! (global-set-key [horizontal-slider mouse-3]
;;;!! 'mouse-scroll-move-cursor-horizontally)
;;;!!
;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
;;;!!
;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
;;;!!
;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
;;;!! 'mouse-split-window-horizontally)
;;;!! (global-set-key [mode-line S-mouse-2]
;;;!! 'mouse-split-window-horizontally)
;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
;;;!! 'mouse-split-window)
;;;;
;;;; Here are experimental things being tested. Mouse events
;;;; are of the form:
;;;; ((x y) window screen-part key-sequence timestamp)
;;
;;;;
;;;; Dynamically track mouse coordinates
;;;;
;;
;;(defun track-mouse (event)
;; "Track the coordinates, absolute and relative, of the mouse."
;; (interactive "@e")
;; (while mouse-grabbed
;; (let* ((pos (read-mouse-position (selected-screen)))
;; (abs-x (car pos))
;; (abs-y (cdr pos))
;; (relative-coordinate (coordinates-in-window-p
;; (list (car pos) (cdr pos))
;; (selected-window))))
;; (if (consp relative-coordinate)
;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
;; (car relative-coordinate)
;; (car (cdr relative-coordinate)))
;; (message "mouse: [%d %d]" abs-x abs-y)))))
;;
;; Dynamically put a box around the line indicated by point
;;
;;
;;(require 'backquote)
;;
;;(defun mouse-select-buffer-line (event)
;; (interactive "@e")
;; (let ((relative-coordinate
;; (coordinates-in-window-p (car event) (selected-window)))
;; (abs-y (car (cdr (car event)))))
;; (if (consp relative-coordinate)
;; (progn
;; (save-excursion
;; (move-to-window-line (car (cdr relative-coordinate)))
;; (x-draw-rectangle
;; (selected-screen)
;; abs-y 0
;; (save-excursion
;; (move-to-window-line (car (cdr relative-coordinate)))
;; (end-of-line)
;; (push-mark nil t)
;; (beginning-of-line)
;; (- (region-end) (region-beginning))) 1))
;; (sit-for 1)
;; (x-erase-rectangle (selected-screen))))))
;;
;;(defvar last-line-drawn nil)
;;(defvar begin-delim "[^ \t]")
;;(defvar end-delim "[^ \t]")
;;
;;(defun mouse-boxing (event)
;; (interactive "@e")
;; (save-excursion
;; (let ((screen (selected-screen)))
;; (while (= (x-mouse-events) 0)
;; (let* ((pos (read-mouse-position screen))
;; (abs-x (car pos))
;; (abs-y (cdr pos))
;; (relative-coordinate
;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
;; (selected-window)))
;; (begin-reg nil)
;; (end-reg nil)
;; (end-column nil)
;; (begin-column nil))
;; (if (and (consp relative-coordinate)
;; (or (not last-line-drawn)
;; (not (= last-line-drawn abs-y))))
;; (progn
;; (move-to-window-line (car (cdr relative-coordinate)))
;; (if (= (following-char) 10)
;; ()
;; (progn
;; (setq begin-reg (1- (re-search-forward end-delim)))
;; (setq begin-column (1- (current-column)))
;; (end-of-line)
;; (setq end-reg (1+ (re-search-backward begin-delim)))
;; (setq end-column (1+ (current-column)))
;; (message "%s" (buffer-substring begin-reg end-reg))
;; (x-draw-rectangle screen
;; (setq last-line-drawn abs-y)
;; begin-column
;; (- end-column begin-column) 1))))))))))
;;
;;(defun mouse-erase-box ()
;; (interactive)
;; (if last-line-drawn
;; (progn
;; (x-erase-rectangle (selected-screen))
;; (setq last-line-drawn nil))))
;;; (defun test-x-rectangle ()
;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
;;
;; Here is how to do double clicking in lisp. About to change.
;;
(defvar double-start nil)
(defconst double-click-interval 300
"Max ticks between clicks")
(defun double-down (event)
(interactive "@e")
(if double-start
(let ((interval (- (nth 4 event) double-start)))
(if (< interval double-click-interval)
(progn
(backward-up-list 1)
;; (message "Interval %d" interval)
(sleep-for 1)))
(setq double-start nil))
(setq double-start (nth 4 event))))
(defun double-up (event)
(interactive "@e")
(and double-start
(> (- (nth 4 event ) double-start) double-click-interval)
(setq double-start nil)))
;;; (defun x-test-doubleclick ()
;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
;;
;; This scrolls while button is depressed. Use preferable in scrollbar.
;;
(defvar scrolled-lines 0)
(defconst scroll-speed 1)
(defun incr-scroll-down (event)
(interactive "@e")
(setq scrolled-lines 0)
(incremental-scroll scroll-speed))
(defun incr-scroll-up (event)
(interactive "@e")
(setq scrolled-lines 0)
(incremental-scroll (- scroll-speed)))
(defun incremental-scroll (n)
(while (= (x-mouse-events) 0)
(setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
(scroll-down n)
(sit-for 300 t)))
(defun incr-scroll-stop (event)
(interactive "@e")
(message "Scrolled %d lines" scrolled-lines)
(setq scrolled-lines 0)
(sleep-for 1))
;;; (defun x-testing-scroll ()
;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
;;
;; Some playthings suitable for picture mode? They need work.
;;
(defun mouse-kill-rectangle (event)
"Kill the rectangle between point and the mouse cursor."
(interactive "@e")
(let ((point-save (point)))
(save-excursion
(mouse-set-point event)
(push-mark nil t)
(if (> point-save (point))
(kill-rectangle (point) point-save)
(kill-rectangle point-save (point))))))
(defun mouse-open-rectangle (event)
"Kill the rectangle between point and the mouse cursor."
(interactive "@e")
(let ((point-save (point)))
(save-excursion
(mouse-set-point event)
(push-mark nil t)
(if (> point-save (point))
(open-rectangle (point) point-save)
(open-rectangle point-save (point))))))
;; Must be a better way to do this.
(defun mouse-multiple-insert (n char)
(while (> n 0)
(insert char)
(setq n (1- n))))
;; What this could do is not finalize until button was released.
(defun mouse-move-text (event)
"Move text from point to cursor position, inserting spaces."
(interactive "@e")
(let* ((relative-coordinate
(coordinates-in-window-p (car event) (selected-window))))
(if (consp relative-coordinate)
(cond ((> (current-column) (car relative-coordinate))
(delete-char
(- (car relative-coordinate) (current-column))))
((< (current-column) (car relative-coordinate))
(mouse-multiple-insert
(- (car relative-coordinate) (current-column)) " "))
((= (current-column) (car relative-coordinate)) (ding))))))
;;;!! ;;;;
;;;!! ;;;; Here are experimental things being tested. Mouse events
;;;!! ;;;; are of the form:
;;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
;;;!! ;;
;;;!! ;;;;
;;;!! ;;;; Dynamically track mouse coordinates
;;;!! ;;;;
;;;!! ;;
;;;!! ;;(defun track-mouse (event)
;;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
;;;!! ;; (interactive "@e")
;;;!! ;; (while mouse-grabbed
;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
;;;!! ;; (abs-x (car pos))
;;;!! ;; (abs-y (cdr pos))
;;;!! ;; (relative-coordinate (coordinates-in-window-p
;;;!! ;; (list (car pos) (cdr pos))
;;;!! ;; (selected-window))))
;;;!! ;; (if (consp relative-coordinate)
;;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
;;;!! ;; (car relative-coordinate)
;;;!! ;; (car (cdr relative-coordinate)))
;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
;;;!!
;;;!! ;;
;;;!! ;; Dynamically put a box around the line indicated by point
;;;!! ;;
;;;!! ;;
;;;!! ;;(require 'backquote)
;;;!! ;;
;;;!! ;;(defun mouse-select-buffer-line (event)
;;;!! ;; (interactive "@e")
;;;!! ;; (let ((relative-coordinate
;;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
;;;!! ;; (abs-y (car (cdr (car event)))))
;;;!! ;; (if (consp relative-coordinate)
;;;!! ;; (progn
;;;!! ;; (save-excursion
;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
;;;!! ;; (x-draw-rectangle
;;;!! ;; (selected-screen)
;;;!! ;; abs-y 0
;;;!! ;; (save-excursion
;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
;;;!! ;; (end-of-line)
;;;!! ;; (push-mark nil t)
;;;!! ;; (beginning-of-line)
;;;!! ;; (- (region-end) (region-beginning))) 1))
;;;!! ;; (sit-for 1)
;;;!! ;; (x-erase-rectangle (selected-screen))))))
;;;!! ;;
;;;!! ;;(defvar last-line-drawn nil)
;;;!! ;;(defvar begin-delim "[^ \t]")
;;;!! ;;(defvar end-delim "[^ \t]")
;;;!! ;;
;;;!! ;;(defun mouse-boxing (event)
;;;!! ;; (interactive "@e")
;;;!! ;; (save-excursion
;;;!! ;; (let ((screen (selected-screen)))
;;;!! ;; (while (= (x-mouse-events) 0)
;;;!! ;; (let* ((pos (read-mouse-position screen))
;;;!! ;; (abs-x (car pos))
;;;!! ;; (abs-y (cdr pos))
;;;!! ;; (relative-coordinate
;;;!! ;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
;;;!! ;; (selected-window)))
;;;!! ;; (begin-reg nil)
;;;!! ;; (end-reg nil)
;;;!! ;; (end-column nil)
;;;!! ;; (begin-column nil))
;;;!! ;; (if (and (consp relative-coordinate)
;;;!! ;; (or (not last-line-drawn)
;;;!! ;; (not (= last-line-drawn abs-y))))
;;;!! ;; (progn
;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
;;;!! ;; (if (= (following-char) 10)
;;;!! ;; ()
;;;!! ;; (progn
;;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
;;;!! ;; (setq begin-column (1- (current-column)))
;;;!! ;; (end-of-line)
;;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
;;;!! ;; (setq end-column (1+ (current-column)))
;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
;;;!! ;; (x-draw-rectangle screen
;;;!! ;; (setq last-line-drawn abs-y)
;;;!! ;; begin-column
;;;!! ;; (- end-column begin-column) 1))))))))))
;;;!! ;;
;;;!! ;;(defun mouse-erase-box ()
;;;!! ;; (interactive)
;;;!! ;; (if last-line-drawn
;;;!! ;; (progn
;;;!! ;; (x-erase-rectangle (selected-screen))
;;;!! ;; (setq last-line-drawn nil))))
;;;!!
;;;!! ;;; (defun test-x-rectangle ()
;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
;;;!!
;;;!! ;;
;;;!! ;; Here is how to do double clicking in lisp. About to change.
;;;!! ;;
;;;!!
;;;!! (defvar double-start nil)
;;;!! (defconst double-click-interval 300
;;;!! "Max ticks between clicks")
;;;!!
;;;!! (defun double-down (event)
;;;!! (interactive "@e")
;;;!! (if double-start
;;;!! (let ((interval (- (nth 4 event) double-start)))
;;;!! (if (< interval double-click-interval)
;;;!! (progn
;;;!! (backward-up-list 1)
;;;!! ;; (message "Interval %d" interval)
;;;!! (sleep-for 1)))
;;;!! (setq double-start nil))
;;;!! (setq double-start (nth 4 event))))
;;;!!
;;;!! (defun double-up (event)
;;;!! (interactive "@e")
;;;!! (and double-start
;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
;;;!! (setq double-start nil)))
;;;!!
;;;!! ;;; (defun x-test-doubleclick ()
;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
;;;!!
;;;!! ;;
;;;!! ;; This scrolls while button is depressed. Use preferable in scrollbar.
;;;!! ;;
;;;!!
;;;!! (defvar scrolled-lines 0)
;;;!! (defconst scroll-speed 1)
;;;!!
;;;!! (defun incr-scroll-down (event)
;;;!! (interactive "@e")
;;;!! (setq scrolled-lines 0)
;;;!! (incremental-scroll scroll-speed))
;;;!!
;;;!! (defun incr-scroll-up (event)
;;;!! (interactive "@e")
;;;!! (setq scrolled-lines 0)
;;;!! (incremental-scroll (- scroll-speed)))
;;;!!
;;;!! (defun incremental-scroll (n)
;;;!! (while (= (x-mouse-events) 0)
;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
;;;!! (scroll-down n)
;;;!! (sit-for 300 t)))
;;;!!
;;;!! (defun incr-scroll-stop (event)
;;;!! (interactive "@e")
;;;!! (message "Scrolled %d lines" scrolled-lines)
;;;!! (setq scrolled-lines 0)
;;;!! (sleep-for 1))
;;;!!
;;;!! ;;; (defun x-testing-scroll ()
;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
;;;!!
;;;!! ;;
;;;!! ;; Some playthings suitable for picture mode? They need work.
;;;!! ;;
;;;!!
;;;!! (defun mouse-kill-rectangle (event)
;;;!! "Kill the rectangle between point and the mouse cursor."
;;;!! (interactive "@e")
;;;!! (let ((point-save (point)))
;;;!! (save-excursion
;;;!! (mouse-set-point event)
;;;!! (push-mark nil t)
;;;!! (if (> point-save (point))
;;;!! (kill-rectangle (point) point-save)
;;;!! (kill-rectangle point-save (point))))))
;;;!!
;;;!! (defun mouse-open-rectangle (event)
;;;!! "Kill the rectangle between point and the mouse cursor."
;;;!! (interactive "@e")
;;;!! (let ((point-save (point)))
;;;!! (save-excursion
;;;!! (mouse-set-point event)
;;;!! (push-mark nil t)
;;;!! (if (> point-save (point))
;;;!! (open-rectangle (point) point-save)
;;;!! (open-rectangle point-save (point))))))
;;;!!
;;;!! ;; Must be a better way to do this.
;;;!!
;;;!! (defun mouse-multiple-insert (n char)
;;;!! (while (> n 0)
;;;!! (insert char)
;;;!! (setq n (1- n))))
;;;!!
;;;!! ;; What this could do is not finalize until button was released.
;;;!!
;;;!! (defun mouse-move-text (event)
;;;!! "Move text from point to cursor position, inserting spaces."
;;;!! (interactive "@e")
;;;!! (let* ((relative-coordinate
;;;!! (coordinates-in-window-p (car event) (selected-window))))
;;;!! (if (consp relative-coordinate)
;;;!! (cond ((> (current-column) (car relative-coordinate))
;;;!! (delete-char
;;;!! (- (car relative-coordinate) (current-column))))
;;;!! ((< (current-column) (car relative-coordinate))
;;;!! (mouse-multiple-insert
;;;!! (- (car relative-coordinate) (current-column)) " "))
;;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
;; Font selection.
@ -604,44 +621,47 @@ and selects that window."
)
"X fonts suitable for use in Emacs.")
(defun mouse-set-font (font)
(defun mouse-set-font (&optional font)
"Select an emacs font from a list of known good fonts"
(interactive
(x-popup-menu last-nonmenu-event x-fixed-font-alist))
(modify-frame-parameters (selected-frame)
(list (cons 'font font))))
(if font
(modify-frame-parameters (selected-frame)
(list (cons 'font font)))))
;;; Bindings for mouse commands.
;; This won't be needed once the drag and down events
;; are properly implemented.
(global-set-key [mouse-1] 'mouse-set-point)
(global-set-key [mouse-1] 'mouse-set-point)
(global-set-key [drag-mouse-1] 'mouse-set-region)
(global-set-key [mouse-2] 'mouse-yank-at-click)
(global-set-key [mouse-3] 'mouse-save-then-kill)
(global-set-key [drag-mouse-1] 'mouse-set-region)
(global-set-key [mouse-2] 'mouse-yank-at-click)
(global-set-key [mouse-3] 'mouse-save-then-kill)
(global-set-key [C-mouse-1] 'mouse-buffer-menu)
(global-set-key [C-mouse-3] 'mouse-set-font)
;; By binding these to down-going events, we let the user use the up-going
;; event to make the selection, saving a click.
(global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
(global-set-key [C-down-mouse-3] 'mouse-set-font)
;; Replaced with dragging mouse-1
;; (global-set-key [S-mouse-1] 'mouse-set-mark)
(global-set-key [mode-line mouse-1] 'mouse-delete-other-windows)
(global-set-key [mode-line mouse-3] 'mouse-delete-window)
(global-set-key [mode-line mouse-1] 'mouse-delete-other-windows)
(global-set-key [mode-line mouse-3] 'mouse-delete-window)
(global-set-key [mode-line S-mouse-2] 'mouse-split-window-horizontally)
;; Define the mouse help menu tree.
(defvar help-menu-map '(keymap "Help"))
(global-set-key [C-mouse-2] help-menu-map)
(global-set-key [C-down-mouse-2] help-menu-map)
(defvar help-apropos-map '(keymap "Is there a command that..."))
(defvar help-keys-map '(keymap "Key Commands <==> Functions"))
(defvar help-manual-map '(keymap "Manual and tutorial"))
(defvar help-misc-map '(keymap "Odds and ends"))
(defvar help-modes-map '(keymap "Modes"))
(defvar help-admin-map '(keymap "Administrivia"))
(defvar help-apropos-map (make-sparse-keymap "Is there a command that..."))
(defvar help-keys-map (make-sparse-keymap "Key Commands <==> Functions"))
(defvar help-manual-map (make-sparse-keymap "Manual and tutorial"))
(defvar help-misc-map (make-sparse-keymap "Odds and ends"))
(defvar help-modes-map (make-sparse-keymap "Modes"))
(defvar help-admin-map (make-sparse-keymap "Administrivia"))
(define-key help-menu-map [apropos]
(cons "@Is there a command that..." help-apropos-map))

10
lisp/progmodes/c-mode.el
View File

@ -322,11 +322,13 @@ preserving the comment indentation or line-starting decorations."
(paragraph-start
;; Lines containing just a comment start or just an end
;; should not be filled into paragraphs they are next to.
(concat paragraph-start
"\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[^ \t/*]"))
(concat
paragraph-start
"\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[ \t/*]*$"))
(paragraph-separate
(concat paragraph-separate
"\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[^ \t/*]"))
(concat
paragraph-separate
"\\|^[ \t]*/\\*[ \t]*$\\|^[ \t]*\\*/[ \t]*$\\|^[ \t/*]*$"))
(chars-to-delete 0))
(save-restriction
;; Don't fill the comment together with the code following it.

6
lisp/progmodes/fortran.el
View File

@ -39,7 +39,7 @@
;;; This file may be used with GNU Emacs version 18.xx if the following
;;; variable and function substutions are made.
;;; Replace:
;;; unread-command-event with unread-command-char
;;; unread-command-events with unread-command-char
;;; frame-width with screen-width
;;; auto-fill-function with auto-fill-hook
@ -469,7 +469,7 @@ Any other key combination is executed normally."
(if (or (= (setq c (read-char)) ??) ;insert char if not equal to `?'
(= c help-char))
(fortran-abbrev-help)
(setq unread-command-event c))))
(setq unread-command-events (list c)))))
(defun fortran-abbrev-help ()
"List the currently defined abbrevs in Fortran mode."
@ -535,7 +535,7 @@ See also `fortran-window-create'."
(progn (message "Type SPC to continue editing.")
(let ((char (read-char)))
(or (equal char (string-to-char " "))
(setq unread-command-event char))))))
(setq unread-command-events (list char)))))))
(fortran-window-create)))
(defun fortran-split-line ()

2
lisp/progmodes/simula.el
View File

@ -401,7 +401,7 @@ The relative indentation among the lines of the statement are preserved."
(case-fold-search t)
;; don't mix a label with an assignment operator := :-
;; therefore look at next typed character...
(next-char (setq unread-command-event (read-char)))
(next-char (setq unread-command-events (list (read-char))))
(com-char last-command-char))
(unwind-protect
;; Problem: find out if character just read is a command char

8
lisp/scroll-bar.el
View File

@ -21,6 +21,8 @@
;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(require 'mouse)
;;;; Utilities.
@ -43,7 +45,7 @@ that scrollbar position."
"Set the window start according to where the scrollbar is dragged.
EVENT should be a scrollbar click or drag event."
(interactive "e")
(let* ((end-position (nth (1- (length event)) event))
(let* ((end-position (event-end event))
(window (nth 0 end-position))
(portion-whole (nth 2 end-position)))
(save-excursion
@ -60,7 +62,7 @@ EVENT should be a scrollbar click."
(let ((old-selected-window (selected-window)))
(unwind-protect
(progn
(let* ((end-position (nth (1- (length event)) event))
(let* ((end-position (event-end event))
(window (nth 0 end-position))
(portion-whole (nth 2 end-position)))
(select-window window)
@ -75,7 +77,7 @@ EVENT should be a scrollbar click."
(let ((old-selected-window (selected-window)))
(unwind-protect
(progn
(let* ((end-position (nth (1- (length event)) event))
(let* ((end-position (event-end event))
(window (nth 0 end-position))
(portion-whole (nth 2 end-position)))
(select-window window)

13
lisp/simple.el
View File

@ -59,7 +59,10 @@ With arg N, insert N newlines."
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
You may also type up to 3 octal digits, to insert a character with that code"
You may also type up to 3 octal digits, to insert a character with that code.
`quoted-insert' inserts the character even in overstrike mode; if you
use overstrike as your normal editing mode, you can use this function
to insert characters when necessary."
(interactive "*p")
(let ((char (read-quoted-char)))
(while (> arg 0)
@ -789,13 +792,7 @@ Repeating \\[universal-argument] without digits or minus sign
(progn
(describe-arg value sign)
(setq key (read-key-sequence nil t))))
(if (= (length key) 1)
;; Make sure self-insert-command finds the proper character;
;; unread the character and let the command loop process it.
(setq unread-command-event (aref key 0))
;; We can't push back a longer string, so we'll emulate the
;; command loop ourselves.
(command-execute (key-binding key)))))
(setq unread-command-events (append key '()))))
(defun describe-arg (value sign)
(cond ((numberp value)

6
lisp/subr.el
View File

@ -65,7 +65,7 @@ Optional argument PROMPT specifies a string to use to prompt the user."
(and prompt (message (setq prompt
(format "%s %c" prompt char)))))
((> count 0)
(setq unread-command-event char count 259))
(setq unread-command-events (list char) count 259))
(t (setq code char count 259))))
(logand 255 code)))
@ -222,6 +222,7 @@ Accept any number of arguments, but ignore them."
(fset 'show-buffer 'set-window-buffer)
(fset 'buffer-flush-undo 'buffer-disable-undo)
(fset 'eval-current-buffer 'eval-buffer)
(fset 'compiled-function-p 'byte-code-function-p)
; alternate names
(fset 'string= 'string-equal)
@ -229,7 +230,6 @@ Accept any number of arguments, but ignore them."
(fset 'move-marker 'set-marker)
(fset 'eql 'eq)
(fset 'not 'null)
(fset 'numberp 'integerp)
(fset 'rplaca 'setcar)
(fset 'rplacd 'setcdr)
(fset 'beep 'ding) ;preserve lingual purtity
@ -325,7 +325,7 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
(single-key-description exit-char))
(let ((char (read-char)))
(or (eq char exit-char)
(setq unread-command-event char))))
(setq unread-command-events (list char)))))
(if insert-end
(save-excursion
(delete-region pos insert-end)))

6
lisp/term/sun-mouse.el
View File

@ -318,12 +318,14 @@ but that uses minibuffer, and mucks up last-command."
(let ((pc1 (read-char)))
(if (or (not (equal pc1 mouse-prefix1))
(sit-for-millisecs 3)) ; a mouse prefix will have second char
(progn (setq unread-command-event pc1) ; Can get away with one unread.
;; Can get away with one unread.
(progn (setq unread-command-events (list pc1))
nil) ; Next input not mouse event.
(let ((pc2 (read-char)))
(if (not (equal pc2 mouse-prefix2))
(progn (setq unread-command-event pc1) ; put back the ^X
(progn (setq unread-command-events (list pc1)) ; put back the ^X
;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2))
;;; Well, now we can, but I don't understand this code well enough to fix it...
(ding) ; user will have to retype that pc2.
nil) ; This input is not a mouse event.
;; Next input has mouse prefix and is within time limit.

2
lisp/terminal.el
View File

@ -223,7 +223,7 @@ Other chars following \"%s\" are interpreted as follows:\n"
;; not used.
(defun te-escape-extended-command-unread ()
(interactive)
(setq unread-command-event last-input-char)
(setq unread-command-events (list last-input-char))
(te-escape-extended-command))
(defun te-set-escape-char (c)

13
src/Makefile.in
View File

@ -47,14 +47,17 @@ temacs: dotemacs
dotemacs: xmakefile
$(MAKE) CC='${CC}' -f xmakefile ${MFLAGS} temacs
# If you have a problem with cc -E here, changing
# the definition of CPP above may fix it.
### Some makes, like Ultrix's make, complain if you put a comment in
### the middle of a rule's command list! Dummies.
### The flags for optimization and debugging depend on the
### system, so take an ordinary CFLAGS value and choose the
### appropriate CPP symbols to use in ymakefile.
### If you have a problem with cc -E here, changing
### the definition of CPP above may fix it.
xmakefile: ymakefile config.h
-rm -f xmakefile xmakefile.new junk.c junk.cpp
cp ymakefile junk.c
## The flags for optimization and debugging depend on the
## system, so take an ordinary CFLAGS value and choose the
## appropriate CPP symbols to use in ymakefile.
$(CPP) junk.c > junk.cpp \
-DC_SWITCH_SITE="`echo ${CFLAGS}' ' \
| sed -e 's/-g /C_DEBUG_SWITCH /' \

15
src/buffer.c
View File

@ -112,8 +112,9 @@ Lisp_Object Vbuffer_alist;
Lisp_Object Vbefore_change_function;
Lisp_Object Vafter_change_function;
/* Function to call before changing an unmodified buffer. */
Lisp_Object Vfirst_change_function;
/* List of functions to call before changing an unmodified buffer. */
Lisp_Object Vfirst_change_hook;
Lisp_Object Qfirst_change_hook;
Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
@ -1655,10 +1656,12 @@ While executing the `after-change-function', changes to buffers do not\n\
cause calls to any `before-change-function' or `after-change-function'.");
Vafter_change_function = Qnil;
DEFVAR_LISP ("first-change-function", &Vfirst_change_function,
"Function to call before changing a buffer which is unmodified.\n\
The function is called, with no arguments, if it is non-nil.");
Vfirst_change_function = Qnil;
DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook,
"A list of functions to call before changing a buffer which is unmodified.\n\
The functions are run using the `run-hooks' function.");
Vfirst_change_hook = Qnil;
Qfirst_change_hook = intern ("first-change-hook");
staticpro (&Qfirst_change_hook);
DEFVAR_PER_BUFFER ("buffer-undo-list", &current_buffer->undo_list, Qnil,
"List of undo entries in current buffer.\n\

3
src/buffer.h
View File

@ -340,7 +340,8 @@ extern void reset_buffer ();
/* Functions to call before and after each text change. */
extern Lisp_Object Vbefore_change_function;
extern Lisp_Object Vafter_change_function;
extern Lisp_Object Vfirst_change_function;
extern Lisp_Object Vfirst_change_hook;
extern Lisp_Object Qfirst_change_hook;
/* Fields.

43
src/callint.c
View File

@ -1,11 +1,11 @@
/* Call a Lisp function interactively.
Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
@ -89,10 +89,11 @@ X -- Lisp expression read and evaluated.\n\
In addition, if the string begins with `*'\n\
then an error is signaled if the buffer is read-only.\n\
This happens before reading any arguments.\n\
If the string begins with `@', then the window the mouse is over is selected\n\
before anything else is done. You may use both `@' and `*';\n\
they are processed in the order that they appear."
*/
If the string begins with `@', then Emacs searches the key sequence\n\
which invoked the command for its first mouse click (or any other\n\
event which specifies a window), and selects that window before\n\
reading any arguments. You may use both `@' and `*'; they are\n\
processed in the order that they appear." */
/* ARGSUSED */
DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
@ -167,7 +168,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
/* The index of the next element of this_command_keys to examine for
the 'e' interactive code. */
int next_event = 0;
int next_event;
Lisp_Object prefix_arg;
unsigned char *string;
@ -296,6 +297,12 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
/* Here if function specifies a string to control parsing the defaults */
/* Set next_event to point to the first event with parameters. */
for (next_event = 0; next_event < this_command_key_count; next_event++)
if (EVENT_HAS_PARAMETERS
(XVECTOR (this_command_keys)->contents[next_event]))
break;
/* Handle special starting chars `*' and `@'. */
while (1)
{
@ -307,9 +314,15 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
}
else if (*string == '@')
{
Lisp_Object event =
XVECTOR (this_command_keys)->contents[next_event];
if (EVENT_HAS_PARAMETERS (event)
&& XTYPE (event = XCONS (event)->cdr) == Lisp_Cons
&& XTYPE (event = XCONS (event)->car) == Lisp_Cons
&& XTYPE (event = XCONS (event)->car) == Lisp_Window)
Fselect_window (event);
string++;
if (!NILP (Vmouse_window))
Fselect_window (Vmouse_window);
}
else break;
}
@ -433,11 +446,6 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
break;
case 'e': /* The invoking event. */
/* Find the next parameterized event. */
while (next_event < this_command_key_count
&& ! (EVENT_HAS_PARAMETERS
(XVECTOR (this_command_keys)->contents[next_event])))
next_event++;
if (next_event >= this_command_key_count)
error ("%s must be bound to an event with parameters",
(XTYPE (function) == Lisp_Symbol
@ -445,6 +453,13 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
: "command"));
args[i] = XVECTOR (this_command_keys)->contents[next_event++];
varies[i] = -1;
/* Find the next parameterized event. */
while (next_event < this_command_key_count
&& ! (EVENT_HAS_PARAMETERS
(XVECTOR (this_command_keys)->contents[next_event])))
next_event++;
break;
case 'm': /* Value of mark. Does not do I/O. */

6
src/commands.h
View File

@ -49,12 +49,12 @@ extern Lisp_Object last_command_char;
reached by the mouse. */
extern Lisp_Object last_nonmenu_event;
/* Command event to be re-read, or Qnil. */
extern Lisp_Object unread_command_event;
/* List of command events to be re-read, or Qnil. */
extern Lisp_Object unread_command_events;
/* If not Qnil, this is a switch-frame event which we decided to put
off until the end of a key sequence. This should be read as the
next command input, after any unread_command_event.
next command input, after any unread_command_events.
read_key_sequence uses this to delay switch-frame events until the
end of the key sequence; Fread_char uses it to put off switch-frame

20
src/data.c
View File

@ -256,8 +256,8 @@ DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.")
return Qnil;
}
DEFUN ("compiled-function-p", Fcompiled_function_p, Scompiled_function_p,
1, 1, 0, "T if OBJECT is a compiled function object.")
DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
1, 1, 0, "T if OBJECT is a byte-compiled function object.")
(obj)
Lisp_Object obj;
{
@ -308,13 +308,10 @@ DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
(obj)
Lisp_Object obj;
{
if (0
#ifdef LISP_FLOAT_TYPE
|| XTYPE (obj) == Lisp_Float
#endif
|| XTYPE (obj) == Lisp_Int)
if (NUMBERP (obj))
return Qt;
return Qnil;
else
return Qnil;
}
DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
@ -323,10 +320,7 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
(obj)
Lisp_Object obj;
{
if (XTYPE (obj) == Lisp_Int
#ifdef LISP_FLOAT_TYPE
|| XTYPE (obj) == Lisp_Float
#endif
if (NUMBERP (obj)
|| XTYPE (obj) == Lisp_Marker)
return Qt;
return Qnil;
@ -2037,7 +2031,7 @@ syms_of_data ()
defsubr (&Sbufferp);
defsubr (&Smarkerp);
defsubr (&Ssubrp);
defsubr (&Scompiled_function_p);
defsubr (&Sbyte_code_function_p);
defsubr (&Schar_or_string_p);
defsubr (&Scar);
defsubr (&Scdr);

17
src/dispnew.c
View File

@ -173,7 +173,22 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "",
for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
{
frame = XCONS (tail)->car;
if (FRAME_VISIBLE_P (XFRAME (frame)))
/* If we simply redrew all visible frames, whether or not they
were garbaged, then this would make all frames clear and
redraw whenever a new frame is created or an existing frame
is de-iconified; those events set the global frame_garbaged
flag, to which redisplay responds by calling this function.
This used to redraw all visible frames; the only advantage of
that approach is that if a frame changes from invisible to
visible without setting its garbaged flag, it still gets
redisplayed. But that should never happen; since invisible
frames are not updated, they should always be marked as
garbaged when they become visible again. If that doesn't
happen, it's a bug in the visibility code, not a bug here. */
if (FRAME_VISIBLE_P (XFRAME (frame))
&& FRAME_GARBAGED_P (XFRAME (frame)))
Fredraw_frame (frame);
}
return Qnil;

4
src/emacs.c
View File

@ -519,10 +519,8 @@ main (argc, argv, envp)
#ifdef HAVE_X11
syms_of_xselect ();
#endif
#ifdef HAVE_X_WINDOWS
#ifndef NO_X_MENU
#ifdef HAVE_X_MENU
syms_of_xmenu ();
#endif /* not NO_X_MENU */
#endif /* HAVE_X_MENU */
#endif /* HAVE_X_WINDOWS */

9
src/fns.c
View File

@ -836,8 +836,12 @@ internal_equal (o1, o2, depth)
error ("Stack overflow in equal");
do_cdr:
QUIT;
if (EQ (o1, o2)) return Qt;
if (NUMBERP (o1) && NUMBERP (o2))
{
return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
}
if (XTYPE (o1) != XTYPE (o2)) return Qnil;
if (XINT (o1) == XINT (o2)) return Qt;
if (XTYPE (o1) == Lisp_Cons)
{
Lisp_Object v1;
@ -853,7 +857,8 @@ internal_equal (o1, o2, depth)
&& XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
? Qt : Qnil;
}
if (XTYPE (o1) == Lisp_Vector)
if (XTYPE (o1) == Lisp_Vector
|| XTYPE (o1) == Lisp_Compiled)
{
register int index;
if (XVECTOR (o1)->size != XVECTOR (o2)->size)

84
src/frame.c
View File

@ -74,7 +74,7 @@ Lisp_Object Vdefault_frame_alist;
/*&&& symbols declared here &&&*/
Lisp_Object Qframep;
Lisp_Object Qlive_frame_p;
Lisp_Object Qframe_live_p;
Lisp_Object Qheight;
Lisp_Object Qicon;
Lisp_Object Qminibuffer;
@ -110,7 +110,7 @@ Also see `live-frame-p'.")
}
}
DEFUN ("live-frame-p", Flive_frame_p, Slive_frame_p, 1, 1, 0,
DEFUN ("frame-live-p", Fframe_live_p, Sframe_live_p, 1, 1, 0,
"Return non-nil if OBJECT is a frame which has not been deleted.\n\
Value is nil if OBJECT is not a live frame. If object is a live\n\
frame, the return value indicates what sort of output device it is\n\
@ -381,14 +381,13 @@ Changing the selected frame can change focus redirections. See\n\
Fselect_window (XFRAME (frame)->selected_window);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
#ifdef MULTI_FRAME
if (FRAME_X_P (XFRAME (frame))
&& NILP (no_enter))
{
Ffocus_frame (frame);
}
#endif
#endif
choose_minibuf_frame ();
@ -450,8 +449,6 @@ DEFUN ("frame-list", Fframe_list, Sframe_list,
return Fcopy_sequence (Vframe_list);
}
#ifdef MULTI_FRAME
/* Return the next frame in the frame list after FRAME.
If MINIBUF is nil, exclude minibuffer-only frames.
If MINIBUF is a window, include only frames using that window for
@ -469,6 +466,10 @@ next_frame (frame, minibuf)
if (! CONSP (Vframe_list))
abort ();
/* If this frame is dead, it won't be in Vframe_list, and we'll loop
forever. Forestall that. */
CHECK_LIVE_FRAME (frame, 0);
while (1)
for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
{
@ -503,9 +504,6 @@ next_frame (frame, minibuf)
}
}
#if 0
/* Nobody seems to be using this code right now. */
/* Return the previous frame in the frame list before FRAME.
If MINIBUF is nil, exclude minibuffer-only frames.
If MINIBUF is a window, include only frames using that window for
@ -561,7 +559,6 @@ prev_frame (frame, minibuf)
acceptable frame in the list, return it. */
return prev;
}
#endif
DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0,
"Return the next frame in the frame list after FRAME.\n\
@ -583,7 +580,7 @@ If MINIFRAME is non-nil and not a window, include all frames.")
return next_frame (frame, miniframe);
}
#endif /* MULTI_FRAME */
DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 1, "",
"Delete FRAME, permanently eliminating it from use.\n\
@ -659,6 +656,8 @@ A frame may not be deleted if its minibuffer is used by other frames.")
now, then we may trip up the event-handling code. Instead, we'll
promise that the display of the frame must be valid until we have
called the window-system-dependent frame destruction routine. */
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
x_destroy_window (f);
@ -739,19 +738,25 @@ to read the mouse position, it returns the selected frame for FRAME\n\
and nil for X and Y.")
()
{
Lisp_Object x, y, dummy;
FRAME_PTR f;
Lisp_Object lispy_dummy;
enum scrollbar_part party_dummy;
Lisp_Object x, y;
unsigned long long_dummy;
if (mouse_position_hook)
(*mouse_position_hook) (&f, &x, &y, &dummy);
(*mouse_position_hook) (&f,
&lispy_dummy, &party_dummy,
&x, &y,
&long_dummy);
else
{
f = selected_frame;
x = y = Qnil;
}
XSET (dummy, Lisp_Frame, f);
return Fcons (dummy, Fcons (make_number (x), make_number (y)));
XSET (lispy_dummy, Lisp_Frame, f);
return Fcons (lispy_dummy, Fcons (make_number (x), make_number (y)));
}
DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0,
@ -764,6 +769,7 @@ WARNING: If you use this under X, you should do `unfocus-frame' afterwards.")
CHECK_NUMBER (x, 2);
CHECK_NUMBER (y, 1);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
@ -842,6 +848,7 @@ If omitted, FRAME defaults to the currently selected frame.")
CHECK_LIVE_FRAME (frame, 0);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (XFRAME (frame)))
x_make_frame_visible (XFRAME (frame));
@ -862,6 +869,7 @@ If omitted, FRAME defaults to the currently selected frame.")
CHECK_LIVE_FRAME (frame, 0);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (XFRAME (frame)))
x_make_frame_invisible (XFRAME (frame));
@ -882,6 +890,7 @@ If omitted, FRAME defaults to the currently selected frame.")
CHECK_LIVE_FRAME (frame, 0);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (XFRAME (frame)))
x_iconify_frame (XFRAME (frame));
@ -931,6 +940,37 @@ DEFUN ("visible-frame-list", Fvisible_frame_list, Svisible_frame_list,
}
DEFUN ("frame-to-front", Fframe_to_front, Sframe_to_front, 1, 1, 0,
"Bring FRAME to the front, so it occludes any frames it overlaps.\n\
If FRAME is invisible, make it visible.\n\
If Emacs is displaying on an ordinary terminal or some other device which\n\
doesn't support multiple overlapping frames, this function does nothing.")
(frame)
Lisp_Object frame;
{
CHECK_LIVE_FRAME (frame, 0);
if (frame_raise_lower_hook)
(*frame_raise_lower_hook) (XFRAME (frame), 1);
return Qnil;
}
DEFUN ("frame-to-back", Fframe_to_back, Sframe_to_back, 1, 1, 0,
"Send FRAME to the back, so it is occluded by any frames that overlap it.\n\
If Emacs is displaying on an ordinary terminal or some other device which\n\
doesn't support multiple overlapping frames, this function does nothing.")
(frame)
Lisp_Object frame;
{
CHECK_LIVE_FRAME (frame, 0);
if (frame_raise_lower_hook)
(*frame_raise_lower_hook) (XFRAME (frame), 0);
return Qnil;
}
DEFUN ("redirect-frame-focus", Fredirect_frame_focus, Sredirect_frame_focus,
1, 2, 0,
@ -1075,6 +1115,7 @@ If FRAME is omitted, return information on the currently selected frame.")
: FRAME_MINIBUF_WINDOW (f))));
store_in_alist (&alist, Qunsplittable, (f->no_split ? Qt : Qnil));
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
x_report_frame_params (f, &alist);
@ -1102,6 +1143,7 @@ The meaningful PARMs depend on the kind of frame; undefined PARMs are ignored.")
f = XFRAME (frame);
}
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
#if 1
@ -1180,6 +1222,7 @@ but that the idea of the actual height of the frame should not be changed.")
f = XFRAME (frame);
}
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
{
@ -1209,6 +1252,7 @@ but that the idea of the actual width of the frame should not be changed.")
f = XFRAME (frame);
}
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
{
@ -1234,6 +1278,7 @@ DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 3, 0,
CHECK_NUMBER (rows, 1);
f = XFRAME (frame);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
{
@ -1264,6 +1309,7 @@ off the screen.")
CHECK_NUMBER (yoffset, 2);
f = XFRAME (frame);
/* I think this should be done with a hook. */
#ifdef HAVE_X_WINDOWS
if (FRAME_X_P (f))
x_set_offset (f, XINT (xoffset), XINT (yoffset));
@ -1338,8 +1384,8 @@ syms_of_frame ()
/*&&& init symbols here &&&*/
Qframep = intern ("framep");
staticpro (&Qframep);
Qlive_frame_p = intern ("live-frame-p");
staticpro (&Qlive_frame_p);
Qframe_live_p = intern ("frame-live-p");
staticpro (&Qframe_live_p);
Qheight = intern ("height");
staticpro (&Qheight);
Qicon = intern ("icon");
@ -1396,7 +1442,7 @@ For values specific to the separate minibuffer frame, see\n\
Vdefault_frame_alist = Qnil;
defsubr (&Sframep);
defsubr (&Slive_frame_p);
defsubr (&Sframe_live_p);
defsubr (&Sselect_frame);
defsubr (&Sselected_frame);
defsubr (&Swindow_frame);
@ -1416,6 +1462,8 @@ For values specific to the separate minibuffer frame, see\n\
defsubr (&Siconify_frame);
defsubr (&Sframe_visible_p);
defsubr (&Svisible_frame_list);
defsubr (&Sframe_to_front);
defsubr (&Sframe_to_back);
defsubr (&Sredirect_frame_focus);
defsubr (&Sframe_focus);
defsubr (&Sframe_parameters);

4
src/frame.h
View File

@ -306,7 +306,7 @@ typedef struct frame *FRAME_PTR;
{ \
if (! FRAMEP (x) \
|| ! FRAME_LIVE_P (XFRAME (x))) \
x = wrong_type_argument (Qlive_frame_p, (x)); \
x = wrong_type_argument (Qframe_live_p, (x)); \
}
/* FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a
@ -325,7 +325,7 @@ typedef struct frame *FRAME_PTR;
list_var = XCONS (list_var)->cdr)
extern Lisp_Object Qframep, Qlive_frame_p;
extern Lisp_Object Qframep, Qframe_live_p;
extern struct frame *selected_frame;
extern struct frame *last_nonminibuf_frame;

8
src/insdel.c
View File

@ -545,10 +545,10 @@ signal_before_change (start, end)
{
/* If buffer is unmodified, run a special hook for that case. */
if (current_buffer->save_modified >= MODIFF
&& !NILP (Vfirst_change_function))
{
call0 (Vfirst_change_function);
}
&& !NILP (Vfirst_change_hook)
&& !NILP (Vrun_hooks))
call1 (Vrun_hooks, Qfirst_change_hook);
/* Now in any case run the before-change-function if any. */
if (!NILP (Vbefore_change_function))
{

136
src/keyboard.c
View File

@ -152,12 +152,12 @@ Lisp_Object last_nonmenu_event;
/* Last input character read for any purpose. */
Lisp_Object last_input_char;
/* If not Qnil, an object to be read as the next command input. */
Lisp_Object unread_command_event;
/* If not Qnil, a list of objects to be read as subsequent command input. */
Lisp_Object unread_command_events;
/* If not Qnil, this is a switch-frame event which we decided to put
off until the end of a key sequence. This should be read as the
next command input, after any unread_command_event.
next command input, after any unread_command_events.
read_key_sequence uses this to delay switch-frame events until the
end of the key sequence; Fread_char uses it to put off switch-frame
@ -867,7 +867,7 @@ command_loop_1 ()
if (!NILP (Vquit_flag))
{
Vquit_flag = Qnil;
unread_command_event = make_number (quit_char);
unread_command_events = Fcons (make_number (quit_char), Qnil);
}
}
@ -1145,10 +1145,10 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
int count;
jmp_buf save_jump;
if (!NILP (unread_command_event))
if (CONSP (unread_command_events))
{
c = unread_command_event;
unread_command_event = Qnil;
c = XCONS (unread_command_events)->car;
unread_command_events = XCONS (unread_command_events)->cdr;
if (this_command_key_count == 0)
goto reread_first;
@ -1229,7 +1229,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
/* After a mouse event, start echoing right away.
This is because we are probably about to display a menu,
and we don't want to delay before doing so. */
if (XTYPE (prev_event) == Lisp_Cons)
if (EVENT_HAS_PARAMETERS (prev_event))
echo ();
else
{
@ -1880,7 +1880,8 @@ make_lispy_event (event)
{
int button = XFASTINT (event->code);
Lisp_Object position;
Lisp_Object *start_pos;
Lisp_Object *start_pos_ptr;
Lisp_Object start_pos;
if (button < 0 || button >= NUM_MOUSE_BUTTONS)
abort ();
@ -1899,21 +1900,20 @@ make_lispy_event (event)
posn = Qnil;
else
{
XSETINT (event->x,
(XINT (event->x) - XINT (XWINDOW (window)->left)));
XSETINT (event->y,
(XINT (event->y) - XINT (XWINDOW (window)->top)));
if (part == 1)
posn = Qmode_line;
else if (part == 2)
posn = Qvertical_line;
else
{
XSETINT (event->x, (XINT (event->x)
- XINT (XWINDOW (window)->left)));
XSETINT (event->y, (XINT (event->y)
- XINT (XWINDOW (window)->top)));
XSET (posn, Lisp_Int,
buffer_posn_from_coords (XWINDOW (window),
XINT (event->x),
XINT (event->y)));
}
XSET (posn, Lisp_Int,
buffer_posn_from_coords (XWINDOW (window),
XINT (event->x),
XINT (event->y)));
}
position =
@ -1938,29 +1938,43 @@ make_lispy_event (event)
Qnil)))));
}
start_pos = &XVECTOR (button_down_location)->contents[button];
start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
start_pos = *start_pos_ptr;
*start_pos_ptr = Qnil;
/* If this is a button press, squirrel away the location, so
we can decide later whether it was a click or a drag. */
if (event->modifiers & down_modifier)
*start_pos = Fcopy_alist (position);
*start_pos_ptr = Fcopy_alist (position);
/* Now we're releasing a button - check the co-ordinates to
see if this was a click or a drag. */
else if (event->modifiers & up_modifier)
{
Lisp_Object down = Fnth (make_number (2), *start_pos);
/* The third element of every position should be the (x,y)
pair. */
if (! CONSP (down))
abort ();
/* Is there a start position stored at all for this
button?
It would be nice if we could assume that if we're
getting a button release, we must therefore have gotten
a button press. Unfortunately, the X menu code thwarts
this assumption, so we'll have to be more robust. We
treat a button release with no stored start position as
a click. */
event->modifiers &= ~up_modifier;
event->modifiers |= ((EQ (event->x, XCONS (down)->car)
&& EQ (event->y, XCONS (down)->cdr))
? click_modifier
: drag_modifier);
if (XTYPE (start_pos) != Lisp_Cons)
event->modifiers |= click_modifier;
else
{
/* The third element of every position should be the (x,y)
pair. */
Lisp_Object down = Fnth (make_number (2), start_pos);
event->modifiers |= ((EQ (event->x, XCONS (down)->car)
&& EQ (event->y, XCONS (down)->cdr))
? click_modifier
: drag_modifier);
}
}
else
/* Every mouse event should either have the down_modifier or
@ -1978,18 +1992,10 @@ make_lispy_event (event)
/ sizeof (lispy_mouse_names[0])));
if (event->modifiers & drag_modifier)
{
Lisp_Object lispy_event =
Fcons (head,
Fcons (*start_pos,
Fcons (position,
Qnil)));
/* Allow this to be GC'd. */
*start_pos = Qnil;
return lispy_event;
}
return Fcons (head,
Fcons (start_pos,
Fcons (position,
Qnil)));
else
return Fcons (head,
Fcons (position,
@ -2453,21 +2459,6 @@ modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table,
return apply_modifiers (modifiers, *slot);
}
DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0,
"Return non-nil iff OBJECT is a representation of a mouse event.\n\
A mouse event is a list of five elements whose car is a symbol of the\n\
form <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;
}
/* Store into *addr a value nonzero if terminal input chars are available.
Serves the purpose of ioctl (0, FIONREAD, addr)
@ -2686,7 +2677,9 @@ static int echo_flag;
static int echo_now;
/* Read a character like read_char but optionally prompt based on maps
in the array MAPS. NMAPS is the length of MAPS.
in the array MAPS. NMAPS is the length of MAPS. Return nil if we
decided not to read a character, because there are no menu items in
MAPS.
PREV_EVENT is the previous input event, or nil if we are reading
the first event of a key sequence.
@ -2730,14 +2723,14 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
}
/* If we don't have any menus, just read a character normally. */
if (NILP (name))
if (mapno >= nmaps)
return Qnil;
#ifdef HAVE_X_WINDOW
#ifndef NO_X_MENU
#ifdef HAVE_X_WINDOWS
#ifdef HAVE_X_MENU
/* If we got to this point via a mouse click,
use a real menu for mouse selection. */
if (XTYPE (prev_event) == Lisp_Cons)
if (EVENT_HAS_PARAMETERS (prev_event))
{
/* Display the menu and get the selection. */
Lisp_Object *realmaps
@ -2757,8 +2750,8 @@ read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
*used_mouse_menu = 1;
return value;
}
#endif /* not NO_X_MENU */
#endif /* HAVE_X_WINDOW */
#endif /* HAVE_X_MENU */
#endif /* HAVE_X_WINDOWS */
/* Prompt string always starts with map's prompt, and a space. */
strcpy (menu, XSTRING (name)->data);
@ -3677,7 +3670,7 @@ DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
Actually, the value is nil only if we can be sure that no input is available.")
()
{
if (!NILP (unread_command_event))
if (!NILP (unread_command_events))
return (Qt);
return detect_input_pending () ? Qt : Qnil;
@ -3749,7 +3742,7 @@ Also cancel any kbd macro being defined.")
defining_kbd_macro = 0;
update_mode_lines++;
unread_command_event = Qnil;
unread_command_events = Qnil;
discard_tty_input ();
@ -3997,7 +3990,7 @@ quit_throw_to_read_char ()
clear_waiting_for_input ();
input_pending = 0;
unread_command_event = Qnil;
unread_command_events = Qnil;
_longjmp (getcjmp, 1);
}
@ -4051,7 +4044,7 @@ init_keyboard ()
command_loop_level = -1;
immediate_quit = 0;
quit_char = Ctl ('g');
unread_command_event = Qnil;
unread_command_events = Qnil;
total_keys = 0;
recent_keys_index = 0;
kbd_fetch_ptr = kbd_buffer;
@ -4219,7 +4212,6 @@ syms_of_keyboard ()
defsubr (&Sread_key_sequence);
defsubr (&Srecursive_edit);
defsubr (&Strack_mouse);
defsubr (&Smouse_click_p);
defsubr (&Sinput_pending_p);
defsubr (&Scommand_execute);
defsubr (&Srecent_keys);
@ -4250,8 +4242,8 @@ so that you can determine whether the command was run by mouse or not.");
DEFVAR_LISP ("last-input-char", &last_input_char,
"Last terminal input key.");
DEFVAR_LISP ("unread-command-event", &unread_command_event,
"Object to be read as next input from input stream, or nil if none.");
DEFVAR_LISP ("unread-command-events", &unread_command_events,
"Lisp of object to be read as next input from input stream, or nil if none.");
DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
"Meta-prefix character code. Meta-foo as command input\n\

3
src/keyboard.h
View File

@ -1,5 +1,5 @@
/* Declarations useful when processing input.
Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@ -84,7 +84,6 @@ extern Lisp_Object Qmode_line, Qvertical_line;
extern Lisp_Object get_keymap_1 ();
extern Lisp_Object Fkeymapp ();
extern Lisp_Object reorder_modifiers ();
extern Lisp_Object Fmouse_click_p ();
extern Lisp_Object read_char ();
/* User-supplied string to translate input characters through. */
extern Lisp_Object Vkeyboard_translate_table;

10
src/keymap.c
View File

@ -555,8 +555,14 @@ the front of KEYMAP.")
keymap = get_keymap_1 (cmd, 0, 1);
if (NILP (keymap))
error ("Key sequence %s uses invalid prefix characters",
XSTRING (key)->data);
{
/* We must use Fkey_description rather than just passing key to
error; key might be a vector, not a string. */
Lisp_Object description = Fkey_description (key);
error ("Key sequence %s uses invalid prefix characters",
XSTRING (description)->data);
}
}
}

12
src/lread.c
View File

@ -203,7 +203,7 @@ If you want to read non-character events, or ignore them, call\n\
/* Only ASCII characters are acceptable. */
if (XTYPE (val) != Lisp_Int)
{
unread_command_event = val;
unread_command_events = Fcons (val, Qnil);
error ("Object read was not a character");
}
}
@ -1045,9 +1045,17 @@ read1 (readcharfun)
if (p1 != p)
{
while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
#ifdef LISP_FLOAT_TYPE
/* Integers can have trailing decimal points. */
if (p1 < p && *p1 == '.') p1++;
#endif
if (p1 == p)
/* It is. */
/* It is an integer. */
{
#ifdef LISP_FLOAT_TYPE
if (p1[-1] == '.')
p1[-1] = '\0';
#endif
XSET (val, Lisp_Int, atoi (read_buffer));
return val;
}

4
src/minibuf.c
View File

@ -1,5 +1,5 @@
/* Minibuffer input and completion.
Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@ -930,7 +930,7 @@ temp_echo_area_glyphs (m)
if (!NILP (Vquit_flag))
{
Vquit_flag = Qnil;
XFASTINT (unread_command_event) = Ctl ('g');
unread_command_events = Fcons (make_number (Ctl ('g')), Qnil);
}
Vinhibit_quit = oinhibit;
}

12
src/term.c
View File

@ -125,6 +125,18 @@ void (*mouse_position_hook) ( /* FRAME_PTR *f,
the highlight. */
void (*frame_rehighlight_hook) ( /* FRAME_PTR f */ );
/* If we're displaying frames using a window system that can stack
frames on top of each other, this hook allows you to bring a frame
to the front, or bury it behind all the other windows. If this
hook is zero, that means the device we're displaying on doesn't
support overlapping frames, so there's no need to raise or lower
anything.
If RAISE is non-zero, F is brought to the front, before all other
windows. If RAISE is zero, F is sent to the back, behind all other
windows. */
void (*frame_raise_lower_hook) ( /* FRAME_PTR f, int raise */ );
/* Set the vertical scrollbar for WINDOW to have its upper left corner
at (TOP, LEFT), and be LENGTH rows high. Set its handle to
indicate that we are displaying PORTION characters out of a total

11
src/termhooks.h
View File

@ -96,6 +96,17 @@ extern int mouse_moved;
X, this means that Emacs lies about where the focus is. */
extern void (*frame_rehighlight_hook) ( /* void */ );
/* If we're displaying frames using a window system that can stack
frames on top of each other, this hook allows you to bring a frame
to the front, or bury it behind all the other windows. If this
hook is zero, that means the device we're displaying on doesn't
support overlapping frames, so there's no need to raise or lower
anything.
If RAISE is non-zero, F is brought to the front, before all other
windows. If RAISE is zero, F is sent to the back, behind all other
windows. */
extern void (*frame_raise_lower_hook) ( /* FRAME_PTR f, int raise */ );
/* Scrollbar hooks. */

48
src/window.c
View File

@ -60,9 +60,6 @@ Lisp_Object Vminibuf_scroll_window;
/* Non-nil means this is the buffer whose window C-M-v should scroll. */
Lisp_Object Vother_window_scroll_buffer;
/* Window that the mouse is over (nil if no mouse support). */
Lisp_Object Vmouse_window;
/* Last mouse click data structure (nil if no mouse support). */
Lisp_Object Vmouse_event;
@ -811,7 +808,12 @@ minibuffer does not count, only windows from WINDOW's frame count.\n\
\n\
Optional third arg ALL-FRAMES t means include windows on all frames.\n\
ALL-FRAMES nil or omitted means cycle within the frames as specified\n\
above. If neither nil nor t, restrict to WINDOW's frame.")
above. If neither nil nor t, restrict to WINDOW's frame.\n\
\n\
If you use consistent values for MINIBUF and ALL-FRAMES, you can use\n\
`next-window' to iterate through the entire cycle of acceptable\n\
windows, eventually ending up back at the window you started with.\n\
`previous-window' traverses the same cycle, in the reverse order.")
(window, minibuf, all_frames)
register Lisp_Object window, minibuf, all_frames;
{
@ -908,7 +910,12 @@ count.\n\
\n\
Optional third arg ALL-FRAMES t means include windows on all frames.\n\
ALL-FRAMES nil or omitted means cycle within the frames as specified\n\
above. If neither nil nor t, restrict to WINDOW's frame.")
above. If neither nil nor t, restrict to WINDOW's frame.\n\
\n\
If you use consistent values for MINIBUF and ALL-FRAMES, you can use\n\
`previous-window' to iterate through the entire cycle of acceptable\n\
windows, eventually ending up back at the window you started with.\n\
`next-window' traverses the same cycle, in the reverse order.")
(window, minibuf, all_frames)
register Lisp_Object window, minibuf, all_frames;
{
@ -955,7 +962,16 @@ above. If neither nil nor t, restrict to WINDOW's frame.")
tem = WINDOW_FRAME (XWINDOW (window));
#ifdef MULTI_FRAME
if (! NILP (all_frames))
tem = next_frame (tem, all_frames);
/* It's actually important that we use prev_frame here,
rather than next_frame. All the windows acceptable
according to the given parameters should form a ring;
Fnext_window and Fprevious_window should go back and
forth around the ring. If we use next_frame here,
then Fnext_window and Fprevious_window take different
paths through the set of acceptable windows.
window_loop assumes that these `ring' requirement are
met. */
tem = prev_frame (tem, all_frames);
#endif
tem = FRAME_ROOT_WINDOW (XFRAME (tem));
@ -2205,8 +2221,20 @@ showing that buffer, popping the buffer up if necessary.")
window = Fdisplay_buffer (Vother_window_scroll_buffer, Qt);
}
else
/* Nothing specified; pick a neighboring window. */
window = Fnext_window (selected_window, Qnil, Qt);
{
/* Nothing specified; look for a neighboring window on the same
frame. */
window = Fnext_window (selected_window, Qnil, Qnil);
if (EQ (window, selected_window))
/* That didn't get us anywhere; look for a window on another
visible frame. */
do
window = Fnext_window (window, Qnil, Qt);
while (! FRAME_VISIBLE_P (XFRAME (WINDOW_FRAME (XWINDOW (window))))
&& ! EQ (window, selected_window));
}
CHECK_LIVE_WINDOW (window, 0);
if (EQ (window, selected_window))
@ -2866,10 +2894,6 @@ Commands such as `switch-to-buffer-other-window' and `find-file-other-window'\n\
work using this function.");
Vdisplay_buffer_function = Qnil;
DEFVAR_LISP ("mouse-window", &Vmouse_window,
"Window that the last mouse click occurred on.");
Vmouse_window = Qnil;
DEFVAR_LISP ("mouse-event", &Vmouse_event,
"The last mouse-event object. A list of four elements:\n\
((X-POS Y-POS) WINDOW FRAME-PART KEYSEQ).\n\

86
src/xfns.c
View File

@ -37,6 +37,8 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#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))
@ -58,9 +60,6 @@ Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
/* Color of chars displayed in cursor box. */
Lisp_Object Vx_cursor_fore_pixel;
/* If non-nil, use vertical bar cursor. */
Lisp_Object Vbar_cursor;
/* The X Visual we are using for X windows (the default) */
Visual *screen_visual;
@ -115,7 +114,6 @@ static char *x_visual_strings[] =
Lisp_Object Vmouse_depressed;
extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
extern Lisp_Object unread_command_event;
/* Atom for indicating window state to the window manager. */
Atom Xatom_wm_change_state;
@ -123,9 +121,6 @@ Atom Xatom_wm_change_state;
/* When emacs became the selection owner. */
extern Time x_begin_selection_own;
/* The value of the current emacs selection. */
extern Lisp_Object Vx_selection_value;
/* Emacs' selection property identifier. */
extern Atom Xatom_emacs_selection;
@ -228,9 +223,12 @@ Time mouse_timestamp;
Lisp_Object Qauto_raise;
Lisp_Object Qauto_lower;
Lisp_Object Qbackground_color;
Lisp_Object Qbar;
Lisp_Object Qborder_color;
Lisp_Object Qborder_width;
Lisp_Object Qbox;
Lisp_Object Qcursor_color;
Lisp_Object Qcursor_type;
Lisp_Object Qfont;
Lisp_Object Qforeground_color;
Lisp_Object Qgeometry;
@ -261,14 +259,6 @@ extern Lisp_Object Vglobal_mouse_map;
/* Points to table of defined typefaces. */
struct face *x_face_table[MAX_FACES_AND_GLYPHS];
static char gray_bits[] =
{
0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa
};
/* Return the Emacs frame-object corresponding to an X window.
It could be the frame's main window or an icon window. */
@ -330,6 +320,7 @@ void x_set_background_color ();
void x_set_mouse_color ();
void x_set_cursor_color ();
void x_set_border_color ();
void x_set_cursor_type ();
void x_set_icon_type ();
void x_set_font ();
void x_set_border_width ();
@ -346,6 +337,7 @@ static struct x_frame_parm_table x_frame_parms[] =
"mouse-color", x_set_mouse_color,
"cursor-color", x_set_cursor_color,
"border-color", x_set_border_color,
"cursor-type", x_set_cursor_type,
"icon-type", x_set_icon_type,
"font", x_set_font,
"border-width", x_set_border_width,
@ -808,7 +800,8 @@ x_set_border_pixel (f, pix)
pix);
#else
if (pix < 0)
temp = XMakePixmap ((Bitmap) XStoreBitmap (16, 16, gray_bits),
temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
gray_bits),
BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
else
temp = XMakeTile (pix);
@ -822,6 +815,24 @@ x_set_border_pixel (f, pix)
}
}
void
x_set_cursor_type (f, arg, oldval)
FRAME_PTR f;
Lisp_Object arg, oldval;
{
if (EQ (arg, Qbar))
FRAME_DESIRED_CURSOR (f) = bar_cursor;
else if (EQ (arg, Qbox))
FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
else
error
("the `cursor-type' frame parameter should be either `bar' or `box'");
/* Make sure the cursor gets redrawn. This is overkill, but how
often do people change cursor types? */
update_mode_lines++;
}
void
x_set_icon_type (f, arg, oldval)
struct frame *f;
@ -1796,31 +1807,12 @@ x_make_gc (f)
the frame. Since this depends on the frame's pixel values,
this must be done on a per-frame basis. */
f->display.x->border_tile =
XCreatePixmap (x_current_display, ROOT_WINDOW, 16, 16,
DefaultDepth (x_current_display,
XDefaultScreen (x_current_display)));
gc_values.foreground = f->display.x->foreground_pixel;
gc_values.background = f->display.x->background_pixel;
temp_gc = XCreateGC (x_current_display,
(Drawable) f->display.x->border_tile,
GCForeground | GCBackground, &gc_values);
/* These are things that should be determined by the server, in
Fx_open_connection */
tileimage.height = 16;
tileimage.width = 16;
tileimage.xoffset = 0;
tileimage.format = XYBitmap;
tileimage.data = gray_bits;
tileimage.byte_order = LSBFirst;
tileimage.bitmap_unit = 8;
tileimage.bitmap_bit_order = LSBFirst;
tileimage.bitmap_pad = 8;
tileimage.bytes_per_line = (16 + 7) >> 3;
tileimage.depth = 1;
XPutImage (x_current_display, f->display.x->border_tile, temp_gc,
&tileimage, 0, 0, 0, 0, 16, 16);
XFreeGC (x_current_display, temp_gc);
XCreatePixmapFromBitmapData
(x_current_display, ROOT_WINDOW,
gray_bits, gray_width, gray_height,
f->display.x->foreground_pixel,
f->display.x->background_pixel,
DefaultDepth (x_current_display, XDefaultScreen (x_current_display)));
}
#endif /* HAVE_X11 */
@ -1930,6 +1922,8 @@ be shared by the new frame.")
"autoRaise", "AutoRaiseLower", boolean);
x_default_parameter (f, parms, Qauto_lower, Qnil,
"autoLower", "AutoRaiseLower", boolean);
x_default_parameter (f, parms, Qcursor_type, Qbox,
"cursorType", "CursorType", symbol);
/* Dimensions, especially f->height, must be done via change_frame_size.
Change will not be effected unless different from the current
@ -3784,12 +3778,18 @@ syms_of_xfns ()
staticpro (&Qauto_lower);
Qbackground_color = intern ("background-color");
staticpro (&Qbackground_color);
Qbar = intern ("bar");
staticpro (&Qbar);
Qborder_color = intern ("border-color");
staticpro (&Qborder_color);
Qborder_width = intern ("border-width");
staticpro (&Qborder_width);
Qbox = intern ("box");
staticpro (&Qbox);
Qcursor_color = intern ("cursor-color");
staticpro (&Qcursor_color);
Qcursor_type = intern ("cursor-type");
staticpro (&Qcursor_type);
Qfont = intern ("font");
staticpro (&Qfont);
Qforeground_color = intern ("foreground-color");
@ -3851,10 +3851,6 @@ syms_of_xfns ()
"The shape of the pointer when over the mode line.");
Vx_mode_pointer_shape = Qnil;
DEFVAR_LISP ("x-bar-cursor", &Vbar_cursor,
"*If non-nil, use a vertical bar cursor. Otherwise, use the traditional box.");
Vbar_cursor = Qnil;
DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
"A string indicating the foreground color of the cursor box.");
Vx_cursor_fore_pixel = Qnil;

2
src/xmenu.c
View File

@ -103,7 +103,7 @@ Alternatively, you can specify a menu of multiple panes\n\
with a list of the form\n\
\(TITLE PANE1 PANE2...), where each pane is a list of form\n\
\(TITLE (LINE ITEM)...). Each line should be a string, and item should\n\
be the return value for that line (i.e. if it is selected.")
be the return value for that line (i.e. if it is selected).")
(position, menu)
Lisp_Object position, menu;
{

128
src/xselect.c.old
View File

@ -1,5 +1,5 @@
/* X Selection processing for emacs
Copyright (C) 1990, 1992 Free Software Foundation.
Copyright (C) 1990, 1992, 1993 Free Software Foundation.
This file is part of GNU Emacs.
@ -188,17 +188,41 @@ own_selection (selection_type, time)
If we are already the owner, merely change data and timestamp values.
This avoids generating SelectionClear events for ourselves. */
DEFUN ("x-own-selection", Fx_own_selection, Sx_own_selection,
1, 2, "",
"Make STRING the selection value. Default is the primary selection,\n\
but optional second argument TYPE may specify secondary or clipboard.\n\
DEFUN ("x-set-selection", Fx_set_selection, Sx_set_selection,
2, 2, "",
"Set the value of SELECTION to STRING.\n\
SELECTION may be `primary', `secondary', or `clipboard'.\n\
\n\
TYPE may also be cut-buffer0, indicating that Emacs should set the X\n\
cut buffer 0 to STRING. This is for compatibility with older X\n\
applications which still use the cut buffers; new applications should\n\
use X selections.")
(string, type)
register Lisp_Object string, type;
Selections are a mechanism for cutting and pasting information between\n\
X Windows clients. Emacs's kill ring commands set the `primary'\n\
selection to the top string of the kill ring, making it available to\n\
other clients, like xterm. Those commands also use the `primary'\n\
selection to retrieve information from other clients.\n\
\n\
According to the Inter-Client Communications Conventions Manual:\n\
\n\
The `primary' selection \"... is used for all commands that take only a\n\
single argument and is the principal means of communication between\n\
clients that use the selection mechanism.\" In Emacs, this means\n\
that the kill ring commands set the primary selection to the text\n\
put in the kill ring.\n\
\n\
The `secondary' selection \"... is used as the second argument to\n\
commands taking two arguments (for example, `exchange primary and\n\
secondary selections'), and as a means of obtaining data when there\n\
is a primary selection and the user does not want to disturb it.\"\n\
I am not sure how Emacs should use the secondary selection; if you\n\
come up with ideas, this function will at least let you get at it.\n\
\n\
The `clipboard' selection \"... is used to hold data that is being\n\
transferred between clients, that is, data that usually is being\n\
cut or copied, and then pasted.\" It seems that the `clipboard'\n\
selection is for the most part equivalent to the `primary'\n\
selection, so Emacs sets them both.\n\
\n\
Also see `x-selection', and the `interprogram-cut-function' variable.")
(selection, string)
register Lisp_Object selection, string;
{
Atom selection_type;
Lisp_Object val;
@ -207,7 +231,7 @@ use X selections.")
val = Qnil;
if (NILP (type) || EQ (type, Qprimary))
if (NILP (selection) || EQ (selection, Qprimary))
{
BLOCK_INPUT;
if (own_selection (XA_PRIMARY, event_time))
@ -217,7 +241,7 @@ use X selections.")
}
UNBLOCK_INPUT;
}
else if (EQ (type, Qsecondary))
else if (EQ (selection, Qsecondary))
{
BLOCK_INPUT;
if (own_selection (XA_SECONDARY, event_time))
@ -227,7 +251,7 @@ use X selections.")
}
UNBLOCK_INPUT;
}
else if (EQ (type, Qclipboard))
else if (EQ (selection, Qclipboard))
{
BLOCK_INPUT;
if (own_selection (Xatom_clipboard, event_time))
@ -237,33 +261,6 @@ use X selections.")
}
UNBLOCK_INPUT;
}
#if 0
else if (EQ (type, Qcut_buffer0))
{
/* DECwindows and some other servers don't seem to like setting
properties to values larger than about 20k. For very large
values, they signal an error, but for intermediate values
they just seem to hang.
We could just truncate the request, but it's better to let
the user know that the strategy he/she's using isn't going to
work than to have it work partially, but incorrectly. */
BLOCK_INPUT;
if (XSTRING (string)->size > MAX_SELECTION (x_current_display))
{
XStoreBytes (x_current_display, (char *) 0, 0);
val = Qnil;
}
else
{
XStoreBytes (x_current_display,
(char *) XSTRING (string)->data,
XSTRING (string)->size);
val = string;
}
UNBLOCK_INPUT;
}
#endif
else
error ("Invalid X selection type");
@ -621,54 +618,45 @@ get_selection_value (type)
simply return our selection value. If we are not the owner, this
will block until all of the data has arrived. */
DEFUN ("x-selection-value", Fx_selection_value, Sx_selection_value,
0, 1, "",
"Return the value of one of the selections. Default is the primary\n\
selection, but optional argument TYPE may specify secondary or clipboard.")
(type)
register Lisp_Object type;
DEFUN ("x-selection", Fx_selection, Sx_selection,
1, 1, "",
"Return the value of SELECTION.\n\
SELECTION is one of `primary', `secondary', or `clipboard'.\n\
\n\
Selections are a mechanism for cutting and pasting information between\n\
X Windows clients. When the user selects text in an X application,\n\
the application should set the primary selection to that text; Emacs's\n\
kill ring commands will then check the value of the `primary'\n\
selection, and return it as the most recent kill.\n\
The documentation for `x-set-selection' gives more information on how\n\
the different selection types are intended to be used.\n\
Also see the `interprogram-paste-function' variable.")
(selection)
register Lisp_Object selection;
{
Atom selection_type;
if (NILP (type) || EQ (type, Qprimary))
if (NILP (selection) || EQ (selection, Qprimary))
{
if (!NILP (Vx_selection_value))
return Vx_selection_value;
return get_selection_value (XA_PRIMARY);
}
else if (EQ (type, Qsecondary))
else if (EQ (selection, Qsecondary))
{
if (!NILP (Vx_secondary_selection_value))
return Vx_secondary_selection_value;
return get_selection_value (XA_SECONDARY);
}
else if (EQ (type, Qclipboard))
else if (EQ (selection, Qclipboard))
{
if (!NILP (Vx_clipboard_value))
return Vx_clipboard_value;
return get_selection_value (Xatom_clipboard);
}
#if 0
else if (EQ (type, Qcut_buffer0))
{
char *data;
int size;
Lisp_Object string;
BLOCK_INPUT;
data = XFetchBytes (x_current_display, &size);
if (data == 0)
string = Qnil;
else
string = make_string (data, size);
UNBLOCK_INPUT;
return string;
}
#endif
else
error ("Invalid X selection type");
}
@ -950,8 +938,8 @@ syms_of_xselect ()
Qclipboard = intern ("clipboard");
staticpro (&Qclipboard);
defsubr (&Sx_own_selection);
defsubr (&Sx_selection_value);
defsubr (&Sx_set_selection);
defsubr (&Sx_selection);
cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil);
staticpro (&cut_buffer_value);

435
src/xterm.c
View File

@ -657,94 +657,127 @@ XTclear_frame ()
curs_y = 0;
BLOCK_INPUT;
XClear (FRAME_X_WINDOW (f));
/* We have to clear the scrollbars, too. If we have changed
colors or something like that, then they should be notified. */
x_scrollbar_clear (f);
#ifndef HAVE_X11
dumpborder (f, 0);
#endif /* HAVE_X11 */
XFlushQueue ();
UNBLOCK_INPUT;
}
/* Paint horzontal bars down the frame for a visible bell.
Note that this may be way too slow on some machines. */
/* Invert the middle quarter of the frame for .15 sec. */
/* We use the select system call to do the waiting, so we have to make sure
it's avaliable. If it isn't, we just won't do visual bells. */
#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
/* Subtract the `struct timeval' values X and Y,
storing the result in RESULT.
Return 1 if the difference is negative, otherwise 0. */
static int
timeval_subtract (result, x, y)
struct timeval *result, x, y;
{
/* Perform the carry for the later subtraction by updating y.
This is safer because on some systems
the tv_sec member is unsigned. */
if (x.tv_usec < y.tv_usec)
{
int nsec = (y.tv_usec - x.tv_usec) / 1000000 + 1;
y.tv_usec -= 1000000 * nsec;
y.tv_sec += nsec;
}
if (x.tv_usec - y.tv_usec > 1000000)
{
int nsec = (y.tv_usec - x.tv_usec) / 1000000;
y.tv_usec += 1000000 * nsec;
y.tv_sec -= nsec;
}
/* Compute the time remaining to wait. tv_usec is certainly positive. */
result->tv_sec = x.tv_sec - y.tv_sec;
result->tv_usec = x.tv_usec - y.tv_usec;
/* Return indication of whether the result should be considered negative. */
return x.tv_sec < y.tv_sec;
}
XTflash (f)
struct frame *f;
{
register struct frame_glyphs *active_frame = FRAME_CURRENT_GLYPHS (f);
register int i;
int x, y;
if (updating_frame != 0)
abort ();
BLOCK_INPUT;
#ifdef HAVE_X11
#if 0
for (i = f->height * FONT_HEIGHT (f->display.x->font) - 10;
i >= 0;
i -= 100) /* Should be NO LOWER than 75 for speed reasons. */
XFillRectangle (x_current_display, FRAME_X_WINDOW (f),
f->display.x->cursor_gc,
0, i, f->width * FONT_WIDTH (f->display.x->font)
+ 2 * f->display.x->internal_border_width, 25);
#endif /* ! 0 */
x = (f->width * FONT_WIDTH (f->display.x->font)) / 4;
y = (f->height * FONT_HEIGHT (f->display.x->font)) / 4;
XFillRectangle (x_current_display, FRAME_X_WINDOW (f),
f->display.x->cursor_gc,
x, y, 2 * x, 2 * y);
dumpglyphs (f, (x + f->display.x->internal_border_width),
(y + f->display.x->internal_border_width),
&active_frame->glyphs[(f->height / 4) + 1][(f->width / 4)],
1, 0, f->display.x->font);
{
GC gc;
#else /* ! defined (HAVE_X11) */
for (i = f->height * FONT_HEIGHT (f->display.x->font) - 10;
i >= 0;
i -= 50)
XPixFill (FRAME_X_WINDOW (f), 0, i,
f->width * FONT_WIDTH (f->display.x->font)
+ 2 * f->display.x->internal_border_width, 10,
WHITE_PIX_DEFAULT, ClipModeClipped, GXinvert, AllPlanes);
#endif /* ! defined (HAVE_X11) */
/* Create a GC that will use the GXxor function to flip foreground pixels
into background pixels. */
{
XGCValues values;
values.function = GXxor;
values.foreground = (f->display.x->foreground_pixel
^ f->display.x->background_pixel);
gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
GCFunction | GCForeground, &values);
}
{
int width = PIXEL_WIDTH (f);
int height = PIXEL_HEIGHT (f);
XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc,
width/4, height/4, width/2, height/2);
XFlush (x_current_display);
{
struct timeval wakeup, now;
gettimeofday (&wakeup, (struct timezone *) 0);
/* Compute time to wait until, propagating carry from usecs. */
wakeup.tv_usec += 150000;
wakeup.tv_sec += (wakeup.tv_usec / 1000000);
wakeup.tv_usec %= 1000000;
/* Keep waiting until past the time wakeup. */
while (1)
{
struct timeval timeout;
gettimeofday (&timeout, (struct timezone *)0);
/* In effect, timeout = wakeup - timeout.
Break if result would be negative. */
if (timeval_subtract (&timeout, wakeup, timeout))
break;
/* Try to wait that long--but we might wake up sooner. */
select (0, 0, 0, 0, &timeout);
}
}
XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc,
width/4, height/4, width/2, height/2);
XFreeGC (x_current_display, gc);
XFlush (x_current_display);
}
}
XFlushQueue ();
UNBLOCK_INPUT;
}
/* Flip background and forground colors of the frame. */
#endif
x_invert_frame (f)
struct frame *f;
{
#ifdef HAVE_X11
GC temp;
unsigned long pix_temp;
x_display_cursor (f, 0);
XClearWindow (x_current_display, FRAME_X_WINDOW (f));
temp = f->display.x->normal_gc;
f->display.x->normal_gc = f->display.x->reverse_gc;
f->display.x->reverse_gc = temp;
pix_temp = f->display.x->foreground_pixel;
f->display.x->foreground_pixel = f->display.x->background_pixel;
f->display.x->background_pixel = pix_temp;
XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
f->display.x->background_pixel);
if (f->display.x->background_pixel == f->display.x->cursor_pixel)
{
f->display.x->cursor_pixel = f->display.x->foreground_pixel;
XSetBackground (x_current_display, f->display.x->cursor_gc,
f->display.x->cursor_pixel);
XSetForeground (x_current_display, f->display.x->cursor_gc,
f->display.x->background_pixel);
}
redraw_frame (f);
#endif /* ! defined (HAVE_X11) */
}
/* Make audible bell. */
@ -756,15 +789,11 @@ x_invert_frame (f)
XTring_bell ()
{
#if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT)
if (visible_bell)
#if 0
XTflash (selected_frame);
#endif /* ! 0 */
{
x_invert_frame (selected_frame);
x_invert_frame (selected_frame);
}
else
#endif
{
BLOCK_INPUT;
XRINGBELL;
@ -1758,9 +1787,8 @@ x_scrollbar_create (window, top, left, width, height)
| ButtonMotionMask | PointerMotionHintMask
| ExposureMask);
a.cursor = x_vertical_scrollbar_cursor;
a.win_gravity = EastGravity;
mask = (CWBackPixel | CWEventMask | CWCursor | CWWinGravity);
mask = (CWBackPixel | CWEventMask | CWCursor);
SET_SCROLLBAR_X_WINDOW
(bar,
@ -2321,6 +2349,24 @@ x_scrollbar_report_motion (f, bar_window, part, x, y, time)
}
/* The screen has been cleared so we may have changed foreground or
background colors, and the scrollbars may need to be redrawn.
Clear out the scrollbars, and ask for expose events, so we can
redraw them. */
x_scrollbar_clear (f)
FRAME_PTR f;
{
Lisp_Object bar;
for (bar = FRAME_SCROLLBARS (f);
XTYPE (bar) == Lisp_Vector;
bar = XSCROLLBAR (bar)->next)
XClearArea (x_current_display, SCROLLBAR_X_WINDOW (XSCROLLBAR (bar)),
0, 0, 0, 0, True);
}
/* The main X event-reading loop - XTread_socket. */
@ -2865,33 +2911,30 @@ XTread_socket (sd, bufp, numchars, waitp, expected)
break;
case ConfigureNotify:
{
int rows, columns;
f = x_window_to_frame (event.xconfigure.window);
if (!f)
break;
f = x_window_to_frame (event.xconfigure.window);
if (f)
{
int rows = PIXEL_TO_CHAR_HEIGHT (f, event.xconfigure.height);
int columns = PIXEL_TO_CHAR_WIDTH (f, event.xconfigure.width);
columns = PIXEL_TO_CHAR_WIDTH (f, event.xconfigure.width);
rows = PIXEL_TO_CHAR_HEIGHT (f, event.xconfigure.height);
/* Even if the number of character rows and columns has
not changed, the font size may have changed, so we need
to check the pixel dimensions as well. */
if (columns != f->width
|| rows != f->height
|| event.xconfigure.width != f->display.x->pixel_width
|| event.xconfigure.height != f->display.x->pixel_height)
{
change_frame_size (f, rows, columns, 0, 1);
SET_FRAME_GARBAGED (f);
}
/* Even if the number of character rows and columns has
not changed, the font size may have changed, so we need
to check the pixel dimensions as well. */
if (columns != f->width
|| rows != f->height
|| event.xconfigure.width != f->display.x->pixel_width
|| event.xconfigure.height != f->display.x->pixel_height)
{
change_frame_size (f, rows, columns, 0, 1);
SET_FRAME_GARBAGED (f);
}
f->display.x->pixel_width = event.xconfigure.width;
f->display.x->pixel_height = event.xconfigure.height;
f->display.x->left_pos = event.xconfigure.x;
f->display.x->top_pos = event.xconfigure.y;
break;
}
f->display.x->pixel_width = event.xconfigure.width;
f->display.x->pixel_height = event.xconfigure.height;
f->display.x->left_pos = event.xconfigure.x;
f->display.x->top_pos = event.xconfigure.y;
}
break;
case ButtonPress:
case ButtonRelease:
@ -3153,52 +3196,6 @@ clear_cursor (f)
f->phys_cursor_x = -1;
}
static void
x_display_bar_cursor (f, on)
struct frame *f;
int on;
{
register int phys_x = f->phys_cursor_x;
register int phys_y = f->phys_cursor_y;
register int x1;
register int y1;
register int y2;
if (! FRAME_VISIBLE_P (f) || (! on && f->phys_cursor_x < 0))
return;
#ifdef HAVE_X11
if (phys_x >= 0 &&
(!on || phys_x != f->cursor_x || phys_y != f->cursor_y))
{
x1 = CHAR_TO_PIXEL_COL (f, phys_x);
y1 = CHAR_TO_PIXEL_ROW (f, phys_y) - 1;
y2 = y1 + FONT_HEIGHT (f->display.x->font) + 1;
XDrawLine (x_current_display, FRAME_X_WINDOW (f),
f->display.x->reverse_gc, x1, y1, x1, y2);
f->phys_cursor_x = phys_x = -1;
}
if (on && f == x_highlight_frame)
{
x1 = CHAR_TO_PIXEL_COL (f, f->cursor_x);
y1 = CHAR_TO_PIXEL_ROW (f, f->cursor_y) - 1;
y2 = y1 + FONT_HEIGHT (f->display.x->font) + 1;
XDrawLine (x_current_display, FRAME_X_WINDOW (f),
f->display.x->cursor_gc, x1, y1, x1, y2);
f->phys_cursor_x = f->cursor_x;
f->phys_cursor_y = f->cursor_y;
}
#else /* ! defined (HAVE_X11) */
Give it up, dude.
#endif /* ! defined (HAVE_X11) */
}
/* Redraw the glyph at ROW, COLUMN on frame F, in the style
HIGHLIGHT. HIGHLIGHT is as defined for dumpglyphs. Return the
glyph drawn. */
@ -3216,6 +3213,68 @@ x_draw_single_glyph (f, row, column, glyph, highlight)
&glyph, 1, highlight, f->display.x->font);
}
static void
x_display_bar_cursor (f, on)
struct frame *f;
int on;
{
struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f);
if (! FRAME_VISIBLE_P (f))
return;
if (! on && f->phys_cursor_x < 0)
return;
/* If we're not updating, then we want to use the current frame's
cursor position, not our local idea of where the cursor ought to be. */
if (f != updating_frame)
{
curs_x = FRAME_CURSOR_X (f);
curs_y = FRAME_CURSOR_Y (f);
}
/* If there is anything wrong with the current cursor state, remove it. */
if (f->phys_cursor_x >= 0
&& (!on
|| f->phys_cursor_x != curs_x
|| f->phys_cursor_y != curs_y
|| f->display.x->current_cursor != bar_cursor))
{
/* Erase the cursor by redrawing the character underneath it. */
x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x,
f->phys_cursor_glyph,
current_glyphs->highlight[f->phys_cursor_y]);
f->phys_cursor_x = -1;
}
/* If we now need a cursor in the new place or in the new form, do it so. */
if (on
&& (f->phys_cursor_x < 0
|| (f->display.x->current_cursor != bar_cursor)))
{
f->phys_cursor_glyph
= ((current_glyphs->enable[curs_y]
&& curs_x < current_glyphs->used[curs_y])
? current_glyphs->glyphs[curs_y][curs_x]
: SPACEGLYPH);
XFillRectangle (x_current_display, FRAME_X_WINDOW (f),
f->display.x->cursor_gc,
CHAR_TO_PIXEL_COL (f, curs_x),
CHAR_TO_PIXEL_ROW (f, curs_y),
1, FONT_HEIGHT (f->display.x->font));
f->phys_cursor_x = curs_x;
f->phys_cursor_y = curs_y;
f->display.x->current_cursor = bar_cursor;
}
if (updating_frame != f)
XFlushQueue ();
}
/* Turn the displayed cursor of frame F on or off according to ON.
If ON is nonzero, where to put the cursor is specified
by F->cursor_x and F->cursor_y. */
@ -3227,6 +3286,13 @@ x_display_box_cursor (f, on)
{
struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f);
if (! FRAME_VISIBLE_P (f))
return;
/* If cursor is off and we want it off, return quickly. */
if (!on && f->phys_cursor_x < 0)
return;
/* If we're not updating, then we want to use the current frame's
cursor position, not our local idea of where the cursor ought to be. */
if (f != updating_frame)
@ -3235,13 +3301,6 @@ x_display_box_cursor (f, on)
curs_y = FRAME_CURSOR_Y (f);
}
if (! FRAME_VISIBLE_P (f))
return;
/* If cursor is off and we want it off, return quickly. */
if (!on && f->phys_cursor_x < 0)
return;
/* If cursor is currently being shown and we don't want it to be
or it is in the wrong place,
or we want a hollow box and it's not so, (pout!)
@ -3250,7 +3309,7 @@ x_display_box_cursor (f, on)
&& (!on
|| f->phys_cursor_x != curs_x
|| f->phys_cursor_y != curs_y
|| (f->display.x->text_cursor_kind != hollow_box_cursor
|| (f->display.x->current_cursor != hollow_box_cursor
&& (f != x_highlight_frame))))
{
/* Erase the cursor by redrawing the character underneath it. */
@ -3265,7 +3324,7 @@ x_display_box_cursor (f, on)
write it in the right place. */
if (on
&& (f->phys_cursor_x < 0
|| (f->display.x->text_cursor_kind != filled_box_cursor
|| (f->display.x->current_cursor != filled_box_cursor
&& f == x_highlight_frame)))
{
f->phys_cursor_glyph
@ -3276,13 +3335,13 @@ x_display_box_cursor (f, on)
if (f != x_highlight_frame)
{
x_draw_box (f);
f->display.x->text_cursor_kind = hollow_box_cursor;
f->display.x->current_cursor = hollow_box_cursor;
}
else
{
x_draw_single_glyph (f, curs_y, curs_x,
f->phys_cursor_glyph, 2);
f->display.x->text_cursor_kind = filled_box_cursor;
f->display.x->current_cursor = filled_box_cursor;
}
f->phys_cursor_x = curs_x;
@ -3293,16 +3352,17 @@ x_display_box_cursor (f, on)
XFlushQueue ();
}
extern Lisp_Object Vbar_cursor;
x_display_cursor (f, on)
struct frame *f;
int on;
{
if (EQ (Vbar_cursor, Qnil))
if (FRAME_DESIRED_CURSOR (f) == filled_box_cursor)
x_display_box_cursor (f, on);
else
else if (FRAME_DESIRED_CURSOR (f) == bar_cursor)
x_display_bar_cursor (f, on);
else
/* Those are the only two we have implemented! */
abort ();
}
/* Icons. */
@ -3347,8 +3407,7 @@ refreshicon (f)
#endif /* ! defined (HAVE_X11) */
}
/* Make the x-window of frame F use the kitchen-sink icon
that's a window generated by Emacs. */
/* Make the x-window of frame F use the gnu icon bitmap. */
int
x_bitmap_icon (f)
@ -3424,12 +3483,6 @@ x_text_icon (f, icon_name)
if (FRAME_X_WINDOW (f) == 0)
return 1;
if (icon_font_info == 0)
icon_font_info
= XGetFont (XGetDefault (XDISPLAY
(char *) XSTRING (invocation_name)->data,
"BodyFont"));
#ifdef HAVE_X11
if (icon_name)
f->display.x->icon_label = icon_name;
@ -3443,6 +3496,12 @@ x_text_icon (f, icon_name)
f->display.x->icon_bitmap_flag = 0;
x_wm_set_icon_pixmap (f, 0);
#else /* ! defined (HAVE_X11) */
if (icon_font_info == 0)
icon_font_info
= XGetFont (XGetDefault (XDISPLAY
(char *) XSTRING (invocation_name)->data,
"BodyFont"));
if (f->display.x->icon_desc)
{
XClearIconWindow (XDISPLAY FRAME_X_WINDOW (f));
@ -3801,12 +3860,24 @@ x_set_window_size (f, cols, rows)
/* Now, strictly speaking, we can't be sure that this is accurate,
but the window manager will get around to dealing with the size
change request eventually, and we'll hear how it went when the
ConfigureNotify event gets here. */
ConfigureNotify event gets here.
We could just not bother storing any of this information here,
and let the ConfigureNotify event set everything up, but that
might be kind of confusing to the lisp code, since size changes
wouldn't be reported in the frame parameters until some random
point in the future when the ConfigureNotify event arrives. */
FRAME_WIDTH (f) = cols;
FRAME_HEIGHT (f) = rows;
PIXEL_WIDTH (f) = pixelwidth;
PIXEL_HEIGHT (f) = pixelheight;
/* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to
receive in the ConfigureNotify event; if we get what we asked
for, then the event won't cause the screen to become garbaged, so
we have to make sure to do it here. */
SET_FRAME_GARBAGED (f);
XFlushQueue ();
UNBLOCK_INPUT;
}
@ -3903,6 +3974,18 @@ x_lower_frame (f)
}
}
static void
XTframe_raise_lower (f, raise)
FRAME_PTR f;
int raise;
{
if (raise)
x_raise_frame (f);
else
x_lower_frame (f);
}
/* Change from withdrawn state to mapped state. */
x_make_frame_visible (f)
@ -4259,8 +4342,13 @@ x_wm_set_icon_pixmap (f, icon_pixmap)
{
Window window = FRAME_X_WINDOW (f);
f->display.x->wm_hints.flags |= IconPixmapHint;
f->display.x->wm_hints.icon_pixmap = icon_pixmap ? icon_pixmap : None;
if (icon_pixmap)
{
f->display.x->wm_hints.icon_pixmap = icon_pixmap;
f->display.x->wm_hints.flags |= IconPixmapHint;
}
else
f->display.x->wm_hints.flags &= ~IconPixmapHint;
XSetWMHints (x_current_display, window, &f->display.x->wm_hints);
}
@ -4395,6 +4483,7 @@ x_term_init (display_name)
reassert_line_highlight_hook = XTreassert_line_highlight;
mouse_position_hook = XTmouse_position;
frame_rehighlight_hook = XTframe_rehighlight;
frame_raise_lower_hook = XTframe_raise_lower;
set_vertical_scrollbar_hook = XTset_vertical_scrollbar;
condemn_scrollbars_hook = XTcondemn_scrollbars;
redeem_scrollbar_hook = XTredeem_scrollbar;

19
src/xterm.h
View File

@ -239,9 +239,6 @@ enum text_cursor_kinds {
filled_box_cursor, hollow_box_cursor, bar_cursor
};
#define PIXEL_WIDTH(f) ((f)->display.x->pixel_width)
#define PIXEL_HEIGHT(f) ((f)->display.x->pixel_height)
/* Each X frame object points to its own struct x_display object
in the display.x field. The x_display structure contains all
the information that is specific to X windows. */
@ -316,9 +313,13 @@ struct x_display
/* Flag to set when the X window needs to be completely repainted. */
int needs_exposure;
/* What kind of text cursor is drawn in this window right now? (If
there is no cursor (phys_cursor_x < 0), then this means nothing. */
enum text_cursor_kinds text_cursor_kind;
/* What kind of text cursor is drawn in this window right now?
(If there is no cursor (phys_cursor_x < 0), then this means nothing.) */
enum text_cursor_kinds current_cursor;
/* What kind of text cursor should we draw in the future?
This should always be filled_box_cursor or bar_cursor. */
enum text_cursor_kinds desired_cursor;
/* These are the current window manager hints. It seems that
XSetWMHints, when presented with an unset bit in the `flags'
@ -341,6 +342,12 @@ struct x_display
/* Return the window associated with the frame F. */
#define FRAME_X_WINDOW(f) ((f)->display.x->window_desc)
/* These two really ought to be called FRAME_PIXEL_{WIDTH,HEIGHT}. */
#define PIXEL_WIDTH(f) ((f)->display.x->pixel_width)
#define PIXEL_HEIGHT(f) ((f)->display.x->pixel_height)
#define FRAME_DESIRED_CURSOR(f) ((f)->display.x->desired_cursor)
/* When X windows are used, a glyf may be a 16 bit unsigned datum.
The high order byte is the face number and is used as an index