\f
;; Provide a mode-specific menu on a mouse button.
-(defun mouse-major-mode-menu (event)
+(defun mouse-major-mode-menu (event prefix)
"Pop up a mode-specific menu of mouse commands."
;; Switch to the window clicked on, because otherwise
;; the mode's commands may not make sense.
- (interactive "@e")
- (let ((newmap (make-sparse-keymap))
- (unread-command-events (list event)))
- ;; Make a keymap in which our last command leads to a menu
- (define-key newmap (vector (car event))
- (nconc (make-sparse-keymap "Menu")
- (mouse-major-mode-menu-1
- (and (current-local-map)
- (lookup-key (current-local-map) [menu-bar])))))
- (mouse-major-mode-menu-compute-equiv-keys newmap)
- ;; Make NEWMAP override the usual definition
- ;; of the mouse button that got us here.
- ;; Then read the user's menu choice.
- (let* ((minor-mode-map-alist
- (cons (cons t newmap) minor-mode-map-alist))
- ;; read-key-sequence quits if the user aborts the menu.
- ;; If that happens, do nothing silently.
- (keyseq (condition-case nil
- (read-key-sequence "")
- (quit nil)))
- (command (if keyseq (lookup-key newmap keyseq))))
- (if command
- (command-execute command)))))
+ (interactive "@e\nP")
+ (let (;; This is where mouse-major-mode-menu-prefix
+ ;; returns the prefix we should use (after menu-bar).
+ ;; It is either nil or (SOME-SYMBOL).
+ (mouse-major-mode-menu-prefix nil)
+ ;; Make a keymap in which our last command leads to a menu
+ (newmap (make-sparse-keymap (concat mode-name " Mode")))
+ result)
+ ;; Make our menu inherit from the desired keymap
+ ;; which we want to display as the menu now.
+ (set-keymap-parent newmap
+ (mouse-major-mode-menu-1
+ (and (current-local-map)
+ (lookup-key (current-local-map) [menu-bar]))))
+ (setq result (x-popup-menu t (list newmap)))
+ (if result
+ (let ((command (key-binding
+ (apply 'vector (append '(menu-bar)
+ mouse-major-mode-menu-prefix
+ result)))))
+ ;; Clear out echoing, which perhaps shows a prefix arg.
+ (message "")
+ (if command
+ (progn
+ (setq prefix-arg prefix)
+ (command-execute command)))))))
;; Compute and cache the equivalent keys in MENU and all its submenus.
-(defun mouse-major-mode-menu-compute-equiv-keys (menu)
- (and (eq (car menu) 'keymap)
- (x-popup-menu nil menu))
- (while menu
- (and (consp (car menu))
- (consp (cdr (car menu)))
- (let ((tail (cdr (car menu))))
- (while (and (consp tail)
- (not (eq (car tail) 'keymap)))
- (setq tail (cdr tail)))
- (if (consp tail)
- (mouse-major-mode-menu-compute-equiv-keys tail))))
- (setq menu (cdr menu))))
+;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
+;;; (and (eq (car menu) 'keymap)
+;;; (x-popup-menu nil menu))
+;;; (while menu
+;;; (and (consp (car menu))
+;;; (consp (cdr (car menu)))
+;;; (let ((tail (cdr (car menu))))
+;;; (while (and (consp tail)
+;;; (not (eq (car tail) 'keymap)))
+;;; (setq tail (cdr tail)))
+;;; (if (consp tail)
+;;; (mouse-major-mode-menu-compute-equiv-keys tail))))
+;;; (setq menu (cdr menu))))
;; Given a mode's menu bar keymap,
;; if it defines exactly one menu bar menu,
(if (consp (car tail))
(if submap
(setq submap t)
- (setq submap (cdr (car tail)))))
+ (setq submap (car tail))))
(setq tail (cdr tail)))
- (if (eq submap t) menubar
- submap))))
+ (if (eq submap t)
+ menubar
+ (setq mouse-major-mode-menu-prefix (list (car submap)))
+ (cdr (cdr submap))))))
\f
;; Commands that operate on windows.
(raise-frame frame)
(select-frame frame)
(or (eq frame oframe)
- (set-mouse-position (selected-frame) (1- (frame-width)) 0))
- (unfocus-frame)))
+ (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
(defun mouse-tear-off-window (click)
"Delete the window clicked on, and create a new frame displaying its buffer."
should-enlarge-minibuffer
event mouse minibuffer y top bot edges wconfig params growth)
(setq params (frame-parameters))
- (if (and (not (setq minibuffer (cdr (assq 'minibuffer params))))
- (one-window-p t))
- (error "Attempt to resize sole window"))
+ (setq minibuffer (cdr (assq 'minibuffer params)))
(track-mouse
(progn
;; enlarge-window only works on the selected window, so
;; compute size change needed
(setq growth (- y bot -1)
wconfig (current-window-configuration))
+ ;; Check for an error case.
+ (if (and (/= growth 0)
+ (not minibuffer)
+ (one-window-p t))
+ (error "Attempt to resize sole window"))
;; grow/shrink minibuffer?
(if should-enlarge-minibuffer
(progn
;; If mark is highlighted, no need to bounce the cursor.
;; On X, we highlight while dragging, thus once again no need to bounce.
(or transient-mark-mode
- (eq (framep (selected-frame)) 'x)
- (eq (framep (selected-frame)) 'pc)
- (eq (framep (selected-frame)) 'win32)
+ (memq (framep (selected-frame)) '(x pc w32))
(sit-for 1))
(push-mark)
(set-mark (point))
"Set the region 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.
-In Transient Mark mode, the highlighting remains once you
-release the mouse button. Otherwise, it does not."
+In Transient Mark mode, the highlighting remains as long as the mark
+remains active. Otherwise, it remains until the next input event."
(interactive "e")
(mouse-minibuffer-check start-event)
(let* ((echo-keystrokes 0)
;; end-of-range is used only in the single-click case.
;; It is the place where the drag has reached so far
;; (but not outside the window where the drag started).
- (let (event end end-point (end-of-range (point)))
+ (let (event end end-point last-end-point (end-of-range (point)))
(track-mouse
(while (progn
(setq event (read-event))
nil
(setq end (event-end event)
end-point (posn-point end))
+ (if (numberp end-point)
+ (setq last-end-point end-point))
(cond
;; Are we moving within the original window?
;; Run the binding of the terminating up-event, if possible.
;; In the case of a multiple click, it gives the wrong results,
;; because it would fail to set up a region.
- (if (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ (if nil ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
;; In this case, we can just let the up-event execute normally.
(let ((end (event-end event)))
;; Set the position in the event before we replay it,
(cons event unread-command-events)))
(if (not (= (overlay-start mouse-drag-overlay)
(overlay-end mouse-drag-overlay)))
- (let (last-command this-command)
- (push-mark (overlay-start mouse-drag-overlay) t t)
- (goto-char (overlay-end mouse-drag-overlay))
- (delete-overlay mouse-drag-overlay)
+ (let* ((stop-point
+ (if (numberp (posn-point (event-end event)))
+ (posn-point (event-end event))
+ last-end-point))
+ ;; The end that comes from where we ended the drag.
+ ;; Point goes here.
+ (region-termination
+ (if (and stop-point (< stop-point start-point))
+ (overlay-start mouse-drag-overlay)
+ (overlay-end mouse-drag-overlay)))
+ ;; The end that comes from where we started the drag.
+ ;; Mark goes there.
+ (region-commencement
+ (- (+ (overlay-end mouse-drag-overlay)
+ (overlay-start mouse-drag-overlay))
+ region-termination))
+ last-command this-command)
+ (push-mark region-commencement t t)
+ (goto-char region-termination)
(copy-region-as-kill (point) (mark t))
- (mouse-set-region-1))
+ (let ((buffer (current-buffer)))
+ (mouse-show-mark)
+ ;; mouse-show-mark can call read-event,
+ ;; and that means the Emacs server could switch buffers
+ ;; under us. If that happened,
+ ;; avoid trying to use the region.
+ (and (mark t) mark-active
+ (eq buffer (current-buffer))
+ (mouse-set-region-1))))
(goto-char (overlay-end mouse-drag-overlay))
(setq this-command 'mouse-set-point)
(delete-overlay mouse-drag-overlay))))
(backward-sexp 1)
(point))
(1+ start)))
+ ((and (= mode 1)
+ (= start end)
+ (char-after start)
+ (= (char-syntax (char-after start)) ?\"))
+ (let ((open (or (eq start (point-min))
+ (save-excursion
+ (goto-char (- start 1))
+ (looking-at "\\s(\\|\\s \\|\\s>")))))
+ (if open
+ (list start
+ (save-excursion
+ (condition-case nil
+ (progn
+ (goto-char start)
+ (forward-sexp 1)
+ (point))
+ (error end))))
+ (list (1+ start)
+ (save-excursion
+ (condition-case nil
+ (progn
+ (goto-char (1+ start))
+ (backward-sexp 1)
+ (point))
+ (error end)))))))
((= mode 1)
(list (save-excursion
(goto-char start)
(if (numberp (posn-point posn))
(push-mark (posn-point posn) t t))))
+(defun mouse-undouble-last-event (events)
+ (let* ((index (1- (length events)))
+ (last (nthcdr index events))
+ (event (car last))
+ (basic (event-basic-type event))
+ (modifiers (delq 'double (delq 'triple (copy-sequence (event-modifiers event)))))
+ (new
+ (if (consp event)
+ (cons (event-convert-list (nreverse (cons basic modifiers)))
+ (cdr event))
+ event)))
+ (setcar last new)
+ (if (key-binding (apply 'vector events))
+ t
+ (setcar last event)
+ nil)))
+
;; Momentarily show where the mark is, if highlighting doesn't show it.
+
+(defvar mouse-region-delete-keys '([delete])
+ "List of keys which shall cause the mouse region to be deleted.")
+
(defun mouse-show-mark ()
- (or transient-mark-mode
+ (if transient-mark-mode
+ (if window-system
+ (delete-overlay mouse-drag-overlay))
+ (if window-system
+ (let ((inhibit-quit t)
+ (echo-keystrokes 0)
+ event events key ignore
+ x-lost-selection-hooks)
+ (add-hook 'x-lost-selection-hooks
+ '(lambda (seltype)
+ (if (eq seltype 'PRIMARY)
+ (progn (setq ignore t)
+ (throw 'mouse-show-mark t)))))
+ (move-overlay mouse-drag-overlay (point) (mark t))
+ (catch 'mouse-show-mark
+ (while (progn (setq event (read-event))
+ (setq events (append events (list event)))
+ (setq key (apply 'vector events))
+ (and (memq 'down (event-modifiers event))
+ (not (key-binding key))
+ (not (member key mouse-region-delete-keys))
+ (not (mouse-undouble-last-event events))))))
+ ;; If we lost the selection, just turn off the highlighting.
+ (if ignore
+ nil
+ ;; For certain special keys, delete the region.
+ (if (member key mouse-region-delete-keys)
+ (delete-region (overlay-start mouse-drag-overlay)
+ (overlay-end mouse-drag-overlay))
+ ;; Otherwise, unread the key so it gets executed normally.
+ (setq unread-command-events
+ (nconc events unread-command-events))))
+ (setq quit-flag nil)
+ (delete-overlay mouse-drag-overlay))
(save-excursion
- (goto-char (mark t))
- (sit-for 1))))
+ (goto-char (mark t))
+ (sit-for 1)))))
(defun mouse-set-mark (click)
"Set mark at the position clicked on with the mouse.
(mouse-save-then-kill-delete-region (point) (mark))
;; After we kill, another click counts as "the first time".
(setq mouse-save-then-kill-posn nil))
+ ;; This is not a repetition.
+ ;; We are adjusting an old selection or creating a new one.
(if (or (and (eq last-command 'mouse-save-then-kill)
mouse-save-then-kill-posn)
(and mark-active transient-mark-mode)
(if before-scroll
(goto-char before-scroll))
(exchange-point-and-mark)
- (kill-new (buffer-substring (point) (mark t))))
+ (kill-new (buffer-substring (point) (mark t)))
+ (if window-system
+ (mouse-show-mark)))
(mouse-set-region-1)
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))))))
(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."
+This must be bound to a button-down mouse event.
+The function returns a non-nil value if it creates a secondary selection."
(interactive "e")
(mouse-minibuffer-check start-event)
(let* ((echo-keystrokes 0)
mouse-secondary-overlay start-point)))))))))
(if (consp event)
-;;; (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)))
+ (sit-for 1)
+ nil))
(x-set-selection
'SECONDARY
(buffer-substring (overlay-start mouse-secondary-overlay)
(setq tail (buffer-list))
(while tail
(let ((elt (car tail)))
- (if (not (string-match "^ "
- (buffer-name elt)))
+ (if (/= (aref (buffer-name elt) 0) ?\ )
(setq head
(cons
(cons
elt)
head))))
(setq tail (cdr tail)))
- head))
+ ;; Compensate for the reversal that the above loop does.
+ (nreverse head)))
(menu
;; If we have lots of buffers, divide them into groups of 20
;; and make a pane (or submenu) for each one.
(if (> (length buffers) (/ (* mouse-menu-buffer-maxlen 3) 2))
- (let ((buffers (reverse buffers)) sublists next
+ (let ((buffers buffers) sublists next
(i 1))
(while buffers
;; Pull off the next mouse-menu-buffer-maxlen buffers