;;; mouse.el --- window system-independent mouse support.
-;;; Copyright (C) 1993 Free Software Foundation, Inc.
+;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware
(defvar mouse-yank-at-point nil
"*If non-nil, mouse yank commands yank at point instead of at click.")
\f
+(defun mouse-minibuffer-check (event)
+ (let ((w (posn-window (event-start event))))
+ (and (window-minibuffer-p w)
+ (not (minibuffer-window-active-p w))
+ (error "Minibuffer window is not active"))))
+
(defun mouse-delete-window (click)
"Delete the window you click on.
This must be bound to a mouse click."
(interactive "e")
+ (mouse-minibuffer-check click)
(delete-window (posn-window (event-start click))))
(defun mouse-select-window (click)
"Select the window clicked on; don't move point."
(interactive "e")
+ (mouse-minibuffer-check click)
(let ((oframe (selected-frame))
(frame (window-frame (posn-window (event-start click)))))
(select-window (posn-window (event-start click)))
(defun mouse-tear-off-window (click)
"Delete the window clicked on, and create a new frame displaying its buffer."
(interactive "e")
+ (mouse-minibuffer-check click)
(let* ((window (posn-window (event-start click)))
(buf (window-buffer window))
- (frame (new-frame)))
+ (frame (make-frame)))
(select-frame frame)
(switch-to-buffer buf)
(delete-window window)))
The window is split at the line clicked on.
This command must be bound to a mouse click."
(interactive "@e")
+ (mouse-minibuffer-check click)
(let ((start (event-start click)))
(select-window (posn-window start))
(let ((new-height (if (eq (posn-point start) 'vertical-scroll-bar)
The window is split at the column clicked on.
This command must be bound to a mouse click."
(interactive "@e")
+ (mouse-minibuffer-check click)
(let ((start (event-start click)))
(select-window (posn-window start))
(let ((new-width (1+ (car (posn-col-row (event-end click)))))
"Move point to the position clicked on with the mouse.
This should be bound to a mouse click event type."
(interactive "e")
+ (mouse-minibuffer-check event)
;; Use event-end in case called from mouse-drag-region.
;; If EVENT is a click, event-end and event-start give same value.
(let ((posn (event-end event)))
- (and (window-minibuffer-p (posn-window posn))
- (not (minibuffer-window-active-p (posn-window posn)))
- (error "Minibuffer window is not active"))
(select-window (posn-window posn))
(if (numberp (posn-point posn))
(goto-char (posn-point posn)))))
"Set the region to the text dragged over, and copy to kill ring.
This should be bound to a mouse drag event."
(interactive "e")
+ (mouse-minibuffer-check click)
(let ((posn (event-start click))
(end (event-end click)))
(select-window (posn-window posn))
In Transient Mark mode, the highlighting remains once you
release the mouse button. Otherwise, it does not."
(interactive "e")
+ (mouse-minibuffer-check start-event)
(let* ((start-posn (event-start start-event))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
(let ((range (mouse-start-end start-point (point) click-count)))
(move-overlay mouse-drag-overlay (car range) (nth 1 range))))
- ;; Are we moving on a different window on the same frame?
- ((and (windowp (posn-window end))
- (eq (window-frame (posn-window end)) start-frame))
- (let ((mouse-row
- (+ (nth 1 (window-edges (posn-window end)))
- (cdr (posn-col-row end)))))
+ (t
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
(cond
+ ((null mouse-row))
((< mouse-row top)
(mouse-scroll-subr
(- mouse-row top) mouse-drag-overlay start-point))
((and (not (eobp))
(>= mouse-row bottom))
(mouse-scroll-subr (1+ (- mouse-row bottom))
- mouse-drag-overlay start-point)))))
-
- (t
- (let ((mouse-y (cdr (cdr (mouse-position))))
- (menu-bar-lines (or (cdr (assq 'menu-bar-lines
- (frame-parameters)))
- 0)))
-
- ;; Are we on the menu bar?
- (and (integerp mouse-y) (< mouse-y menu-bar-lines)
- (mouse-scroll-subr (- mouse-y menu-bar-lines)
- mouse-drag-overlay start-point))))))))
+ mouse-drag-overlay start-point)))))))))
(if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
(eq (posn-window (event-end event)) start-window)
;; Subroutine: set the mark where CLICK happened,
;; but don't do anything else.
(defun mouse-set-mark-fast (click)
+ (mouse-minibuffer-check click)
(let ((posn (event-start click)))
(select-window (posn-window posn))
(if (numberp (posn-point posn))
"Kill the region between point and the mouse click.
The text is saved in the kill ring, as with \\[kill-region]."
(interactive "e")
- (let ((click-posn (posn-point (event-start click))))
+ (mouse-minibuffer-check click)
+ (let* ((posn (event-start click))
+ (click-posn (posn-point posn)))
+ (select-window (posn-window posn))
(if (numberp click-posn)
(kill-region (min (point) click-posn)
(max (point) click-posn)))))
again in a different position, it extends the selection again.
If you do this twice in the same position, the selection is killed."
(interactive "e")
+ (mouse-minibuffer-check click)
(let ((click-posn (posn-point (event-start click)))
;; Don't let a subsequent kill command append to this one:
;; prevent setting this-command to kill-region.
Use \\[mouse-secondary-save-then-kill] to set the other end
and complete the secondary selection."
(interactive "e")
+ (mouse-minibuffer-check click)
(let ((posn (event-start click)))
(save-excursion
(set-buffer (window-buffer (posn-window posn)))
"Set the secondary selection to the text that the mouse is dragged over.
This must be bound to a mouse drag event."
(interactive "e")
+ (mouse-minibuffer-check click)
(let ((posn (event-start click))
beg
(end (event-end click)))
Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event."
(interactive "e")
+ (mouse-minibuffer-check start-event)
(let* ((start-posn (event-start start-event))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
(defun mouse-secondary-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
-at the front of the kill ring, this deletes the text.
+You must use this in a buffer where you have recently done \\[mouse-start-secondary].
+If the text between where you did \\[mouse-start-secondary] and where
+you use this command matches the text at the front of the kill ring,
+this command deletes the text.
Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
-which prepares for a second click to delete the text.
+which prepares for a second click with this command to delete the text.
-If you have selected words or lines, this command extends the
-selection through the word or line clicked on. If you do this
-again in a different position, it extends the selection again.
-If you do this twice in the same position, the selection is killed."
+If you have already made a secondary selection in that buffer,
+this command extends or retracts the selection to where you click.
+If you do this again in a different position, it extends or retracts
+again. If you do this twice in the same position, it kills the selection."
(interactive "e")
+ (mouse-minibuffer-check click)
(let ((posn (event-start click))
(click-posn (posn-point (event-start click)))
;; Don't let a subsequent kill command append to this one:
This switches buffers in the window that you clicked on,
and selects that window."
(interactive "e")
+ (mouse-minibuffer-check event)
(let ((menu
(list "Buffer Menu"
(cons "Select Buffer"
\f
;; Choose a completion with the mouse.
-;; Delete the longest partial match for STRING
-;; that can be found before POINT.
-(defun mouse-delete-max-match (string)
- (let ((opoint (point))
- (len (min (length string)
- (- (point) (point-min)))))
- (goto-char (- (point) (length string)))
- (while (and (> len 0)
- (let ((tail (buffer-substring (point)
- (+ (point) len))))
- (not (string= tail (substring string 0 len)))))
- (setq len (1- len))
- (forward-char 1))
- (delete-char len)))
-
(defun mouse-choose-completion (event)
"Click on an alternative in the `*Completions*' buffer to choose it."
(interactive "e")
(select-window (posn-window (event-start event)))
(bury-buffer)
(select-window owindow))
- (set-buffer buffer)
- (mouse-delete-max-match choice)
- (insert choice)
- ;; Update point in the window that BUFFER is showing in.
- (let ((window (get-buffer-window buffer t)))
- (set-window-point window (point)))
- (and (equal buffer (window-buffer (minibuffer-window)))
- (minibuffer-complete-and-exit))))
+ (choose-completion-string choice buffer)))
\f
;; Font selection.
(defvar x-fixed-font-alist
'("Font menu"
("Misc"
- ("6x10" "-misc-fixed-medium-r-normal--10-100-75-75-c-60-*-1")
- ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1")
- ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1")
+ ("6x10" "-misc-fixed-medium-r-normal--10-100-75-75-c-60-*-1" "6x10")
+ ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1" "6x12")
+ ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1" "6x13")
("lucida 13"
"-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1")
- ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1")
- ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1")
- ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1")
+ ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1" "7x13")
+ ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1" "7x14")
+ ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1" "9x15")
("")
("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1")
("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1")
)
"X fonts suitable for use in Emacs.")
-(defun mouse-set-font (&optional font)
+(defun mouse-set-font (&rest fonts)
"Select an emacs font from a list of known good fonts"
(interactive
(x-popup-menu last-nonmenu-event x-fixed-font-alist))
- (if font
- (progn (modify-frame-parameters (selected-frame)
- (list (cons 'font font)))
- ;; Update some standard faces too.
- (set-face-font 'bold nil (selected-frame))
- (make-face-bold 'bold (selected-frame) t)
- (set-face-font 'italic nil (selected-frame))
- (make-face-italic 'italic (selected-frame) t)
- (set-face-font 'bold-italic nil (selected-frame))
- (make-face-bold-italic 'bold-italic (selected-frame) t)
- ;; Update any nonstandard faces whose definition is
- ;; "a bold/italic/bold&italic version of the frame's font".
- (let ((rest global-face-data))
- (while rest
- (condition-case nil
- (if (listp (face-font (cdr (car rest))))
- (let ((bold (memq 'bold (face-font (cdr (car rest)))))
- (italic (memq 'italic (face-font (cdr (car rest))))))
- (if (and bold italic)
- (make-face-bold-italic (car (car rest)) (selected-frame))
- (if bold
- (make-face-bold (car (car rest)) (selected-frame))
- (if italic
- (make-face-italic (car (car rest)) (selected-frame)))))))
- (error nil))
- (setq rest (cdr rest))))
- )))
+ (if fonts
+ (let (font)
+ (while fonts
+ (condition-case nil
+ (progn
+ (set-default-font (car fonts))
+ (setq font (car fonts))
+ (setq fonts nil))
+ (error
+ (setq fonts (cdr fonts)))))
+ (if (null font)
+ (error "Font not found")))))
\f
;;; Bindings for mouse commands.
HCoop / bpt / emacs.git / blobdiff