🚀 go-pugleaf

|> Message  9:
|> From epoch-m@cs.uiuc.edu Thu Jul  8 09:29:37 1993
|> To: epoch@cs.uiuc.edu
|> Date: Thu, 08 Jul 1993 14:31:48 GMT
|> Organization: Mentor Graphics Corporation
|> Reply-To: john_vella@mentorg.com
|> Subject: Q?  Is there any support for double/triple clicking?
|>

John Vella writes:

|> does anyone know how to get the double/triple click behavior of xterms
|> supported inside epoch(i am using version 4.2)?  by this i mean, that
|> a double click selects the word under point and a triple click selects
|> the whole line.

Here is a replacement for the epoch-lisp/motion.el file that does just
what you ask for.  It supports double click for words, tripple click
for lines and quad click for the entire file.

Note that motion.el is usually linked in when Epoch is built, but you
can also use this code with something like: (load-file "/x/y/z/motion").

What this code does not support is double/tripple clicking and then
dragging words/lines.  Just thought I would mention it in case someone
has an urge to write some elisp...

----

;;; Copyright (C) 1991 Christopher J. Love
;;;
;;; This file is for use with Epoch, a modified version of GNU Emacs.
;;; Requires Epoch 4.0 or later.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
;;; responsibility to anyone for the consequences of using this code
;;; or for whether it serves any particular purpose or works at all,
;;; unless explicitly stated in a written agreement.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; this code, but only under the conditions described in the
;;; GNU Emacs General Public License, except the original author nor his
;;; agents are bound by the License in their use of this code.
;;; (These special rights for the author in no way restrict the rights of
;;;  others given in the License or this prologue)
;;; A copy of this license is supposed to have been given to you along
;;; with Epoch so you can know your rights and responsibilities.
;;; It should be in a file named COPYING.  Among other things, the
;;; copyright notice and this notice must be preserved on all copies.
;;;
;;; $Revision: 1.11 $
;;; $Source: /import/kaplan/stable/distrib/epoch-4.0p2/epoch-lisp/RCS/motion.el,v $
;;; $Date: 92/06/02 02:19:20 $
;;; $Author: marca $
;;;
;;; motion.el - provide draggin/hi-lighting of primary selection
;;;
;;; Original version by Alan Carroll
;;; Epoch 4.0 modifications by Chris Love
;;; Abort-isearch and other ideas from Ken Laprade and others.
;;;
;;; 10-Aug-92 gerdh@ims.com
;;;
;;; Added code to mark words with a double click, lines with a tripple click
;;;  and everything with a quad click.  Some of this code was taken from the
;;;  IMOUSE package from Martin Boyer (Le laboratoire de robotique de
;;;  l'Institut de recherche d'Hydro-Quebec) <mboyer@ireq-robot.hydro.qc.ca>
;;;  (ftp ireq-robot.hydro.qc.ca  /pub/emacs/lisp)
;;; Fixed a problem with dragging at the end of the file.  This used to leave
;;;  you looking at a blank window.  It now doesn't scroll beyond the last line.
;;;
(provide 'motion)
(require 'zone)
(require 'mouse)

;;; ------------------------------------------------------------------------
;;; Interface values
(defvar mouse-show-position t
  "*If t, display the mouse character position for each mouse click.")

(defvar horizontal-drag-inc 5
  "Number of columns to scroll when the pointer is to the left or right of the window")
(defvar vertical-drag-inc 2
  "Number of lines to scroll when the pointer is above or below the edge of the window")

(defvar mouse::downp nil "State variable for mouse dragging internals")
(defvar mouse::last-point -1 "Last location of a motion event")

(setq epoch::zones-modify-buffer nil)
(defvar motion::style nil "style used by drag zones")

(defvar drag-zone nil
  "Epoch zone to be used for hilighting selected text region."
)
(setq-default drag-zone nil)
(setq-default mouse-down-marker nil)

;;; ------------------------------------------------------------------------
;;; Set window-setup-hook to call motion::init(), which sets default
;;; style for zone dragging.  Default style is underlining; can be changed
;;; in .emacs file.
(epoch-add-setup-hook 'motion::init)

(defun motion::init ()
  (and (not motion::style) (setq motion::style (make-style)))
  (set-style-foreground motion::style (foreground))
  (set-style-background motion::style (background))
  (set-style-underline motion::style (foreground))
  ;; enable the handler
  (push-event 'motion 'motion::handler)
  ;; set up hints on all the current screens
  (dolist (s (screen-list t)) (epoch::set-motion-hints t s))
  ;; enable hints on future screens
  (push '(motion-hints t) epoch::screen-properties)
  )

;;; ------------------------------------------------------------------------
;;; Functions to display current mouse position, mark words and lines.
;;; (From Martin Boyer's IMOUSE package <mboyer@ireq-robot.hydro.qc.ca>)
(defun what-cursor-coordinates ()
  "Print line and column number of the cursor."
  (interactive)
  (if mouse-show-position
      (if (not (eq (nth 2 arg) (minibuffer-window)))
      ;; Don't display if cursor is in the minibuffer.
;;    (setq mode-line-process (format " %d, %d"  ;; Alternative to message
      (message "(%d, %d)"
	       (current-column)
	       (save-excursion
		 (beginning-of-line)
		 (1+ (count-lines 1 (point))))))))

(defun mouse-set-drag-position (begin end buffer)
  "Set the beginning and end of the drag-zone to BEGIN and END in BUFFER."
  (if drag-zone
      (setq drag-zone (epoch::move-zone drag-zone begin end buffer))
      (setq drag-zone (add-zone begin end motion::style nil buffer))
  )
)

(defun mouse-select-word (arg)
  "Select the word around the mouse cursor."
  (let (b)
    (mouse::set-point arg)
    (setq mouse::downp t)
    (forward-char 1)
    (forward-word -1)
    (setq b (point))
    (forward-word 1)
    (mouse-set-drag-position b (point) (current-buffer))
    (end-mouse-drag arg)
    ;; Leave cursor at start of word.
    (forward-word -1)
    (what-cursor-coordinates)))

(defun mouse-select-line (arg)
  "Select the entire line around the mouse cursor."
  (let (b)
    (mouse::set-point arg)
    (setq mouse::downp t)
    (beginning-of-line 1)
    (setq b (point))
    (beginning-of-line 2)
    (if (and mouse-show-position (not (eq (nth 2 arg) (minibuffer-window))))
      (message "Marked 1 line (%d characters)" (- (point) b)))
    (mouse-set-drag-position b (point) (current-buffer))
    (end-mouse-drag arg)
    ;; Leave cursor at start of line.
    (forward-line -1)))

(defun mouse-select-buffer (arg)
  "Select the entire buffer."
  (let (b)
    (push-mark)
    (mouse::set-point arg)
    (setq mouse::downp t)
    (goto-char (point-min))
    (setq b (point))
    (goto-char (point-max))
    (mouse-set-drag-position b (point) (current-buffer))
    (end-mouse-drag arg)
    ;; Leave cursor at original (first click) position.
    (pop-mark)
    (exchange-point-and-mark)
    (set-mark (point))
    (if (and mouse-show-position (not (eq (nth 2 arg) (minibuffer-window))))
      ;; Display how much we marked if cursor is not in minibuf.
      (message "Marked %d lines (%d characters)"
	       (count-lines (point-min) (point-max))
	       (point-max)))))


;;; ------------------------------------------------------------------------
(defun set-mouse-marker (&optional location)
  (if (null mouse-down-marker)
    (setq mouse-down-marker (make-marker))
  )
  (set-marker mouse-down-marker (or location (point)))
)

;;; --------------------------------------------------------------------------
;;; Functions to provide dragging & hilighting.
;;; arg is a list of ( POINT BUFFER WINDOW SCREEN )
(defun start-mouse-drag (arg)
  "Set point at mouse.
If double-click -- select the current word
   triple-click -- selects the current line
   quad-click   -- select entire buffer
If mouse-show-position is non-nil, displays the current column and line number."
  (when arg
    (setq mouse::downp 'start)
    (mouse::set-point arg)
    (set-mouse-marker)
    (setq mouse::last-point (point))
    (if drag-zone
      (progn
	(delete-zone drag-zone)
	(setq drag-zone nil)
	(redisplay-screen)
      )
    )
    (abort-isearch)

    ;; Display mouse coordinates
    (what-cursor-coordinates)

    ;; Process multiple clicks.
    (if (eq mouse::clicks 2) (mouse-select-word arg))
    (if (eq mouse::clicks 3) (mouse-select-line arg))
    (if (eq mouse::clicks 4) (mouse-select-buffer arg))
  )
)

(defun extend-mouse-drag (arg)
  (setq mouse::downp 'extend)
  (let
    (
      (m1 (and drag-zone (zone-start drag-zone)))
      (m2 (and drag-zone (zone-end drag-zone)))
      (spot (min (car arg) (point-max))) ;point of the mouse click.
    )
    (if (null m1) (setq m1 0))
    (if (null m2) (setq m2 0))
    (cond
      ((or (null drag-zone) (null mouse-down-marker))
	(setq drag-zone (add-zone (point) spot motion::style) )
	(set-zone-transient drag-zone t)
	(set-mouse-marker)
      )
      ((<= spot m1)
	(setq drag-zone (move-zone drag-zone spot m2) )
	(set-mouse-marker m2)
      )
      ((>= spot m2)
	(setq drag-zone (move-zone drag-zone m1 spot) )
	(set-mouse-marker m1)
      )
      ((<= mouse-down-marker spot)
	(setq drag-zone (move-zone drag-zone m1 spot) )
	(set-mouse-marker m1)
      )
      (t
	(setq drag-zone (move-zone drag-zone spot m2) )
	(set-mouse-marker m2)
      )
    )
    (epoch::redisplay-screen)
    (setq mouse::last-point (point))
  )
)

(defun end-mouse-drag (arg)
  (setq mouse::last-point -1)		;always do this cleanup
  (when mouse::downp
    (setq mouse::downp nil)
    ;; Only change the X selection if we have something new to put in it.  This
    ;;  allows the user to move the mouse cursor and then do a paste.
    (if (and drag-zone (< (zone-start drag-zone) (zone-end drag-zone)))
	(mouse::copy-zone drag-zone))
    (let (
	(s (and drag-zone (zone-start drag-zone)))
	(e (and drag-zone (zone-end drag-zone)))
      )
      (if (null s) (setq s 1))
      (if (null e) (setq e 1))
      (if (zonep drag-zone)
	(if (<= (point) s)
	  (progn
	    (push-mark e t)
            ;; Bandaid...?
            ;; (goto-char s)
            (goto-char (min s (point-max)))
	  )
        ;; ELSE point is past drag zone start
	  (progn
	    (push-mark s t)
            ;; Bandaid...?
            ;; (goto-char e)
	    (goto-char (min e (point-max)))
	  )
	)
      )
    )
  )
)

;;; ------------------------------------------------------------------------
;;; Define the handler for dragging, etc.
(defun motion::handler (type value scr)
  (if (null mouse-down-marker) (set-mouse-marker))
  (if (and (boundp 'mouse::downp) mouse::downp)
    (mouse-sweep-update)
  )
)

;;; Update drag-zone for mouse sweep.
(defun mouse-sweep-update()
  (let*
    (
      drag-m1
      drag-m2
      pnt
      pos
      x
      y
      do-scroll
      (w (selected-window))
      (out-of-bounds t)
      (epoch::event-handler-abort nil)
      (w-edges (window-pixedges w))
      (left (car w-edges))
      (top (elt w-edges 1))
      (right (- (elt w-edges 2) left 1))
      (bottom (- (elt w-edges 4) top 1))
    )
    (if (not drag-zone)
      (progn
        (setq drag-zone
	  (add-zone mouse-down-marker (point) motion::style )
	)
	(set-zone-transient drag-zone t)
      )
    )
    (while
      (and
        out-of-bounds
	(setq pos (query-pointer))
	(/= 0 (logand mouse-any-mask (elt pos 2)))
      )
      ;; convert to window relative co-ordinates
      (setq x (- (car pos) left))
      (setq y (- (elt pos 1) top))
      (setq out-of-bounds
        (not (and (<= 0 y) (<= y bottom) (<= 0 x) (<= x right)))
      )

      (condition-case errno
	(progn
	  ;; Mouse if off the top of the window.  Scroll text down.
	  (if (< y 0) (scroll-down vertical-drag-inc))

	  ;; Mouse if off the bottom of window.  Scroll down only until
	  ;;  last line is visible.  This keeps us from looking at an
	  ;;  empty window when user drags to the end of file.
	  (if (> y bottom)
	      (progn
		(save-excursion
		  (move-to-window-line -1)
		  (setq do-scroll (< (point) (point-max))))
		(if do-scroll (scroll-up vertical-drag-inc)))))
	(error)			; nothing, just catch it
      )
;; Disable horizontal scrolling.
;      (if (< x left) (scroll-right horizontal-drag-inc))
;      (if (> x right) (scroll-left horizontal-drag-inc))
      (setq y (max 1 (min bottom y)))
      (setq x (max 0 (min right x)))

      (setq pnt (car (epoch::coords-to-point (+ x left) (+ y top))))
      (when (/= mouse::last-point pnt)
	(if (> mouse-down-marker pnt)
	  (progn
            (setq drag-m1 pnt)
            (setq drag-m2 (marker-position mouse-down-marker))
	  )
	  (progn
	    (setq drag-m1 (marker-position mouse-down-marker))
	    (setq drag-m2 pnt)
	  )
	)
	(move-zone drag-zone drag-m1 drag-m2)
	(redisplay-screen)
      )
      (setq mouse::last-point pnt)
    )
  )
)

;;; ------------------------------------------------------------------------
;;; Code for selecting lines using motion events. Assumes that the line is
;;; left unmarked on zone up
(defvar mouse::line-zone nil "Zone for selected line")
;;;
(defun mouse-select-line-start (arg)
  (mouse::set-point arg)		;go there
  (setq mouse::last-point (point))
  (let ( bol )
    (save-excursion
      (beginning-of-line)
      (setq bol (point))
      (end-of-line)
      (setq mouse::line-zone (add-zone bol (point) motion::style))
    )
  )
  (push-event 'motion 'mouse-select-line-update)
)
;;;
(defun mouse-select-line-end (arg)
  (setq mouse::last-point -1)
  (when mouse::line-zone (delete-zone mouse::line-zone))
  (pop-event 'motion)
)
;;;
(defun mouse-select-line-update (type value scr)
  (let*
    (
      y
      pos
      bol
      (out-of-bounds t)
      (epoch::event-handler-abort nil)
      (w-edges (window-pixedges (selected-window)))
      (top (elt w-edges 1))
      (bottom (- (elt w-edges 4) top 1))
      max-vscroll
    )
    (while
      (and
	out-of-bounds
	(setq pos (query-pointer))
	(/= 0 (logand mouse-any-mask (elt pos 2)))
      )
      ;;convert to window relative co-ordinates
      (setq y (- (elt pos 1) top))
      (setq out-of-bounds (not (and (<= 0 y) (<= y bottom))))

      ;; Scrolling hard, because of possibly shrink-wrapped windows.
      ;; set max-vscroll to be the most we could scroll down and not have
      ;; empty lines at the bottom
      (save-excursion
	(move-to-window-line bottom)	;go to the last line in the window
	(setq max-vscroll
	  (- vertical-drag-inc (forward-line vertical-drag-inc))
	)
	(if (and (> max-vscroll 0) (eobp) (= 0 (current-column)))
	  (decf max-vscroll)
	)
      )
      (condition-case errno
	(progn
	  (if (< y 0) (scroll-down vertical-drag-inc))
	  (if (> y bottom) (scroll-up (min max-vscroll vertical-drag-inc)))
	)
	;; CONDITIONS
	(error)				;nothing, just want to catch it
      )
      (setq y (max 0 (min bottom y)))

      ;;move to the new point
      (move-to-window-line y)
      (beginning-of-line) (setq bol (point))
      (end-of-line)
      (when (/= mouse::last-point (point))
	(move-zone mouse::line-zone bol (point))
	(epoch::redisplay-screen)
      )
      (setq mouse::last-point (point))
    )
  )
)

;; Blow out of any current isearch
(defun abort-isearch () "Abort any isearch in progress."
  (condition-case err
      (throw 'search-done t)
    (no-catch nil)))

;;; ------------------------------------------------------------------------
;;; Scroll mouse line to top, center or bottom of screen
(defun mouse-line-to-top (arg)
  "Put the line where the mouse is at the top of the window."
  (mouse::set-point arg)
  (recenter 0)
)

(defun mouse-line-to-center (arg)
  "Put the line where the mouse is at the center of the window."
  (mouse::set-point arg)
  (recenter '(1))
)

(defun mouse-line-to-bottom (arg)
  "Put the line where the mouse is at the center of the window."
  (mouse::set-point arg)
  (recenter -1)
)

;;; --------------------------------------------------------------------------
(defun mouse-set-spot (arg)
  "Set point at mouse.  With double-click, set mark there as well.
Blinks matching paren if sitting after one.  Intended to be bound
to a window down button."
  (start-mouse-drag arg)
  (let ((buf (current-buffer))
        (p (point)))
    (mouse::set-point arg)
    (if (and (equal p (point))
             (equal buf (current-buffer)))
        (if (and (= mouse::clicks 1)
                 (not (eq (mark) (point))))
            (push-mark))
      (setq mouse::clicks 0))
    (if (eq (char-syntax (preceding-char)) ?\))
          (blink-matching-open)))
  (abort-isearch))

;;; --------------------------------------------------------------------------
;;; install all our various handlers
(global-set-mouse mouse-left mouse-down 'start-mouse-drag)
(global-set-mouse mouse-left mouse-up 'end-mouse-drag)
(global-set-mouse mouse-right mouse-down 'extend-mouse-drag)
(global-set-mouse mouse-right mouse-up 'end-mouse-drag)
(global-set-mouse mouse-middle mouse-down 'mouse::paste-cut-buffer)

--------------------------------------
Gerd Hoeren
  Integrated Measurement Systems, Inc.
  Beaverton, Oregon  (USA)
  Voice: (503) 626-7117
  Fax:   (503) 644-6969
  Email: gerdh@ims.com
--------------------------------------