;;; -*-Scheme-*-
;;;
;;; $Id: mousecom.scm,v 1.5 2000/06/11 04:32:26 cph Exp $
;;;
;;; Copyright (c) 1989-2000 Massachusetts Institute of Technology
;;;
;;; This program 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 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;;; Mouse Commands

(declare (usual-integrations))

(define-command mouse-select
  "Select window the mouse is on."
  ()
  (lambda ()
    (select-window (button-event/window (current-button-event)))))

(define-command mouse-keep-one-window
  "Select window mouse is on, then kill all other windows."
  ()
  (lambda ()
    ((ref-command mouse-select))
    ((ref-command delete-other-windows))))

(define-command mouse-select-and-split
  "Select window mouse is on, then split it vertically in half."
  ()
  (lambda ()
    ((ref-command mouse-select))
    ((ref-command split-window-vertically) false)))

(define-command mouse-set-point
  "Select window mouse is on, and move point to mouse position."
  ()
  (lambda ()
    (let ((button-event (current-button-event)))
      (let ((window (button-event/window button-event)))
	(select-window window)
	(set-current-point!
	 (or (window-coordinates->mark window
				       (button-event/x button-event)
				       (button-event/y button-event))
	     (buffer-end (window-buffer window))))))))

(define-command mouse-set-mark
  "Select window mouse is on, and set mark at mouse position.
Display cursor at that position for a second."
  ()
  (lambda ()
    (let ((button-event (current-button-event)))
      (let ((window (button-event/window button-event)))
	(select-window window)
	(let ((mark
	       (or (window-coordinates->mark window
					     (button-event/x button-event)
					     (button-event/y button-event))
		   (buffer-end (window-buffer window)))))
	  (push-current-mark! mark)
	  (mark-flash mark))))))

(define-command mouse-show-event
  "Show the mouse position in the minibuffer."
  ()
  (lambda ()
    (let ((button-event (current-button-event)))
      (message "window: " (button-event/window button-event)
	       " x: " (button-event/x button-event)
	       " y: " (button-event/y button-event)))))

(define-command mouse-scroll-up
  "Scroll up mouse-scroll-increment lines."
  ()
  (lambda ()
    (scroll-window (selected-window)
		   (ref-variable mouse-scroll-increment)
		   (lambda () unspecific))))

(define-command mouse-scroll-down
  "Scroll down mouse-scroll-increment lines."
  ()
  (lambda ()
    (scroll-window (selected-window)
		   (- (ref-variable mouse-scroll-increment))
		   (lambda () unspecific))))

(define-variable mouse-scroll-increment
  "Number of lines by which a mouse-scroll event moves."
  5
  exact-nonnegative-integer?)

(define-command mouse-ignore
  "Don't do anything."
  ()
  (lambda () unspecific))

(define button1-down (make-down-button 0))
(define button2-down (make-down-button 1))
(define button3-down (make-down-button 2))
(define button4-down (make-down-button 3))
(define button5-down (make-down-button 4))
(define button1-up (make-up-button 0))
(define button2-up (make-up-button 1))
(define button3-up (make-up-button 2))
(define button4-up (make-up-button 3))
(define button5-up (make-up-button 4))