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

[David De La Harpe Golden]

Stefan Monnier wrote:
> Sorry, don't mind me, I was completely confused.
> 
> 
No worries.  Anyway, there's probably a much more elegant way:

(Background: I «gasp» read the docstring for x-set-selection, and
_thought_ I'd found a better way - it can take a cons of markers
to _lazily_ find the selection data as whatever's between
the markers when something requests the selection. However, it turns out
that the emacs point is _not_ in fact a marker, so you can't use
mark-marker and point-marker to find the region on-demand (point-marker
just returns a marker to the instantaneous position of the point))

*** Sooo - Here's a solution that seems generally saner, though does
wander deeper into the emacs core - allow x-set-selection to take a
function that will be funcalled on demand to return a string to use as
the selection data, not just a cons of markers.

Avoids performance issues that the moronic string-equal or hash in the
timer would introduce, and the (theoretical, for inhumanly fast users)
potential flakiness of an idle timer.


















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      9 Sep 2008 00:35:08 -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 function of one argument that returns a string.
+In that case, the selection is considered to be the string
+returned by the function *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,22 @@
       (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))))
+      ;; no real guarantee that an impure function that returns
+      ;; a string now will always do so, but might as well
+      ;; try it out, for early failure.
+      (and (functionp data)
+          (stringp (funcall 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.
@@ -229,17 +238,25 @@
                (markerp (cdr value)))
           (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
               (signal 'error
                       (list "markers must be in the same buffer"
                             (car value) (cdr value))))
           (save-excursion
             (set-buffer (or (marker-buffer (car value))
                             (error "selection is in a killed buffer")))
-            (setq str (buffer-substring (car value) (cdr value))))))
+            (setq str (buffer-substring (car value) (cdr value)))))
+
+         ((functionp value)
+          (let ((ret (funcall value)))
+            (if (stringp ret)
+                (setq str ret)
+              (signal 'error
+                      (list "selection function must return string"
+                            value ret))))))
 
     (when str
       ;; If TYPE is nil, this is a local request, thus return STR as
       ;; is.  Otherwise, encode STR.
       (if (not type)
          str
        (setq coding (or next-selection-coding-system selection-coding-system))
        (if coding
@@ -304,17 +321,24 @@
               ((and (consp value)
                     (markerp (car value))
                     (markerp (cdr value)))
                (or (eq (marker-buffer (car value))
                        (marker-buffer (cdr value)))
                    (signal 'error
                            (list "markers must be in the same buffer"
                                  (car value) (cdr value))))
-               (abs (- (car value) (cdr value)))))))
+               (abs (- (car value) (cdr value))))
+              ((functionp value)
+               (let ((ret (funcall value)))
+                 (if (stringp ret)
+                     (length ret)
+                   (signal 'error
+                           (list "no selection length found"
+                                 value ret))))))))
     (if value ; force it to be in 32-bit format.
        (cons (ash value -16) (logand value 65535))
       nil)))
 
 (defun xselect-convert-to-targets (selection type value)
   ;; return a vector of atoms, but remove duplicates first.
   (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
         (rest all))
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      9 Sep 2008 00:35:12 -0000
@@ -3416,44 +3416,60 @@
 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, set `mouse-drag-copy-region'
+to nil, and turn on `transient-mark-mode'."
+  :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
     (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))))
+      (run-hooks 'deactivate-mark-hook))
+    (and select-active-regions
+        (x-selection-owner-p nil)
+        (< (region-beginning) (region-end))
+        (x-set-selection
+         nil (buffer-substring (region-beginning) (region-end))))))
 
 (defun activate-mark ()
   "Activate the mark."
   (when (mark t)
     (setq mark-active t)
     (unless transient-mark-mode
-      (setq transient-mark-mode 'lambda))))
-
-(defcustom select-active-regions nil
-  "If non-nil, an active region automatically becomes the window selection."
-  :type 'boolean
-  :group 'killing
-  :version "23.1")
+      (setq transient-mark-mode 'lambda))
+    (and select-active-regions
+        (x-set-selection
+         nil (lambda ()
+               (if (< (region-beginning) (region-end))
+                   (buffer-substring (region-beginning) (region-end))
+                 ""))))))
 
 (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 +3482,28 @@
 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)
+       (set-marker (mark-marker) pos (current-buffer))
        (and select-active-regions
             (x-set-selection
-             nil (buffer-substring (region-beginning) (region-end))))
-       (set-marker (mark-marker) pos (current-buffer)))
+             nil (lambda ()
+               (if (< (region-beginning) (region-end))
+                   (buffer-substring (region-beginning) (region-end))
+                 "")))))
+    (and mark-active select-active-regions
+        (< (region-beginning) (region-end))
+        (x-selection-owner-p nil)
+        (x-set-selection
+         nil (buffer-substring (region-beginning) (region-end))))
     ;; 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       9 Sep 2008 00:35:13 -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

2008-09-06 David De La Harpe Golden <david@harpegolden.net>

        * select.el: allow x-set-selection to take a function
                     that is called on-demand to obtain selection data.

        * simple.el: lazy implementation of select-active-regions.

        * mouse.el:  fix time-ordering of deactivate-mark operations
                     in mouse drag tracking.