Subject: Re: bug#902: select-active-regions only half-working

From: David De La Harpe Golden <[email-masked]>
Date: Wed, 10 Sep 2008 22:45:23 +0100

Stefan Monnier wrote:

> Again, since this code is present at several places, move it into its
> own function.  Basically this function could turn the buffer value into
> a "cons of markers" value, so you can use it everywhere and reuse the
> code that handles a cons of markers.
>

Okay, sorry, I seem to have an irrational fear of introducing named
functions in elisp (possibly due to lack of CL packages I'm used to for
hiding). Attached.

Index: lisp/select.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/select.el,v
retrieving revision 1.44
diff -U 8 -r1.44 select.el
--- lisp/select.el	12 Jun 2008 03:56:16 -0000	1.44
+++ lisp/select.el	10 Sep 2008 20:37:34 -0000
@@ -123,16 +123,20 @@
 integer (or a cons of two integers or list of two integers).
 
 The selection may also be a cons of two markers pointing to the same buffer,
 or an overlay.  In these cases, the selection is considered to be the text
 between the markers *at whatever time the selection is examined*.
 Thus, editing done in the buffer after you specify the selection
 can alter the effective value of the selection.
 
+The selection may also be a buffer object. In that case, the selection is
+considered to be the region between the mark and point, if any, in that
+buffer, *at whatever time the selection is examined*.
+
 The data may also be a vector of valid non-vector selection values.
 
 The return value is DATA.
 
 Interactively, this command sets the primary selection.  Without
 prefix argument, it reads the selection in the minibuffer.  With
 prefix argument, it uses the text of the region as the selection value ."
   (interactive (if (not current-prefix-arg)
@@ -170,17 +174,18 @@
       (and (consp data)
 	   (markerp (car data))
 	   (markerp (cdr data))
 	   (marker-buffer (car data))
 	   (marker-buffer (cdr data))
 	   (eq (marker-buffer (car data))
 	       (marker-buffer (cdr data)))
 	   (buffer-name (marker-buffer (car data)))
-	   (buffer-name (marker-buffer (cdr data))))))
+	   (buffer-name (marker-buffer (cdr data))))
+      (bufferp data)))
 
 ;;; Cut Buffer support
 
 (declare-function x-get-cut-buffer-internal "xselect.c")
 
 (defun x-get-cut-buffer (&optional which-one)
   "Returns the value of one of the 8 X server cut-buffers.
 Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0.
@@ -206,18 +211,25 @@
       (x-rotate-cut-buffers-internal 1))
   (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
 
 
 ;;; Functions to convert the selection into various other selection types.
 ;;; Every selection type that Emacs handles is implemented this way, except
 ;;; for TIMESTAMP, which is a special case.
 
+(defun xselect-buffer-region-markers-cons (buffer)
+  "Helper function for xselect-convert functions given buffers. (Internal)"
+  (with-current-buffer buffer
+    (cons (mark-marker) (point-marker))))
+
 (defun xselect-convert-to-string (selection type value)
   (let (str coding)
+    (when (bufferp value)
+      (setq value (xselect-buffer-region-markers-cons value)))
     ;; Get the actual string from VALUE.
     (cond ((stringp value)
 	   (setq str value))
 
 	  ((overlayp value)
 	   (save-excursion
 	     (or (buffer-name (overlay-buffer value))
 		 (error "selection is in a killed buffer"))
@@ -291,16 +303,18 @@
 	    (error "Unknow selection type: %S" type))
 	   )))
 
       (setq next-selection-coding-system nil)
       (cons type str))))

 (defun xselect-convert-to-length (selection type value)
+  (when (bufferp value)
+    (setq value (xselect-buffer-region-markers-cons value)))
   (let ((value
 	 (cond ((stringp value)
 		(length value))
 	       ((overlayp value)
 		(abs (- (overlay-end value) (overlay-start value))))
 	       ((and (consp value)
 		     (markerp (car value))
 		     (markerp (cdr value)))
@@ -338,35 +352,41 @@
   (cond ((overlayp value)
 	 (buffer-file-name (or (overlay-buffer value)
 			       (error "selection is in a killed buffer"))))
 	((and (consp value)
 	      (markerp (car value))
 	      (markerp (cdr value)))
 	 (buffer-file-name (or (marker-buffer (car value))
 			       (error "selection is in a killed buffer"))))
+	((bufferp value)
+	 (buffer-file-name value))
 	(t nil)))
 
 (defun xselect-convert-to-charpos (selection type value)
+  (when (bufferp value)
+    (setq value (xselect-buffer-region-markers-cons value)))
   (let (a b tmp)
     (cond ((cond ((overlayp value)
 		  (setq a (overlay-start value)
 			b (overlay-end value)))
 		 ((and (consp value)
 		       (markerp (car value))
 		       (markerp (cdr value)))
 		  (setq a (car value)
 			b (cdr value))))
 	   (setq a (1- a) b (1- b)) ; zero-based
 	   (if (< b a) (setq tmp a a b b tmp))
 	   (cons 'SPAN
 		 (vector (cons (ash a -16) (logand a 65535))
 			 (cons (ash b -16) (logand b 65535))))))))
 
 (defun xselect-convert-to-lineno (selection type value)
+  (when (bufferp value)
+    (setq value (xselect-buffer-region-markers-cons value)))
   (let (a b buf tmp)
     (cond ((cond ((and (consp value)
 		       (markerp (car value))
 		       (markerp (cdr value)))
 		  (setq a (marker-position (car value))
 			b (marker-position (cdr value))
 			buf (marker-buffer (car value))))
 		 ((overlayp value)
@@ -379,16 +399,18 @@
 	     (setq a (count-lines 1 a)
 		   b (count-lines 1 b)))
 	   (if (< b a) (setq tmp a a b b tmp))
 	   (cons 'SPAN
 		 (vector (cons (ash a -16) (logand a 65535))
 			 (cons (ash b -16) (logand b 65535))))))))
 
 (defun xselect-convert-to-colno (selection type value)
+  (when (bufferp value)
+    (setq value (xselect-buffer-region-markers-cons value)))
   (let (a b buf tmp)
     (cond ((cond ((and (consp value)
 		       (markerp (car value))
 		       (markerp (cdr value)))
 		  (setq a (car value)
 			b (cdr value)
 			buf (marker-buffer a)))
 		 ((overlayp value)
Index: lisp/simple.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/simple.el,v
retrieving revision 1.945
diff -U 8 -r1.945 simple.el
--- lisp/simple.el	15 Aug 2008 00:30:44 -0000	1.945
+++ lisp/simple.el	10 Sep 2008 20:37:38 -0000
@@ -3416,44 +3416,55 @@
 is active, and returns an integer or nil in the usual way.
 
 If you are using this in an editing command, you are most likely making
 a mistake; see the documentation of `set-mark'."
   (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
       (marker-position (mark-marker))
     (signal 'mark-inactive nil)))
 
+(defcustom select-active-regions nil
+  "If non-nil, an active region automatically becomes the window selection.
+
+In conjunction with this, to ape some other X11 apps, you might want to:
+rebind mouse-2 to `mouse-yank-primary', set `x-select-enable-primary' to nil,
+set `x-select-enable-clipboard' to non-nil and set `mouse-drag-copy-region'
+to nil."
+  :type 'boolean
+  :group 'killing
+  :version "23.1")
+
 ;; Many places set mark-active directly, and several of them failed to also
 ;; run deactivate-mark-hook.  This shorthand should simplify.
 (defsubst deactivate-mark ()
   "Deactivate the mark by setting `mark-active' to nil.
 \(That makes a difference only in Transient Mark mode.)
 Also runs the hook `deactivate-mark-hook'."
   (when transient-mark-mode
+    (and mark-active select-active-regions
+	  (x-selection-owner-p nil)
+	  (x-set-selection nil (x-get-selection nil)))
     (if (or (eq transient-mark-mode 'lambda)
 	    (and (eq (car-safe transient-mark-mode) 'only)
 		 (null (cdr transient-mark-mode))))
 	(setq transient-mark-mode nil)
       (if (eq (car-safe transient-mark-mode) 'only)
 	  (setq transient-mark-mode (cdr transient-mark-mode)))
       (setq mark-active nil)
       (run-hooks 'deactivate-mark-hook))))
 
 (defun activate-mark ()
   "Activate the mark."
   (when (mark t)
     (setq mark-active t)
     (unless transient-mark-mode
-      (setq transient-mark-mode 'lambda))))
+      (setq transient-mark-mode 'lambda))
+    (when select-active-regions
+      (x-set-selection nil (current-buffer)))))
 
-(defcustom select-active-regions nil
-  "If non-nil, an active region automatically becomes the window selection."
-  :type 'boolean
-  :group 'killing
-  :version "23.1")
 
 (defun set-mark (pos)
   "Set this buffer's mark to POS.  Don't use this function!
 That is to say, don't use this function unless you want
 the user to see that the mark has moved, and you want the previous
 mark position to be lost.
 
 Normally, when a new mark is set, the old one should go on the stack.
@@ -3466,20 +3477,22 @@
 store it in a Lisp variable.  Example:
 
    (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
 
   (if pos
       (progn
 	(setq mark-active t)
 	(run-hooks 'activate-mark-hook)
-	(and select-active-regions
-	     (x-set-selection
-	      nil (buffer-substring (region-beginning) (region-end))))
-	(set-marker (mark-marker) pos (current-buffer)))
+	(set-marker (mark-marker) pos (current-buffer))
+	(when select-active-regions
+	  (x-set-selection nil (current-buffer))))
+    (and mark-active select-active-regions
+	 (x-selection-owner-p nil)
+	 (x-set-selection nil (x-get-selection nil)))
     ;; Normally we never clear mark-active except in Transient Mark mode.
     ;; But when we actually clear out the mark value too,
     ;; we must clear mark-active in any mode.
     (setq mark-active nil)
     (run-hooks 'deactivate-mark-hook)
     (set-marker (mark-marker) nil)))
 
 (defcustom use-empty-active-region nil
Index: lisp/mouse.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mouse.el,v
retrieving revision 1.347
diff -U 8 -r1.347 mouse.el
--- lisp/mouse.el	11 Aug 2008 01:23:05 -0000	1.347
+++ lisp/mouse.el	10 Sep 2008 20:37:39 -0000
@@ -906,16 +906,17 @@
 (defun mouse-drag-track (start-event  &optional
 				      do-mouse-drag-region-post-process)
     "Track mouse drags by highlighting area between point and cursor.
 The region will be defined with mark and point, and the overlay
 will be deleted after return.  DO-MOUSE-DRAG-REGION-POST-PROCESS
 should only be used by mouse-drag-region."
   (mouse-minibuffer-check start-event)
   (setq mouse-selection-click-count-buffer (current-buffer))
+  (deactivate-mark)
   (let* ((original-window (selected-window))
          ;; We've recorded what we needed from the current buffer and
          ;; window, now let's jump to the place of the event, where things
          ;; are happening.
          (_ (mouse-set-point start-event))
          (echo-keystrokes 0)
 	 (start-posn (event-start start-event))
 	 (start-point (posn-point start-posn))
@@ -950,17 +951,16 @@
     (if (< (point) start-point)
 	(goto-char start-point))
     (setq start-point (point))
     (if remap-double-click ;; Don't expand mouse overlay in links
 	(setq click-count 0))
     (mouse-move-drag-overlay mouse-drag-overlay start-point start-point
                              click-count)
     (overlay-put mouse-drag-overlay 'window start-window)
-    (deactivate-mark)
     (let (event end end-point last-end-point)
       (track-mouse
 	(while (progn
 		 (setq event (read-event))
                  (or (mouse-movement-p event)
                      (memq (car-safe event) '(switch-frame select-window))))
           (if (memq (car-safe event) '(switch-frame select-window))
 	      nil
@@ -1352,16 +1352,19 @@
 (defun mouse-yank-primary (click)
   "Insert the primary selection at the position clicked on.
 Move point to the end of the inserted text.
 If `mouse-yank-at-point' is non-nil, insert at point
 regardless of where you click."
   (interactive "e")
   ;; Give temporary modes such as isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
+  ;; if region is active and _is_ primary (due to select-active-regions)
+  ;; avoid doubling upon repeated consecutive clicks.
+  (and select-active-regions (deactivate-mark))
   (or mouse-yank-at-point (mouse-set-point click))
   (let ((primary (x-get-selection 'PRIMARY)))
     (if primary
         (insert (x-get-selection 'PRIMARY))
       (error "No primary selection"))))
 
 (defun mouse-kill-ring-save (click)
   "Copy the region between point and the mouse click in the kill ring.
2008-09-10  David De La Harpe Golden  <[email-masked]>

	* select.el: allow x-set-selection to take a buffer object that is
	inspected on-demand to obtain selection data from its region.
	* simple.el: lazy implementation of select-active-regions.
	* mouse.el: fix time-ordering of deactivate-mark operations in
	mouse drag tracking. Avoid doubling of selection in
	mouse-yank-primary when select-active-regions is on.