\f
;;; Utility functions.
-(defun mouse-movement-p (event)
- (and (consp event)
- (eq (car event) 'mouse-movement)))
-
-(defun event-window (event) (nth 1 event))
-(defun event-point (event) (nth 2 event))
-(defun mouse-coords (event) (nth 3 event))
-(defun mouse-timestamp (event) (nth 4 event))
+(defsubst mouse-movement-p (object)
+ "Return non-nil if OBJECT is a mouse movement event."
+ (and (consp object)
+ (eq (car object) 'mouse-movement)))
+
+(defsubst event-start (event)
+ "Return the starting position of EVENT.
+If EVENT is a mouse press or a mouse click, this returns the location
+of the event.
+If EVENT is a drag, this returns the drag's starting position.
+The return value is of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+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.
+The return value is of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+The `posn-' functions access elements of such lists."
+ (nth 2 event))
+
+(defsubst posn-window (position)
+ "Return the window in POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (nth 0 position))
+
+(defsubst posn-point (position)
+ "Return the buffer location in POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (nth 1 position))
+
+(defsubst posn-col-row (position)
+ "Return the row and column in POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (nth 2 position))
+
+(defsubst posn-timestamp (position)
+ "Return the timestamp of POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+nas returned by the `event-start' and `event-end' functions."
+ (nth 3 position))
;;; Indent track-mouse like progn.
(put 'track-mouse 'lisp-indent-function 0)
\f
(defun mouse-delete-window (click)
- "Delete the window clicked on.
-This must be bound to a mouse click."
- (interactive "K")
- (delete-window (event-window click)))
-
-(defun mouse-delete-other-windows (click)
- "Select Emacs window clicked on, then kill all other Emacs windows.
+ "Delete the window you click on.
This must be bound to a mouse click."
- (interactive "K")
- (select-window (event-window click))
+ (interactive "e")
+ (delete-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")
+ (let* ((window (posn-window (event-start click)))
+ (buf (window-buffer window))
+ (frame (new-frame)))
+ (select-frame frame)
+ (switch-to-buffer buf)
+ (delete-window window)))
+
+(defun mouse-delete-other-windows ()
+ "Delete all window except the one you click on."
+ (interactive "@")
(delete-other-windows))
(defun mouse-split-window-vertically (click)
"Select Emacs window mouse is on, then split it vertically in half.
The window is split at the line clicked on.
This command must be bound to a mouse click."
- (interactive "K")
- (select-window (event-window click))
- (split-window-vertically (1+ (cdr (mouse-coords click)))))
+ (interactive "@e")
+ (let ((start (event-start click)))
+ (select-window (posn-window start))
+ (split-window-vertically (1+ (cdr (posn-col-row click))))))
+
+(defun mouse-split-window-horizontally (click)
+ "Select Emacs window mouse is on, then split it horizontally in half.
+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)))))
(defun mouse-set-point (click)
"Move point to the position clicked on with the mouse.
This must be bound to a mouse click."
- (interactive "K")
- (select-window (event-window click))
- (if (numberp (event-point click))
- (goto-char (event-point click))))
+ (interactive "e")
+ (let ((posn (event-start click)))
+ (select-window (posn-window posn))
+ (if (numberp (posn-point posn))
+ (goto-char (posn-point posn)))))
+
+(defun mouse-set-region (click)
+ "Set the region to the text that the mouse is dragged over.
+This must be bound to a mouse click."
+ (interactive "e")
+ (let ((posn (event-start click))
+ (end (event-end click)))
+ (select-window (posn-window posn))
+ (if (numberp (posn-point posn))
+ (goto-char (posn-point posn)))
+ (sit-for 1)
+ (push-mark)
+ (if (numberp (posn-point end))
+ (goto-char (posn-point end)))))
(defun mouse-set-mark (click)
"Set mark at the position clicked on with the mouse.
Display cursor at that position for a second.
This must be bound to a mouse click."
- (interactive "K")
+ (interactive "e")
(let ((point-save (point)))
(unwind-protect
(progn (mouse-set-point click)
(defun mouse-kill (click)
"Kill the region between point and the mouse click.
The text is saved in the kill ring, as with \\[kill-region]."
- (interactive "K")
+ (interactive "e")
(let ((click-posn (event-point click)))
(if (numberp click-posn)
(kill-region (min (point) click-posn)
(defun mouse-yank-at-click (click arg)
"Insert the last stretch of killed text at the position clicked on.
Prefix arguments are interpreted as with \\[yank]."
- (interactive "K\nP")
+ (interactive "e\nP")
(mouse-set-point click)
(yank arg))
(defun mouse-kill-ring-save (click)
"Copy the region between point and the mouse click in the kill ring.
This does not delete the region; it acts like \\[kill-ring-save]."
- (interactive "K")
+ (interactive "e")
(mouse-set-mark click)
(call-interactively 'kill-ring-save))
+(defun mouse-save-then-kill (click)
+ "Copy the region between point and the mouse click in the kill ring.
+This does not delete the region; it acts like \\[kill-ring-save]."
+ (interactive "e")
+ (mouse-set-mark click)
+ (if (string= (buffer-substring (point) (mark)) (car kill-ring))
+ ;; If this text was already saved in kill ring,
+ ;; now delete it 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)))
+ ;; Otherwise, save this region.
+ (call-interactively 'kill-ring-save)))
+
(defun mouse-buffer-menu (event)
"Pop up a menu of buffers for selection with the mouse."
- (interactive "K")
+ (interactive "e")
(let ((menu
(list "Buffer Menu"
(cons "Select Buffer"
\f
;; Commands for the scroll bar.
-(defun mouse-scroll-down (nlines)
- (interactive "@p")
- (scroll-down nlines))
+(defun mouse-scroll-down (click)
+ (interactive "@e")
+ (scroll-down (1+ (cdr (mouse-coords click)))))
-(defun mouse-scroll-up (nlines)
- (interactive "@p")
- (scroll-up nlines))
+(defun mouse-scroll-up (click)
+ (interactive "@e")
+ (scroll-up (1+ (cdr (mouse-coords click)))))
(defun mouse-scroll-down-full ()
(interactive "@")
(interactive "@")
(scroll-up nil))
-(defun mouse-scroll-move-cursor (nlines)
- (interactive "@p")
- (move-to-window-line nlines))
+(defun mouse-scroll-move-cursor (click)
+ (interactive "@e")
+ (move-to-window-line (1+ (cdr (mouse-coords click)))))
(defun mouse-scroll-absolute (event)
(interactive "@e")
(goto-char newpos)
(recenter '(4)))))
-(defun mouse-scroll-left (ncolumns)
- (interactive "@p")
- (scroll-left ncolumns))
+(defun mouse-scroll-left (click)
+ (interactive "@e")
+ (scroll-left (1+ (car (mouse-coords click)))))
-(defun mouse-scroll-right (ncolumns)
- (interactive "@p")
- (scroll-right ncolumns))
+(defun mouse-scroll-right (click)
+ (interactive "@e")
+ (scroll-right (1+ (car (mouse-coords click)))))
(defun mouse-scroll-left-full ()
(interactive "@")
(interactive "@")
(scroll-right nil))
-(defun mouse-scroll-move-cursor-horizontally (ncolumns)
- (interactive "@p")
- (move-to-column ncolumns))
+(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")
(global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
(global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
(global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
+
+(global-set-key [horizontal-scroll-bar S-mouse-2]
+ 'mouse-split-window-horizontally)
+(global-set-key [mode-line S-mouse-2]
+ 'mouse-split-window-horizontally)
+(global-set-key [vertical-scroll-bar S-mouse-2]
+ 'mouse-split-window)
\f
;;;;
;;;; Here are experimental things being tested. Mouse events
(mouse-multiple-insert
(- (car relative-coordinate) (current-column)) " "))
((= (current-column) (car relative-coordinate)) (ding))))))
-
+\f
+;; Font selection.
+
+(defvar x-fixed-font-alist
+ '("Font menu"
+ ("Misc"
+ ("fixed" "fixed")
+ ("6x10" "6x10")
+ ("6x12" "6x12")
+ ("6x13" "6x13")
+ ("7x13" "7x13")
+ ("7x14" "7x14")
+ ("8x13" "8x13")
+ ("8x13 bold" "8x13bold")
+ ("8x16" "8x16")
+ ("9x15" "9x15")
+ ("9x15 bold" "9x15bold")
+ ("10x20" "10x20")
+ ("11x18" "11x18")
+ ("12x24" "12x24"))
+;;; We don't seem to have these; who knows what they are.
+;;; ("fg-18" "fg-18")
+;;; ("fg-25" "fg-25")
+;;; ("lucidasanstypewriter-12" "lucidasanstypewriter-12")
+;;; ("lucidasanstypewriter-bold-14" "lucidasanstypewriter-bold-14")
+;;; ("lucidasanstypewriter-bold-24" "lucidasanstypewriter-bold-24")
+;;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
+;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
+ ("Courier"
+ ("8" "-adobe-courier-medium-r-normal--8-*-*-*-m-*-iso8859-1")
+ ("10" "-adobe-courier-medium-r-normal--10-*-*-*-m-*-iso8859-1")
+ ("12" "-adobe-courier-medium-r-normal--12-*-*-*-m-*-iso8859-1")
+ ("14" "-adobe-courier-medium-r-normal--14-*-*-*-m-*-iso8859-1")
+ ("18" "-adobe-courier-medium-r-normal--18-*-*-*-m-*-iso8859-1")
+ ("24" "-adobe-courier-medium-r-normal--24-*-*-*-m-*-iso8859-1")
+ ("8 bold" "-adobe-courier-bold-r-normal--8-*-*-*-m-*-iso8859-1")
+ ("10 bold" "-adobe-courier-bold-r-normal--10-*-*-*-m-*-iso8859-1")
+ ("12 bold" "-adobe-courier-bold-r-normal--12-*-*-*-m-*-iso8859-1")
+ ("14 bold" "-adobe-courier-bold-r-normal--14-*-*-*-m-*-iso8859-1")
+ ("18 bold" "-adobe-courier-bold-r-normal--18-*-*-*-m-*-iso8859-1")
+ ("24 bold" "-adobe-courier-bold-r-normal--24-*-*-*-m-*-iso8859-1")
+ ("8 slant" "-adobe-courier-medium-o-normal--8-*-*-*-m-*-iso8859-1")
+ ("10 slant" "-adobe-courier-medium-o-normal--10-*-*-*-m-*-iso8859-1")
+ ("12 slant" "-adobe-courier-medium-o-normal--12-*-*-*-m-*-iso8859-1")
+ ("14 slant" "-adobe-courier-medium-o-normal--14-*-*-*-m-*-iso8859-1")
+ ("18 slant" "-adobe-courier-medium-o-normal--18-*-*-*-m-*-iso8859-1")
+ ("24 slant" "-adobe-courier-medium-o-normal--24-*-*-*-m-*-iso8859-1")
+ ("8 bold slant" "-adobe-courier-bold-o-normal--8-*-*-*-m-*-iso8859-1")
+ ("10 bold slant" "-adobe-courier-bold-o-normal--10-*-*-*-m-*-iso8859-1")
+ ("12 bold slant" "-adobe-courier-bold-o-normal--12-*-*-*-m-*-iso8859-1")
+ ("14 bold slant" "-adobe-courier-bold-o-normal--14-*-*-*-m-*-iso8859-1")
+ ("18 bold slant" "-adobe-courier-bold-o-normal--18-*-*-*-m-*-iso8859-1")
+ ("24 bold slant" "-adobe-courier-bold-o-normal--24-*-*-*-m-*-iso8859-1"))
+ )
+ "X fonts suitable for use in Emacs.")
+
+(defun mouse-set-font (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))))
\f
;;; Bindings for mouse commands.
;; are properly implemented.
(global-set-key [mouse-1] 'mouse-set-point)
-(global-set-key [down-mouse-1] 'mouse-set-point)
-(global-set-key [drag-mouse-1] 'mouse-set-mark)
+(global-set-key [drag-mouse-1] 'mouse-set-region)
(global-set-key [mouse-2] 'mouse-yank-at-click)
-(global-set-key [mouse-3] 'mouse-kill-ring-save)
-(global-set-key [S-mouse-3] 'mouse-kill)
+(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)
+
;; 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)
\f
;; Define the mouse help menu tree.
(defvar help-admin-map '(keymap "Administrivia"))
(define-key help-menu-map [apropos]
- (cons "Is there a command that..." help-apropos-map))
+ (cons "@Is there a command that..." help-apropos-map))
(define-key help-menu-map [keys]
- (cons "Key Commands <==> Functions" help-keys-map))
+ (cons "@Key Commands <==> Functions" help-keys-map))
(define-key help-menu-map [manuals]
- (cons "Manual and tutorial" help-manual-map))
+ (cons "@Manual and tutorial" help-manual-map))
(define-key help-menu-map [misc]
- (cons "Odds and ends" help-misc-map))
+ (cons "@Odds and ends" help-misc-map))
(define-key help-menu-map [modes]
- (cons "Modes" help-modes-map))
+ (cons "@Modes" help-modes-map))
(define-key help-menu-map [admin]
- (cons "Administrivia" help-admin-map))
+ (cons "@Administrivia" help-admin-map))
(define-key help-apropos-map "c" '("Command Apropos" . command-apropos))
(define-key help-apropos-map "a" '("Apropos" . apropos))
HCoop / bpt / emacs.git / blobdiff