(setq event (read-event))
(or (mouse-movement-p event)
(eq (car-safe event) 'switch-frame)))
-
(if (eq (car-safe event) 'switch-frame)
nil
(setq end (event-end event)
(numberp (posn-point (event-end event))))
(let ((fun (key-binding (vector (car event)))))
(if (memq fun '(mouse-set-region mouse-set-point))
- (progn
- (push-mark (overlay-start mouse-drag-overlay) t t)
- (goto-char (overlay-end mouse-drag-overlay)))
+ (if (not (= (overlay-start mouse-drag-overlay)
+ (overlay-end mouse-drag-overlay)))
+ (let (this-command)
+ (push-mark (overlay-start mouse-drag-overlay) t t)
+ (goto-char (overlay-end mouse-drag-overlay))
+ (copy-region-as-kill (point) (mark t)))
+ (goto-char (overlay-end mouse-drag-overlay))
+ (setq this-command 'mouse-set-point))
(if (fboundp fun)
(funcall fun event)))))
(delete-overlay mouse-drag-overlay))))
(skip-syntax-backward syntax)
(skip-syntax-forward syntax))
(if (< dir 0)
- (while (= (preceding-char) char)
+ (while (and (not (bobp)) (= (preceding-char) char))
(forward-char -1))
- (while (= (following-char) char)
+ (while (and (not (eobp)) (= (following-char) char))
(forward-char 1))))))
;; Return a list of region bounds based on START and END according to MODE.
(list start end))
((and (= mode 1)
(= start end)
+ (not (eobp))
(= (char-syntax (char-after start)) ?\())
(list start (save-excursion (forward-sexp 1) (point))))
((and (= mode 1)
(= start end)
+ (not (eobp))
(= (char-syntax (char-after start)) ?\)))
(list (save-excursion
(goto-char (1+ start))
- (backward-sexp 1))
+ (backward-sexp 1)
+ (point))
(1+ start)))
((= mode 1)
(list (save-excursion
Prefix arguments are interpreted as with \\[yank]."
(interactive "e\nP")
(mouse-set-point click)
+ (setq this-command 'yank)
(yank arg))
(defun mouse-kill-ring-save (click)
;;; invocation of mouse-save-then-kill.
(defvar mouse-save-then-kill-posn nil)
-(defun mouse-save-then-kill-delete-region ()
+(defun mouse-save-then-kill-delete-region (beg end)
;; Delete just one char, so in case buffer is being modified
;; for the first time, the undo list records that fact.
- (delete-region (point)
- (+ (point) (if (> (mark) (point)) 1 -1)))
- ;; Now delete the rest of the specified region,
- ;; but don't record it.
- (let ((buffer-undo-list t))
- (delete-region (point) (mark)))
+ (delete-region beg
+ (+ beg (if (> end beg) 1 -1)))
+ (let ((buffer-undo-list buffer-undo-list))
+ ;; Undo that deletion--but don't change the undo list!
+ (primitive-undo 1 buffer-undo-list)
+ ;; Now delete the rest of the specified region,
+ ;; but don't record it.
+ (setq buffer-undo-list t)
+ (delete-region beg end))
(if (not (eq buffer-undo-list t))
(let ((tail buffer-undo-list))
;; Search back in buffer-undo-list for the string
(setq tail (cdr tail)))
;; Replace it with an entry for the entire deleted text.
(and tail
- (setcar tail (cons (car kill-ring) (point)))))))
+ (setcar tail (cons (car kill-ring) (min beg end)))))))
(defun mouse-save-then-kill (click)
"Save text to point in kill ring; the second time, kill the text.
(if (not (and (eq last-command 'mouse-save-then-kill)
(equal click-posn
(car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
- (let* ((obeg (min (point) (mark t)))
- (oend (max (point) (mark t)))
- (beg (min obeg click-posn))
- (end (if (< click-posn obeg) oend click-posn))
- (range
- (mouse-start-end beg end mouse-selection-click-count))
- (nbeg (if (= beg obeg) obeg (car range)))
- (nend (if (= end oend) oend (nth 1 range))))
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn))
- (set-mark nbeg)
- (goto-char nend)
+ ;; Find both ends of the object selected by this click.
+ (let* ((range
+ (mouse-start-end click-posn click-posn
+ mouse-selection-click-count)))
+ ;; Move whichever end is closer to the click.
+ ;; That's what xterm does, and it seems reasonable.
+ (if (< (abs (- click-posn (mark t)))
+ (abs (- click-posn (point))))
+ (set-mark (car range))
+ (goto-char (nth 1 range)))
;; We have already put the old region in the kill ring.
;; Replace it with the extended region.
;; (It would be annoying to make a separate entry.)
(setcar kill-ring (buffer-substring (point) (mark t)))
+ (if interprogram-cut-function
+ (funcall interprogram-cut-function (car kill-ring)))
+ ;; Arrange for a repeated mouse-3 to kill this region.
+ (setq mouse-save-then-kill-posn
+ (list (car kill-ring) (point) click-posn))
(mouse-show-mark))
;; If we click this button again without moving it,
;; that time kill.
- (mouse-save-then-kill-delete-region))
+ (mouse-save-then-kill-delete-region (point) (mark)))
(if (and (eq last-command 'mouse-save-then-kill)
mouse-save-then-kill-posn
(eq (car mouse-save-then-kill-posn) (car kill-ring))
(equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
;; If this is the second time we've called
;; mouse-save-then-kill, delete the text from the buffer.
- (mouse-save-then-kill-delete-region)
- ;; Otherwise, save this region.
- (mouse-set-mark-fast click)
- (kill-ring-save (point) (mark t))
- (mouse-show-mark)
+ (mouse-save-then-kill-delete-region (point) (mark))
+ (if (or (eq last-command 'mouse-save-then-kill)
+ (and mark-active transient-mark-mode)
+ (and (eq last-command 'mouse-drag-region)
+ (or mark-even-if-inactive
+ (not transient-mark-mode))))
+ ;; We have a selection or suitable region, so adjust it.
+ (let* ((posn (event-start click))
+ (new (posn-point posn)))
+ (select-window (posn-window posn))
+ (if (numberp new)
+ (progn
+ ;; Move whichever end of the region is closer to the click.
+ ;; That is what xterm does, and it seems reasonable.
+ (if (< (abs (- new (point))) (abs (- new (mark t))))
+ (goto-char new)
+ (set-mark new))
+ (setq deactivate-mark nil)))
+ (setcar kill-ring (buffer-substring (point) (mark t)))
+ (if interprogram-cut-function
+ (funcall interprogram-cut-function (car kill-ring))))
+ ;; We just have point, so set mark here.
+ (mouse-set-mark-fast click)
+ (kill-ring-save (point) (mark t))
+ (mouse-show-mark))
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn))))))
\f
(setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
(overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
-(defun mouse-drag-secondary (click)
+(defun mouse-drag-secondary (start-event)
"Set the secondary selection to the text that the mouse is dragged over.
+Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event."
(interactive "e")
- (let ((posn (event-start click)))
- (save-window-excursion
- (select-window (posn-window posn))
- ;; Set point temporarily, so user sees where it is.
- (save-excursion
- (if (numberp (posn-point posn))
- (goto-char (posn-point posn)))
- (setq unread-command-events
- (cons (read-event) unread-command-events))))))
+ (let* ((start-posn (event-start start-event))
+ (start-point (posn-point start-posn))
+ (start-window (posn-window start-posn))
+ (start-frame (window-frame start-window))
+ (bounds (window-edges start-window))
+ (top (nth 1 bounds))
+ (bottom (if (window-minibuffer-p start-window)
+ (nth 3 bounds)
+ ;; Don't count the mode line.
+ (1- (nth 3 bounds))))
+ (click-count (1- (event-click-count start-event))))
+ (save-excursion
+ (set-buffer (window-buffer start-window))
+ (setq mouse-selection-click-count click-count)
+ (or mouse-secondary-overlay
+ (setq mouse-secondary-overlay
+ (make-overlay (point) (point))))
+ (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
+ (if (> click-count 0)
+ ;; Double or triple press: make an initial selection
+ ;; of one word or line.
+ (let ((range (mouse-start-end start-point start-point click-count)))
+ (set-marker mouse-secondary-start nil)
+ (move-overlay mouse-secondary-overlay 1 1
+ (window-buffer start-window))
+ (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
+ (window-buffer start-window)))
+ ;; Single-press: cancel any preexisting secondary selection.
+ (or mouse-secondary-start
+ (setq mouse-secondary-start (make-marker)))
+ (set-marker mouse-secondary-start start-point)
+ (delete-overlay mouse-secondary-overlay))
+ (let (event end end-point)
+ (track-mouse
+ (while (progn
+ (setq event (read-event))
+ (or (mouse-movement-p event)
+ (eq (car-safe event) 'switch-frame)))
+
+ (if (eq (car-safe event) 'switch-frame)
+ nil
+ (setq end (event-end event)
+ end-point (posn-point end))
+ (cond
+
+ ;; Ignore switch-frame events.
+ ((eq (car-safe event) 'switch-frame))
+
+ ;; Are we moving within the original window?
+ ((and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ (if (/= start-point end-point)
+ (set-marker mouse-secondary-start nil))
+ (let ((range (mouse-start-end start-point end-point
+ click-count)))
+ (move-overlay mouse-secondary-overlay
+ (car range) (nth 1 range))))
+
+ ;; Are we moving on a different window on the same frame?
+ ((and (windowp (posn-window end))
+ (eq (window-frame (posn-window end)) start-frame))
+ (let ((mouse-row
+ (+ (nth 1 (window-edges (posn-window end)))
+ (cdr (posn-col-row end)))))
+ (cond
+ ((< mouse-row top)
+ (mouse-scroll-subr
+ (- mouse-row top) mouse-secondary-overlay start-point))
+ ((and (not (eobp))
+ (>= mouse-row bottom))
+ (mouse-scroll-subr (1+ (- mouse-row bottom))
+ mouse-drag-overlay start-point)))))
+
+ (t
+ (let ((mouse-y (cdr (cdr (mouse-position))))
+ (menu-bar-lines (or (cdr (assq 'menu-bar-lines
+ (frame-parameters)))
+ 0)))
+
+ ;; Are we on the menu bar?
+ (and (integerp mouse-y) (< mouse-y menu-bar-lines)
+ (mouse-scroll-subr (- mouse-y menu-bar-lines)
+ mouse-secondary-overlay start-point))))))))
+
+ (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
+ (eq (posn-window (event-end event)) start-window)
+ (numberp (posn-point (event-end event))))
+ (if (marker-position mouse-secondary-start)
+ (save-window-excursion
+ (delete-overlay mouse-secondary-overlay)
+ (select-window start-window)
+ (save-excursion
+ (goto-char mouse-secondary-start)
+ (sit-for 1)))
+ (kill-ring-save (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))))))))
(defun mouse-kill-secondary ()
"Kill the text in the secondary selection."
(setq mouse-secondary-overlay nil))
(defun mouse-secondary-save-then-kill (click)
- "Save text to secondary start point in kill ring; if twice, kill it.
-If the text between secondary start point and the mouse is the same as what's
+ "Save text to point in kill ring; the second time, kill the text.
+If the text between point and the mouse is the same as what's
at the front of the kill ring, this deletes the text.
Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
-which prepares for a second click to delete the text."
+which prepares for a second click to delete the text.
+
+If you have selected words or lines, this command extends the
+selection through the word or line clicked on. If you do this
+again in a different position, it extends the selection again.
+If you do this twice in the same position, the selection is killed."
(interactive "e")
- (let ((click-posn (posn-point (event-start click)))
- (start (+ 0 mouse-secondary-start))
+ (let ((posn (event-start click))
+ (click-posn (posn-point (event-start click)))
;; Don't let a subsequent kill command append to this one:
;; prevent setting this-command to kill-region.
(this-command this-command))
- (if (and (eq last-command 'mouse-secondary-save-then-kill)
- mouse-save-then-kill-posn
- (eq (car mouse-save-then-kill-posn) (car kill-ring))
- (equal (cdr mouse-save-then-kill-posn)
- (list start click-posn)))
- ;; If this is the second time we've called
- ;; mouse-save-then-kill, delete the text from the buffer.
- (progn
- (let ((buffer-undo-list t))
- (delete-overlay mouse-secondary-overlay)
- (delete-region start click-posn))
- ;; Make the undo list by hand so it is shared.
- (if (not (eq buffer-undo-list t))
- (setq buffer-undo-list
- (cons (cons (car kill-ring) (marker-position start))
- buffer-undo-list))))
- ;; Otherwise, save this region.
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-start click))))
- (kill-ring-save start click-posn)
- (if mouse-secondary-overlay
- (move-overlay mouse-secondary-overlay start click-posn)
- (setq mouse-secondary-overlay (make-overlay start click-posn)))
- (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
+ (if (> mouse-selection-click-count 0)
+ (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
+ (equal click-posn
+ (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
+ ;; Find both ends of the object selected by this click.
+ (let* ((range
+ (mouse-start-end click-posn click-posn
+ mouse-selection-click-count)))
+ ;; Move whichever end is closer to the click.
+ ;; That's what xterm does, and it seems reasonable.
+ (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
+ (abs (- click-posn (overlay-end mouse-secondary-overlay))))
+ (move-overlay mouse-secondary-overlay (car range)
+ (overlay-end mouse-secondary-overlay))
+ (move-overlay mouse-secondary-overlay
+ (overlay-start mouse-secondary-overlay)
+ (nth 1 range)))
+ ;; We have already put the old region in the kill ring.
+ ;; Replace it with the extended region.
+ ;; (It would be annoying to make a separate entry.)
+ (setcar kill-ring (buffer-substring
+ (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay)))
+ (if interprogram-cut-function
+ (funcall interprogram-cut-function (car kill-ring)))
+ ;; Arrange for a repeated mouse-3 to kill this region.
+ (setq mouse-save-then-kill-posn
+ (list (car kill-ring) (point) click-posn)))
+ ;; If we click this button again without moving it,
+ ;; that time kill.
+ (progn
+ (mouse-save-then-kill-delete-region
+ (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))
+ (delete-overlay mouse-secondary-overlay)))
+ (if (and (eq last-command 'mouse-secondary-save-then-kill)
+ mouse-save-then-kill-posn
+ (eq (car mouse-save-then-kill-posn) (car kill-ring))
+ (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
+ ;; If this is the second time we've called
+ ;; mouse-secondary-save-then-kill, delete the text from the buffer.
+ (progn
+ (mouse-save-then-kill-delete-region
+ (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))
+ (delete-overlay mouse-secondary-overlay))
+ (if (overlay-start mouse-secondary-overlay)
+ ;; We have a selection, so adjust it.
+ (progn
+ (select-window (posn-window posn))
+ (if (numberp click-posn)
+ (progn
+ ;; Move whichever end of the region is closer to the click.
+ ;; That is what xterm does, and it seems reasonable.
+ (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
+ (abs (- click-posn (overlay-end mouse-secondary-overlay))))
+ (move-overlay mouse-secondary-overlay click-posn
+ (overlay-end mouse-secondary-overlay))
+ (move-overlay mouse-secondary-overlay
+ (overlay-start mouse-secondary-overlay)
+ click-posn))
+ (setq deactivate-mark nil)))
+ (setcar kill-ring (buffer-substring
+ (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay)))
+ (if interprogram-cut-function
+ (funcall interprogram-cut-function (car kill-ring))))
+ (if mouse-secondary-start
+ ;; All we have is one end of a selection,
+ ;; so put the other end here.
+ (let ((start (+ 0 mouse-secondary-start)))
+ (set-buffer (window-buffer (posn-window (event-start click))))
+ (kill-ring-save start click-posn)
+ (if mouse-secondary-overlay
+ (move-overlay mouse-secondary-overlay start click-posn)
+ (setq mouse-secondary-overlay (make-overlay start click-posn)))
+ (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
(setq mouse-save-then-kill-posn
- (list (car kill-ring) start click-posn))))))
+ (list (car kill-ring) (point) click-posn))))))
\f
(defun mouse-buffer-menu (event)
"Pop up a menu of buffers for selection with the mouse.
\f
;; Choose a completion with the mouse.
+;; Delete the longest partial match for STRING
+;; that can be found before POINT.
+(defun mouse-delete-max-match (string)
+ (let ((len (min (length string)
+ (- (point-max) (point-min)))))
+ (goto-char (max (point-min) (- (point) (length string))))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point)
+ (+ (point) len))))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (delete-char len)))
+
(defun mouse-choose-completion (event)
"Click on an alternative in the `*Completions*' buffer to choose it."
(interactive "e")
- (let (choice)
+ (let ((buffer (window-buffer))
+ choice)
(save-excursion
(set-buffer (window-buffer (posn-window (event-start event))))
(save-excursion
(let ((beg (point)))
(skip-chars-forward "^ \t\n")
(setq choice (buffer-substring beg (point))))))
- (set-buffer (window-buffer (minibuffer-window)))
- (goto-char (max (point-min) (- (point-max) (length choice))))
- (while (and (not (eobp))
- (let ((tail (buffer-substring (point) (point-max))))
- (not (string= tail (substring choice 0 (length tail))))))
- (forward-char 1))
+ (set-buffer buffer)
+ (mouse-delete-max-match choice)
(insert choice)
- (delete-region (point) (point-max))
- (minibuffer-complete-and-exit)))
+ (and (equal buffer (window-buffer (minibuffer-window)))
+ (minibuffer-complete-and-exit))))
\f
;; Font selection.
HCoop / bpt / emacs.git / blobdiff