🚀 go-pugleaf

Here is a modified version of epoch-lisp/motion.el that implements the
following additional mouse features for the left mouse
(start-mouse-drag) function:

     Double Click	Select word
     Tripple Click	Select line
     Quad Click		Select all

Other minor changes are:

    o  Moving point with the mouse no longer clears the X selection.
       This allows you to mark a region, move the pointer with the
       mouse and then do a paste (just like XEdit or XTerm).

    o  It displays the column and line position when point is moved with
       the mouse.  This can be disabled with (setq mouse-show-position nil).

    o  If you drag the mouse off the end of a file, it no longer
       leaves you looking at a blank screen.

    o  Functions mouse-line-to-top, mouse-line-center, and
       mouse-line-bottom can be assigned to scroll the text to the
       top, center or bottom of the window if you put the following in
       your ~/.emacs file:

       (global-set-mouse mouse-left   mouse-meta 'mouse-line-to-top)
       (global-set-mouse mouse-middle mouse-meta 'mouse-line-to-center)
       (global-set-mouse mouse-right  mouse-meta 'mouse-line-to-bottom)


This file is a direct replacement for either V4.0 or V4.2 motion.el.
You can try it out with:

    (load-file "motion.el")

Note that motion.el is loaded into Epoch at build (dump) time.  If you
like these changes, you may want to rebuild the Epoch executable to
include this version of motion.el.

----

While I'm at it, we use the following with dired (or dired-19) to
create a new window and open a file.  We assign it to the right and
shift/right mouse buttons.

;;
;; This function creates a new screen when finding a file.
;;  It sets the screen and icon name.
;;
(defun my-find-file (filename)
  "Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
creating one if none already exists."
  (interactive "FFind file: ")
  (select-screen
   (create-screen
    filename
    (list
     (cons 'title filename)
     (if (equal (substring filename -1 nil) "/")
	 ;; The file name ends with a slash.  Remove it so that
	 ;;  file-name-nondirectory picks up the last component.
	 ;;  We then append a trailing slash.
	 (cons 'icon-name (concat (file-name-nondirectory
				   (substring filename 0 -1))
				  "/"))
       ;; Normal path name.  Pick up file name only.
       (cons 'icon-name (file-name-nondirectory filename))))))
  (switch-to-buffer (find-file-noselect filename)))

;;
;; Find file name around cursor
;;
(defun pointer-get-filename ()
  "Return name of file pointed to on this line.
Value returned normally includes the default directory name.
If the name pointed to starts with a slash, then name is
returned as is."
  (interactive)
  (save-excursion
      (skip-chars-backward "^ \*\"<(\n\t")
      (let ((beg (point)))
         (skip-chars-forward "^ \*\">)\n\t")
         (if (equal (substring (buffer-substring beg (point)) 0 1) "/")
             (buffer-substring beg (point))
             (concat default-directory  (buffer-substring beg (point)))))))

;;
;; Right mouse:   Click         - Create window/open file
;;                Shift/click   - Close window/kill buffer
;;
(global-set-mouse mouse-right  mouse-down       'mouse::set-point)
(global-set-mouse mouse-right  mouse-up         '(lambda (arg)
						   (my-find-file
						    (pointer-get-filename))))
(global-set-mouse mouse-right  mouse-shift-up   '(lambda (arg) (interactive)
						   (kill-buffer (current-buffer))

----- File epoch-lisp/motion.el -----

;;; 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.
  Voice: (503) 626-7117
  Fax:   (503) 644-6969
  Email: gerdh@ims.com
--------------------------------------