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

[Stefan Monnier]

>> 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.

You can use the double dash convention (i.e. "<prefix>--") to indicate
that this function is "for internal use".


        Stefan


> 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  <david@harpegolden.net>

>       * 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.