2

Is there a select region function that will preserve the selection if the region scrolls out of sight?

There are two kinds of selected region that I use on a daily basis. The first kind is with the shift key using an interactive code "^" in various movement functions -- e.g., left or right. The second kind is set-mark-command. In the first case, the highlighted region is deselected when I scroll up or down. In the second case, the highlighted region changes / moves if the selected region touches the top or bottom of the window when scrolling.

Ideally, I would like to select a region and then be free to move around the buffer from point-min to point-max.

lawlist
  • 13,099
  • 3
  • 49
  • 158
  • 1
    It should be fairly easy to write a package which stores the position of point before the first scroll command, and restores it before the first non-scroll command. Then it can get refined so that the highlighting of the region while scrolling reflects the "non-scrolled point" and so that the "scrolling point" is not drawn as a cursor. – Stefan Mar 07 '14 at 19:13

3 Answers3

3

I do not think there is such a function. The thing is emacs moves the point on scrolling (when the point moves out of window) that is why the selected region changes. See this question

Community
  • 1
  • 1
  • In theory, the beginning and ending points could be set to a buffer local variable -- when a portion of the selected region comes into view, the region can be re-highlighted and activated. Maybe the `post-command-hook` could be used for this purpose. When the region is deactivated by the user, the variables would be set back to `nil` so that the `post-command-hook` isn't firing the function all the time. – lawlist Mar 04 '14 at 18:30
  • 1
    @lawlist - the region is _defined_ by point, so the region changes as you move through a buffer. The region is **always** bounded by point on one end. I don't think there's any way to get around that, it's fundamental to how Emacs works. I think you'll need to find a way of remembering positions that does not use the region at all. – Tyler Mar 04 '14 at 19:54
  • @Tyler -- Hmmm . . . I'll give it some more thought -- something like `(isearch-highlight beg end)`, but have it be able to copy / cut / paste the region. – lawlist Mar 04 '14 at 20:03
  • 1
    @lawlist I don't know how Magnars' multiple-cursors mode works, but there might be some useful ideas in the code: https://github.com/magnars/multiple-cursors.el – Tyler Mar 04 '14 at 21:18
  • Thank both -- @Tyler and @Iqbal Ansari -- for the assistance. I believe I'm on the right track now. `mwheel-scroll` contained a `deactivate-mark`, which was causing the disappearance of my highlighted selected region. I've modified `mwheel-scroll` so that the selected region now becomes a fixed overlay if the `(point)` moves when scrolling up or down (i.e., because it nears `window-start` or `window-end`), and I've created additional functions to select a region and to copy the selected region. As time goes on, I'll continue to modify the sample answer with any updates to the code. – lawlist Mar 05 '14 at 17:22
  • @lawlist best of luck, I will also try to improve you solutions –  Mar 05 '14 at 18:31
2

That looks promising:

https://sites.google.com/site/steveyemacsutils/multi-select-el

There is also a multi-region.el at emacswiki.org

Andreas Röhler
  • 4,804
  • 14
  • 18
  • Thank you for the link to multi-select.el and the referral to multi-region.el. I'll take a look at both. – lawlist Mar 05 '14 at 13:07
1

INITIAL (March 4, 2014):  First rough draft.  lawlist-mwheel-scroll is a modification of mwheel-scroll within mwheel.el -- the primary modification was to remove (let ((newpoint (point))) (goto-char opoint) (deactivate-mark) (goto-char newpoint)) and replace it with a fixed overlay based upon region-begin and region-end immediately before scrolling up or down.

EDIT (March 5, 2014):  Revised lawlist-mwheel-scroll to behave more like mwheel-scroll was originally intended within mwheel.el. Because regions can be selected from left to right, or from right to left, the original-point could be on either side of the selected region. Therefore, region-begin and region-end are not used to calculate whether the point has moved -- we use original-point and compare it to the potential new (point) after scrolling has occurred. Consolidated the contents of the prior function lawlist-select-region into the function lawlist-activate-deactivate-mark such that the former is no longer used.

(global-set-key (kbd "C-c c") 'lawlist-copy-selected-region)

(global-set-key (kbd "C-SPC") 'lawlist-activate-deactivate-mark)

(global-set-key [(wheel)] 'lawlist-mwheel-scroll)

(global-set-key [(wheel-down)] 'lawlist-mwheel-scroll)

(global-set-key [(wheel-up)] 'lawlist-mwheel-scroll)

(defvar region-begin nil
  "The beginning of the selected region.")
(make-variable-buffer-local 'region-begin)

(defvar region-end nil
  "The ending of the selected region.")
(make-variable-buffer-local 'region-end)

(defun lawlist-activate-deactivate-mark ()
(interactive)
  (cond
    ;; newly selected region -- no prior overlay
    ((and
        (region-active-p)
        (not region-begin)
        (not region-end))
      (setq region-begin (region-beginning))
      (setq region-end (region-end))
      (overlay-put (make-overlay region-begin region-end) 'priority 1001)
      (overlay-put (make-overlay region-begin region-end) 'face isearch-face)
      (deactivate-mark t))
    ;; prior overlay + newly selected region
    ((and
        (region-active-p)
        region-begin
        region-end)
      (mapc 'delete-overlay (overlays-in region-begin region-end))
      (setq region-begin (region-beginning))
      (setq region-end (region-end))
      (overlay-put (make-overlay region-begin region-end) 'priority 1001)
      (overlay-put (make-overlay region-begin region-end) 'face isearch-face)
      (deactivate-mark t))
    ;; prior overlay -- no selected region -- inside of overlay
    ((and
        (not (region-active-p))
        region-begin
        region-end
        (and
          (>= (point) region-begin)
          (<= (point) region-end)))
      (message "[b]egin | [e]nd | [c]urrent | [d]eactivate")
      (let* ((extend-region (read-char-exclusive)))
        (cond
          ((eq extend-region ?b)
            (set-marker (mark-marker) region-begin (current-buffer))
            (setq mark-active t))
          ((eq extend-region ?e)
            (set-marker (mark-marker) region-end (current-buffer))
            (setq mark-active t))
          ((eq extend-region ?c)
            (set-marker (mark-marker) (point) (current-buffer))
            (setq mark-active t))
          ((eq extend-region ?d)
            (deactivate-mark t))))
      (mapc 'delete-overlay (overlays-in region-begin region-end)))
    ;; prior overlay -- no selected region -- outside of overlay
    ((and
        (not (region-active-p))
        region-begin
        region-end
        (or
          (< (point) region-begin)
          (> (point) region-end)))
      (mapc 'delete-overlay (overlays-in region-begin region-end))
      (setq region-begin nil)
      (setq region-end nil)
      (deactivate-mark t))
    (t
      (set-mark-command nil))))

(defun lawlist-copy-selected-region ()
(interactive)
  (cond
    ;; prior overlay + newly selected region
    ((and
        (region-active-p)
        region-begin
        region-end)
      (mapc 'delete-overlay (overlays-in region-begin region-end))
      (setq region-begin (region-beginning))
      (setq region-end (region-end)))
    ;; prior overlay + no region selected
    ((and
        (not (region-active-p))
        region-begin
        region-end)
      (mapc 'delete-overlay (overlays-in region-begin region-end)))
    ;; newly selected region -- no prior overlay
    ((and
        (region-active-p)
        (not region-begin)
        (not region-end))
      (setq region-begin (region-beginning))
      (setq region-end (region-end))) )
  (if (and region-begin region-end)
    (progn
      (copy-region-as-kill region-begin region-end)
      (message "copied:  %s"
        (concat
          (truncate-string-to-width
            (buffer-substring-no-properties region-begin region-end)
              40)
          (if
            (>
              (length
                (buffer-substring-no-properties region-begin region-end))
              40)
            " . . ."
            "")))
      (setq region-begin nil)
      (setq region-end nil))
    (message "To copy, you must first select a region.")))

(defun lawlist-mwheel-scroll (event)
  "Scroll up or down according to the EVENT.
This should only be bound to mouse buttons 4 and 5."
  (interactive (list last-input-event))
  (let* (
      (curwin
        (if mouse-wheel-follow-mouse
          (prog1
            (selected-window)
            (select-window (mwheel-event-window event)))))
      (buffer (window-buffer curwin))
      (original-point
        (with-current-buffer buffer
          (when (eq (car-safe transient-mark-mode) 'only)
            (point))))
      (mods
        (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
      (amt (assoc mods mouse-wheel-scroll-amount)))
    (with-current-buffer buffer
      (when (eq (car-safe transient-mark-mode) 'only)
        (setq region-begin (region-beginning))
        (setq region-end (region-end))))
    (if amt (setq amt (cdr amt))
      (let ((list-elt mouse-wheel-scroll-amount))
        (while (consp (setq amt (pop list-elt))))))
    (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
    (when (and mouse-wheel-progressive-speed (numberp amt))
      (setq amt (* amt (event-click-count event))))
    (unwind-protect
      (let ((button (mwheel-event-button event)))
        (cond
          ((eq button mouse-wheel-down-event)
            (condition-case nil (funcall mwheel-scroll-down-function amt)
              (beginning-of-buffer
               (unwind-protect
                   (funcall mwheel-scroll-down-function)
                 (set-window-start (selected-window) (point-min))))))
          ((eq button mouse-wheel-up-event)
            (condition-case nil (funcall mwheel-scroll-up-function amt)
              (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
          (t (error "Bad binding in mwheel-scroll"))))
      (if curwin (select-window curwin)))
    (with-current-buffer buffer
      (when
          (and
            original-point
            (/= (point) original-point))
        (overlay-put (make-overlay region-begin region-end) 'priority 1001)
        (overlay-put (make-overlay region-begin region-end) 'face isearch-face)
        (deactivate-mark t) )))
  (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
    (if mwheel-inhibit-click-event-timer
      (cancel-timer mwheel-inhibit-click-event-timer)
      (add-hook 'pre-command-hook 'mwheel-filter-click-events))
    (setq mwheel-inhibit-click-event-timer
      (run-with-timer mouse-wheel-inhibit-click-time nil
        'mwheel-inhibit-click-timeout))))

(put 'lawlist-mwheel-scroll 'scroll-command t)
lawlist
  • 13,099
  • 3
  • 49
  • 158