;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Commentary:
+
+;; This package provides various useful commands (including help
+;; system access) through the mouse. All this code assumes that mouse
+;; interpretation has been abstracted into Emacs input events.
+;;
+;; The code is rather X-dependent.
+
;;; Code:
;;; Utility functions.
(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."
+This must be bound to a mouse drag event."
(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)
+ ;; If mark is highlighted, no need to bounce the cursor.
+ (or (and transient-mark-mode
+ (eq (framep (selected-frame)) 'x))
+ (sit-for 1))
(push-mark)
+ (set-mark (point))
(if (numberp (posn-point end))
(goto-char (posn-point end)))))
+(defun mouse-drag-region (click)
+ "Set the region to the text that the mouse is dragged over.
+This must be bound to a button-down mouse event."
+ (interactive "e")
+ (let ((posn (event-start click))
+ done event (mark-active nil))
+ (select-window (posn-window posn))
+ ;; Set point temporarily, so user sees where it is.
+ (if (numberp (posn-point posn))
+ (goto-char (posn-point posn)))
+ ;; Turn off the old mark when we set up an empty region.
+ (setq deactivate-mark t)))
+
+;;;Nice hack, but too slow.
+;;;(defun mouse-drag-region-1 (click)
+;;; "Set the region to the text that the mouse is dragged over.
+;;;This must be bound to a button-down mouse event."
+;;; (interactive "e")
+;;; (let (newmark)
+;;; (let ((posn (event-start click))
+;;; done event omark (mark-active t))
+;;; (select-window (posn-window posn))
+;;; (setq omark (and mark-active (mark)))
+;;; (if (numberp (posn-point posn))
+;;; (goto-char (posn-point posn)))
+;;; ;; Set mark temporarily, so highlighting does what we want.
+;;; (set-marker (mark-marker) (point))
+;;; (track-mouse
+;;; (while (not done)
+;;; (setq event (read-event))
+;;; (if (eq (car-safe event) 'mouse-movement)
+;;; (goto-char (posn-point (event-start event)))
+;;; ;; Exit when we get the drag event; ignore that event.
+;;; (setq done t))))
+;;; (if (/= (mark) (point))
+;;; (setq newmark (mark)))
+;;; ;; Restore previous mark status.
+;;; (if omark (set-marker (mark-marker) omark)))
+;;; ;; Now, if we dragged, set the mark at the proper place.
+;;; (if newmark
+;;; (push-mark newmark t)
+;;; ;; Turn off the old mark when we set up an empty region.
+;;; (setq deactivate-mark t))))
+
(defun mouse-set-mark (click)
"Set mark at the position clicked on with the mouse.
Display cursor at that position for a second.
(let ((point-save (point)))
(unwind-protect
(progn (mouse-set-point click)
- (push-mark nil t)
- (sit-for 1))
+ (push-mark nil t t)
+ (or transient-mark-mode
+ (sit-for 1)))
(goto-char point-save))))
(defun mouse-kill (click)
This does not delete the region; it acts like \\[kill-ring-save]."
(interactive "e")
(mouse-set-mark click)
- (call-interactively 'kill-ring-save))
+ (kill-ring-save (point) (mark t)))
;;; 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
(cons (cons (car kill-ring) (point)) buffer-undo-list))))
;; Otherwise, save this region.
(mouse-set-mark click)
- (call-interactively 'kill-ring-save)
+ (kill-ring-save (point) (mark t))
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))))
(setq head (cons
(cons
(format
- "%14s %s"
+ "%-14s %s"
(buffer-name elt)
(or (buffer-file-name elt) ""))
elt)
;;; ("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"))
+ ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
+ ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
+ ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
+ ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
+ ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
+ ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
+ ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
+ ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
+ ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
+ ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
+ ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
+ ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
+ ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
+ ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
+ ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
+ ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
+ ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
+ ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
+ ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
+ ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
+ ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
+ ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
+ ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
+ ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1"))
)
"X fonts suitable for use in Emacs.")
\f
;;; Bindings for mouse commands.
-;; This won't be needed once the drag and down events
-;; are properly implemented.
+(define-key global-map [down-mouse-1] 'mouse-drag-region)
(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)
HCoop / bpt / emacs.git / blobdiff