🚀 go-pugleaf

Thanks to all who replied to this; I've made this code into something
more useable outside our setup. It requires Imouse in order to work,
but replaces some of it. Primary selections work in the usual OpenLook
fashion, secondaries only coming out of epoch. (ie it doesn't use the
secondary selection mechanism itself) It also requires that you be able
to bind L6 L8 and L10; you'll probably have your own conventions for
this. The keystroke for make-region-selection could well be something
else. The logic for deciding which of the selection or region to use is
a little odd, but turns out to be convenient.
---
Andrew McGregor,
Physics, University of Canterbury, Christchurch, New Zealand.
adm@phys.canterbury.ac.nz


;;; .emacs fragment for ol-cut-and-paste
;;; The strange control characters here are a local convention; use
;;; whatever works for you. note that these require ^^ installed as a
;;; prefix.

(require 'ol-cut-and-paste)
(rebind-key "space"        'mod4 "\C-^A ")  ;; Alt-space
(rebind-key "F18" 0 "\C-^H")          ;; L8 Paste
(rebind-key "F20" 0 "\C-^J")          ;; L10 Cut
(rebind-key "F16" 0 "\C-^L") ;; L6 Copy note: L `cos F conflicts with F1 etc.


(global-set-key "\C-^L" 'copy-selection) ;copy

(global-set-key "\C-^H" 'get-selection)  ;paste

(global-set-key "\C-^J" 'cut-selection)  ;cut

(global-set-key "\C-^A " 'make-region-selection) ;Alt-space

;;; ol-cut-and-paste.el
;;; open look style cut and paste bindings
;;;  preliminary 92 11 26 adm
;;;  replaces some parts of imouse.
;;;  would be nicer if it was just a direct replacement for imouse.
;;;  defines the keyfunctions but doesn't bind them.
;;;  I've mostly just left commented out stuff that needed removing
;;;  from imouse-do-bindings

(require 'imouse)
(provide 'ol-cut-and-paste)

;;; we want to set the X selection automatically
(setq auto-set-X-selection t)

;;; but it back automatically too
(setq auto-get-X-selection t)

;;; so copy key sets the killbuffer too.
(setq auto-X-selection-to-killbuffer t)

(defvar mouse-select mouse-left
  "*The mouse button used to select.  Usually mouse-left.")

(defvar mouse-modify mouse-middle
  "*The mouse button used to modify.
Usually mouse-middle for Open Look, and mouse-right for twm.")

;;; mouse should never insert anything
(defvar mouse-paste nil
  "*The mouse button used to paste.
Usually mouse-right for Open Look, and mouse-middle for twm.")

;;; nor delete anything, but leave the defn in
(defvar mouse-delete-modifier mouse-shift
  "*The modifier used to delete with the mouse.")

(defvar mouse-thing-modifier mouse-control
  "*The modifier used to operate 
on objects with the mouse.")

(defvar mouse-window-modifier mouse-meta
  "*The modifier used to operate on emacs windows with the mouse.")


;;; my functions
;;; this one helps make cut and paste with the region work better.
;;; also a good way of finding out what region is
(defun make-region-selection ()
  "Make the current region also the current selection"
  (interactive)
  (cond
   (drag-zone (move-zone drag-zone (region-beginning) (region-end) (current-buffer)))
   ((not drag-zone) (setq drag-zone 
			  (add-zone (region-beginning) (region-end) 
				    motion::style nil (current-buffer))))  
   ((eq (region-beginning) (region-end)) (setq drag-zone nil))
   )
  )

;;; this relies on the mark being set by a mouse seln.
(defun region-eq-selection-p ()
  "Is the region the same as the selection?"
(interactive)
  (and drag-zone
       (or (eq (mark) (zone-end drag-zone))(eq (mark) (zone-start drag-zone)))
       )
  )

;;; functions from imouse.el, modified slightly.
(defun get-X-selection ()
  "Insert the current X selection or cut-buffer at point."
  (interactive)
  ;; Stolen from mouse::paste-cut-buffer
  ;; Get text from selection PRIMARY, insert text once it's there.
  (let ((text (epoch::convert-selection mouse::selection-atom
					"STRING" "PROPERTY")))
    (if (stringp text)
	(insert text)			; selection is owned and has a value
      (insert (get-cut-buffer))))	; grab cut-buffer instead
  )

(defun get-selection ()
  "Insert the epoch selection, or the X selection if auto-get-X-selection
is on. Clear either selection if set."
  (interactive)
  (cond (auto-get-X-selection 
	 (get-X-selection) 
	 (message "X inserted") 
	 )
        ((and (imouse::region-selected) (region-eq-selection-p))
	 (insert (zone-text drag-zone))
	 (message "Selection inserted")  
	 (delete-zone drag-zone))
	(t
	 (yank) 
	 (message "Yanked!"))
	)
  )

(defun copy-selection () 
  "Export the selection to X, or the region if the two are sufficiently different."
  (interactive) 
  (if (not (region-eq-selection-p)) 
      (make-region-selection))
  (set-X-selection) 
  (message "X exported")
  )

(defun cut-selection ()
  "Cut selected text (or region if sufficiently different), set the X selection."
  (interactive)
  (if (not (region-eq-selection-p))
      (make-region-selection))
  (set-X-selection)
  (when (interactive-p) (message "X exported"))
  (kill-region (zone-start drag-zone) (zone-end drag-zone))
  )



;;; functions from motion.el
;;; I've forgotten what I changed here...
;;; arg is a list of ( POINT BUFFER WINDOW SCREEN )
(defun mouse-start-selection (mdata)
  "Set point at mouse and prepare for drag selection. If mouse-show-position
is non-nil, displays the current line and column number."
  (setq imouse::selection-type 'char)
  (setq this-command 'mouse-start-selection)
  (abort-isearch)
  (set-mouse-marker)
  (setq mouse::last-point (point))
  (push-mark (point))
  (if mouse-show-position (what-cursor-coordinates)))

(defun mouse-set-point-or-select (mdata)
  "Set point at mouse.  With double-click, selects the current word,
with triple-click, selects the current line.  If mouse-show-position
is non-nil, displays the current line, column number and buffer."
  (mouse::set-point mdata)
  (setq mouse::downp t)
  (if (and (eq (car mouse::last-spot) (car mdata))
	   (eq (cadr mouse::last-spot) (cadr mdata))
	   (> mouse::clicks 1))
      (case mouse::clicks
	(2 (mouse-select-word mdata))
	(3 (mouse-select-line mdata)))
    (mouse-start-selection mdata)))


(defun end-mouse-drag (arg)
  (setq mouse::last-point -1)		;always do this cleanup
  (when mouse::downp
    (setq mouse::downp nil)
    (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)))
	      )
	    )
	)
      )
    )
  )

(defun start-mouse-drag (arg)
  (when arg
    (setq mouse::downp 'start)
    (mouse::set-point arg)
    (abort-isearch)
    (set-mouse-marker)
    (setq mouse::last-point (point))
    (if drag-zone
	(progn
	  (delete-zone drag-zone)
	  (setq drag-zone nil)
	  (redisplay-screen)
	  )
      )
    )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;  Standard mouse bindings  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun imouse-do-bindings ()
  "Bind the mouse keys according to user preferences.
First bind mouse-select, mouse-modify, and mouse-paste to either
mouse-left, mouse-middle, or mouse-right, then bind
mouse-delete-modifier, mouse-thing-modifier, and mouse-window-modifier
to either mouse-shift, mouse-control, or mouse-meta.
Calling this function will do the actual binding."
  (let ((SELECT       mouse-select)
	(MODIFY	      mouse-modify)
	(PASTE	      mouse-paste)
	(LEFT	      mouse-left)
	(MIDDLE	      mouse-middle)
	(RIGHT	      mouse-right)
	(MODE-SELECT  (+ mouse-select mouse-mode -1))
	(MODE-MODIFY  (+ mouse-modify mouse-mode -1))
	(MODE-RIGHT   (+ mouse-right mouse-mode -1))
	(DOWN	      mouse-down)
	(UP	      mouse-up)
	(DELETE	      mouse-delete-modifier)
	(THING	      mouse-thing-modifier)
	(WINDOW	      mouse-window-modifier)
	(ALL	      mouse-meta-control-shift))
    
    (global-set-mouse SELECT	  DOWN		    'mouse-set-point-or-select)
    (global-set-mouse SELECT	  UP		    nil)
;;;    (global-set-mouse SELECT	  DELETE	    'mouse-delete-char)
    (global-set-mouse SELECT	  DELETE	    nil)
    (global-set-mouse SELECT	  THING		    'mouse-select-thing)
;;;    (global-set-mouse SELECT	  (+ DELETE THING)  'mouse-kill-thing)
    (global-set-mouse SELECT	  (+ DELETE THING)  nil)

    
    (global-set-mouse MODIFY	  DOWN		    'extend-mouse-drag)
    (global-set-mouse MODIFY	  UP		    'end-mouse-drag)
;;;    (global-set-mouse MODIFY	  DELETE	    'mouse-kill-region)
    (global-set-mouse MODIFY	  DELETE	    nil)
    (global-set-mouse MODIFY	  THING		    'mouse-select-bigger-thing)
;;;    (global-set-mouse MODIFY	  (+ DELETE THING)  'mouse-kill-bigger-thing)
    
;;;    (global-set-mouse RIGHT	  DOWN		    'mouse-set-point-and-paste)
;;;    (global-set-mouse RIGHT	  UP		    nil)
;;;    (global-set-mouse RIGHT	  DELETE	    'mouse-move-selection)
;;;    (global-set-mouse RIGHT	  THING		    'mouse-copy-thing)
;;;    (global-set-mouse RIGHT	  (+ DELETE THING)  'mouse-move-thing)
    
;;;    (global-set-mouse SELECT	  WINDOW	    'mouse-toggle-focus-screen)
;;;    (global-set-mouse SELECT	  (+ WINDOW DELETE) 'mouse-indent)
;;;    (global-set-mouse MODIFY	  (+ DELETE THING)  'mouse-kill-bigger-thing)
    
    (global-set-mouse RIGHT	  DOWN		    'mouse-line-to-center)
    (global-set-mouse RIGHT	  UP		    nil)
    (global-set-mouse RIGHT	  DELETE	    nil)
    (global-set-mouse RIGHT	  THING		    nil)
    (global-set-mouse RIGHT	  (+ DELETE THING)  nil)
    
    (global-set-mouse SELECT	  WINDOW	    nil)
    (global-set-mouse SELECT	  (+ WINDOW DELETE) nil)
    (global-set-mouse MODIFY	  (+ DELETE THING)  nil)    

    (global-set-mouse MODIFY	  WINDOW	    'mouse-drag-scroll)
    (global-set-mouse MODIFY	  (+ WINDOW UP)	    'mouse-drag-scroll-terminate)
;;;    (global-set-mouse MODIFY	  (+ WINDOW DELETE) 'mouse-fill)
    (global-set-mouse MODIFY	  (+ WINDOW DELETE) nil)
    
;;;    (global-set-mouse RIGHT	  WINDOW	    'mouse-menu)
    (global-set-mouse RIGHT	  WINDOW	    nil)
    (global-set-mouse RIGHT	  (+ WINDOW DELETE) 'mouse-exec-kbd-macro)
    
    (global-set-mouse SELECT	  (+ WINDOW THING)  'mouse-line-to-top)
    (global-set-mouse MODIFY	  (+ WINDOW THING)  'mouse-line-to-center)
    (global-set-mouse RIGHT	  (+ WINDOW THING)  'mouse-line-to-bottom)
    
;;;    (global-set-mouse SELECT	  ALL		    'mouse-summary)
    (global-set-mouse SELECT	  ALL		    nil)
;;;    (global-set-mouse MODIFY	  ALL		    'mouse-play)
    (global-set-mouse MODIFY	  ALL		    nil)
;;;    (global-set-mouse RIGHT	  ALL		    'mouse-tutorial)
    (global-set-mouse RIGHT	  ALL		    nil)
    
    (global-set-mouse MODE-SELECT DOWN		    'mouse-delete-other-windows)
    (global-set-mouse MODE-SELECT DELETE	    'mouse-delete-window)
    
    (global-set-mouse MODE-MODIFY DOWN		    'mouse-move-modeline)
    (global-set-mouse MODE-MODIFY UP		    'mouse-move-modeline-terminate)
;;;    (global-set-mouse MODE-MODIFY DELETE	    'mouse-move-window)
    (global-set-mouse MODE-MODIFY DELETE	    nil)
;;;    (global-set-mouse MODE-MODIFY (+ DELETE UP)	    'mouse-move-window-terminate)
    (global-set-mouse MODE-MODIFY (+ DELETE UP)	    nil)
    
    (global-set-mouse MODE-RIGHT  DOWN		    'mouse-split-window)
;;;    (global-set-mouse MODE-RIGHT  DELETE	    'next-buffer)
    (global-set-mouse MODE-RIGHT  DELETE	    nil)
    )
  )