🚀 go-pugleaf

Hi Epoch,

	I've sent you some submissions before about some secondary
selection features I've been developing.  I noticed that my stuff
didn't work if I was trying to copy from the RMAIL buffer to the
*mail* buffer, as I sometimes do when I need someone's address.  The
reasone it didn't work is what I think is a bug in your routine
mouse::copy-zone from mouse.el.
The bug is that you insist that both
(epoch::zone-start zone) and (epoch::zone-end zone)
be smaller than 
(point-max),
which is OK unless the buffer has been narrowed.  Let me quote from the
elisp manual:

 * Function: point-max
     This function returns the maximum accessible value of point in
     the current buffer.  This is `(1+ (buffer-size))', unless
     narrowing is in effect, in which case it is the position of the
     end of the region that you narrowed to.  (*Note Narrowing::).

 * Function: buffer-substring START END
     This function returns a string containing a copy of the text of
     the region defined by positions START and END in the current
     buffer.  If the arguments are not positions in the accessible
     portion of the buffer, Emacs signals an `args-out-of-range' error.

And that's the error message I got when trying to make secondary
selections from the RMAIL buffer!  

I'm sending you my fix along with all my other mouse specific code;
please consign my earlier submissions to the bit bucket.   There are
still some things I need to fix:
1) the mouse-modeline scrolling does not work with a split window.
The current-buffer gets scrolled rather than the buffer of the
modeline;
2) If I start an isearch in one window of a split window and click
left-mouse in the other window the point goes flying in the first
window.  
But I'll work on these!

Regards,
Bill


;;; Mouse customizations: 
;;; Hacked from motion.el to resemble Paul Burchard's mods of x-mouse.el
;;; 
;;; LEFT MOUSE   	= insert cursor and begin hiliting (underlining).
;;; MIDDLE MOUSE 	= end hiliting & set-mark & COPY hilited
;;;			  region to kill ring and X cut-buffer. 
;;;			     With double click fills-region-as-paragraph.
;;; RIGHT MOUSE  	= PASTE X cut-buffer at mouse.
;;; CUT (L10) BUTTON    = CUT hilited region.
;;; SHIFT MIDDLE MOUSE 	= CUT region between point and mouse.
;;; 
;;; More precisely, sh-mid-mouse-down HILITES and sh-mid-mouse-up CUTS.
;;; CUT does not take place if you pick up the shift key before
;;; picking up middle-mouse.

;;; Mouse actions giving textedit-like secondary selection capability. 
;;; 
;;; LEFT META MOUSE   		= begin secondary hiliting (grey stipple).
;;; MIDDLE META MOUSE-DOWN 	= hilite and COPY to X cut-buffer.
;;; MIDDLE META MOUSE-UP 	= PASTE here and un-hilite.
;;;					(pick up shift to cancel.)
;;; SHIFT MIDDLE META MOUSE-DOWN= hilite and COPY to X cut-buffer.  
;;; SHIFT MIDDLE META MOUSE-UP	= PASTE here and CUT there.  
;;;					(pick up shift-meta to cancel.)
;;; RIGHT META MOUSE 	 	= PASTE there.
;;; SHIFT MIDDLE META MOUSE 	= CUT there.  
;;;
;;; 
;;; support modeline mouse scrolling
;;; 
;;;  (LEFT MIDDLE RIGHT)-MODELINE MOUSE = (page-down recenter page-up)
;;;  SHIFT-(LEFT MIDDLE RIGHT)-MODELINE = (beg-file top-recenter end-file)


;;; first the modeline mouse scrolling:
(defun bill-mouse-scroll-up (arg)
   (scroll-up) )
(defun bill-mouse-scroll-down (arg)
   (scroll-down) )
(defun bill-mouse-recenter (arg)
   (recenter) )
(defun bill-mouse-ebuff-list (arg)
   (electric-buffer-list () ) )
(defun bill-beg-of-buffer (arg)
   (beginning-of-buffer) )
(defun bill-end-of-buffer (arg)
   (end-of-buffer) )
(defun bill-top-recenter (arg)
   (top-recenter) )

(defun top-recenter ()
  (interactive)
  (recenter 0))

(global-set-mouse mouse-mode-left mouse-shift 'bill-end-of-buffer)
(global-set-mouse mouse-mode-left mouse-down 'bill-mouse-scroll-up)

(global-set-mouse mouse-mode-right mouse-down 'bill-mouse-scroll-down)
(global-set-mouse mouse-mode-right mouse-shift 'bill-beg-of-buffer)

(global-set-mouse mouse-mode-middle mouse-down 'bill-mouse-recenter)

(global-set-mouse mouse-mode-middle mouse-meta 'bill-mouse-ebuff-list)
(global-set-mouse mouse-mode-middle mouse-shift 'bill-top-recenter)


;;;
;;; Now the Primary selection mouse customizations.  We don't
;;; support mouse dragging; this makes the motion.el code a lot more
;;; tractible.
;;;


(setq-default mouse-left-marker nil
  "marker which marks the last location of left-mouse."
)
(setq-default mouse-left-marker (make-marker))

(defvar drag-zone nil
  "Epoch zone to be used for hilighting selection by underlining.  For
copying,     zone-start = mouse-left-marker 	zone-end = mouse cursor.
For cutting, zone-start = point		 	zone-end = mouse cursor."
)
;(setq-default drag-zone nil)

(defvar elapsed nil)


(defun start-mouse-region (arg)
  "set the point (and mouse-left-marker) at the mouse cursor, delete
old drag zone and start new one."
    (mouse::set-point arg)
    (if drag-zone
      (progn
	(delete-zone drag-zone)
	(setq drag-zone nil)
	(redisplay-screen)
       )
    )
    (set-marker mouse-left-marker (car arg) (nth 1 arg))
    (abort-isearch)
)

(defun end-mouse-region (arg)
   "ends the highlited drag-zone, the region between mouse cursor
mouse-left-marker.  With a double click, fills-region-as-paragraph "
  (if drag-zone
     (move-zone drag-zone mouse-left-marker (car arg)
     )
     (setq drag-zone 
	(add-zone mouse-left-marker (car arg) motion::style) 
     )
  )	
; (set-zone-transient drag-zone t)
  (epoch::redisplay-screen)
  (mouse::copy-zone drag-zone)
  (push-mark (car arg) t)	
  (setq elapsed (- (aref epoch::event 3) mouse::time-stamp))
  (if (< elapsed mouse::interval) ; multi-click
    (fill-region-as-paragraph 
	(point) (zone-end drag-zone))
  )
)



(defun mouse-cut-and-wipe-text (arg)
  "Kill text between point and mouse, like x-cut-and-wipe-text"
  (if drag-zone
     (delete-zone drag-zone)
  )
  (setq drag-zone 
     (add-zone (point) (car arg) motion::style)
  )
  (epoch::redisplay-screen)
  (mouse::copy-zone drag-zone t)	
  (undo-boundary)
)



(defun mouse-cut-and-wipe-text (arg)
  "Kill text between point and mouse, like x-cut-and-wipe-text"
  (mouse::copy-zone drag-zone t)	
  (undo-boundary)
)

(defun mouse-show-x-text (arg)
  "Underlines text between point and mouse; like x-cut-and-wipe-text"
  (if drag-zone
     (move-zone drag-zone (point) (car arg)
     )
     (setq drag-zone 
	(add-zone (point) (car arg) motion::style)
     )
  )
; (set-zone-transient drag-zone t)
  (epoch::redisplay-screen)
)

(defun bill-mouse::paste-cut-buffer (arg)
   (progn 
	(mouse::paste-cut-buffer arg) 
   	(undo-boundary)
   	(mouse::set-point arg)
    	(abort-isearch)
   ) 
)


;;(defun bill-mouse::paste-cut-buffer (arg)
;;   (progn (mouse::paste-cut-buffer arg) (mouse::set-point arg)) )


(defun kill-underlined-region ()
"kills (and X-cuts) the underlined region of text; point is not
moved."
    (interactive)
    (mouse::copy-zone drag-zone t)	
    (undo-boundary)
)

(global-set-mouse mouse-left mouse-down 'start-mouse-region)
(global-set-mouse mouse-left mouse-shift 'start-mouse-region)

(global-set-mouse mouse-middle mouse-down 'end-mouse-region)

(global-set-mouse mouse-middle mouse-shift 'mouse-show-x-text)
(global-set-mouse mouse-middle mouse-shift-up 'mouse-cut-and-wipe-text)

(global-set-mouse mouse-right mouse-down 'bill-mouse::paste-cut-buffer)
(global-set-mouse mouse-right mouse-shift 'bill-mouse::paste-cut-buffer)


;;; 
;;; We define secondary selections for mouse actions, hacked from
;;; motion.el 
;;; 

;; makes secondary selection appear as gray stipple pattern.
(defvar sec:motion::style nil "style used by secondary drag zone")
(setq-default sec:motion::style (make-style))

;; this pattern is from the EPOCH-FAQ
(set-style-background sec:motion::style (foreground))
(set-style-background-stipple sec:motion::style
      (make-bitmap 4 4 "\167\273\335\356"))


(defvar sec:drag-zone nil
  "Epoch zone to be used for hilighting the secondary selection."
)
(setq-default sec:drag-zone nil)

;; sec:mouse-down-marker is the marker which marks the left boundary of
;; our secondary selection, made by clicking the left-meta mouse
  (setq-default sec:mouse-down-marker (make-marker))

(defun sec:start-mouse-region (arg)
;;; arg is a list of ( POINT BUFFER WINDOW SCREEN )
  "starts the epoch region sec:drag-zone, which is one character in
width, starting at location arg_0, in the buffer of arg_1"
    (set-marker sec:mouse-down-marker (car arg) (nth 1 arg))
    (if sec:drag-zone
      (progn
	(delete-zone sec:drag-zone)
	(setq sec:drag-zone nil)
	(redisplay-screen)
      )
    )
    (setq sec:drag-zone   
    	(add-zone (car arg) (+ 1 (car arg)) sec:motion::style 
  		  (nth 2 arg) (nth 1 arg)
      	) 
    )
)

(defun sec:end-mouse-region (arg)
   "ends the epoch zone sec:drag-zone, which will be hilited in a grey
stipple pattern."
  (if sec:drag-zone
     (move-zone sec:drag-zone sec:mouse-down-marker (car arg) (nth 1 arg)
     )
     (setq sec:drag-zone 
	(add-zone sec:mouse-down-marker (car arg) sec:motion::style 
  		  (nth 2 arg) (nth 1 arg)
	) 
     )
  )	
  (set-zone-transient sec:drag-zone t)
  (epoch::redisplay-screen)
  (mouse::sec:copy-zone sec:drag-zone)	
)


(defun sec:mouse-paste-here (arg)
   (yank) 
   (delete-zone sec:drag-zone)
   (setq sec:drag-zone nil)
   (undo-boundary)
)

(defun sec:hilite-region (arg)
 "kills (and X-cuts) the highlit region of text; point is not moved."
    (mouse::copy-zone sec:drag-zone t)	
    (undo-boundary)
)


(defun sec:mouse-paste-here-kill-there (arg)
   (yank) 
   (mouse::copy-zone sec:drag-zone t)	
   (delete-zone sec:drag-zone)
   (setq sec:drag-zone nil)
   (undo-boundary)
)

(defun sec:kill-there (arg)
   (mouse::copy-zone sec:drag-zone t)	
   (delete-zone sec:drag-zone)
   (setq sec:drag-zone nil)
   (undo-boundary)
)



(defun paste-there (arg)
   (progn 
	(mouse::paste-cut-buffer arg) 
   	(undo-boundary)
   ) 
)

(defun mouse::sec:copy-zone (zone)
  "A modification of mouse::copy-zone---``Copy the text in the ZONE to
the appropriate selection atom and to X cut-buffer'':
*** we don't test that (point-max) > (epoch::zone-start&end zone).  This
allows us to copy from the Rmail buffer, in which narrowing occurs;
*** for safety we do not allow optional kills. 
*** We make sure to restore the old buffer when we're done."
  (if (zonep zone)
    (let
      (
        (beg (epoch::zone-start zone) )
	(end (epoch::zone-end zone) )
	(buf (epoch::zone-buffer zone))
	text
      )
      (if (null beg) (setq beg 1))
      (if (null end) (setq end 1))
      (if (bufferp buf)
	(save-excursion
	  (set-buffer buf)
	  (setq text (buffer-substring beg end))
	)
	(setq text "")
      )
      (epoch::store-cut-buffer text)
      ; assert ownership of PRIMARY selection
      (epoch::acquire-selection mouse::selection-atom)
      ; store data so we people can paste from Epoch to other clients.
      (setq epoch::selection-alist
	(alist-delete mouse::selection-atom epoch::selection-alist))
      (setq epoch::selection-alist
	(cons
	  (cons
	    mouse::selection-atom text
	  )
	  epoch::selection-alist
	)
      )
      (if (/= beg end)
	(if (bufferp buf)
	  (save-excursion
	    (set-buffer buf)
	    (copy-region-as-kill beg end)
            ;; Eliminate replication on kill.
            (setq this-command nil)
	  )
	)
      )
    )
    (setq epoch::selection-alist
          (cons
           (cons
            mouse::selection-atom ""
            )
           (alist-delete mouse::selection-atom epoch::selection-alist)
           ))
    )
)

(global-set-mouse mouse-left mouse-meta 'sec:start-mouse-region)
(global-set-mouse mouse-middle mouse-meta 'sec:end-mouse-region)
(global-set-mouse mouse-middle mouse-meta-up 'sec:mouse-paste-here)

(global-set-mouse mouse-left mouse-meta-shift 'sec:start-mouse-region)
(global-set-mouse mouse-middle mouse-meta-shift 'sec:end-mouse-region)
(global-set-mouse mouse-middle mouse-meta-shift-up 
	'sec:mouse-paste-here-kill-there)

(global-set-mouse mouse-right mouse-meta-shift 'sec:end-mouse-region)
(global-set-mouse mouse-right mouse-meta-shift-up 'sec:kill-there)
(global-set-mouse mouse-right mouse-meta 'paste-there)