X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5613a6f6d52bca0018c5777aba67a99f51016a35..1650d7102ae8ea943e4197b7d91198640f0e0ff6:/lisp/mouse.el diff --git a/lisp/mouse.el b/lisp/mouse.el index d3bcf02f21..53d5a22167 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1,6 +1,6 @@ ;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*- -;; Copyright (C) 1993-1995, 1999-2014 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1999-2016 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: hardware, mouse @@ -94,45 +94,47 @@ point at the click position." (defun mouse--down-1-maybe-follows-link (&optional _prompt) "Turn `mouse-1' events into `mouse-2' events if follows-link. Expects to be bound to `down-mouse-1' in `key-translation-map'." - (if (or (null mouse-1-click-follows-link) - (not (eq (if (eq mouse-1-click-follows-link 'double) - 'double-down-mouse-1 'down-mouse-1) - (car-safe last-input-event))) - (not (mouse-on-link-p (event-start last-input-event))) - (and (not mouse-1-click-in-non-selected-windows) - (not (eq (selected-window) - (posn-window (event-start last-input-event)))))) - nil - (let ((this-event last-input-event) - (timedout - (sit-for (if (numberp mouse-1-click-follows-link) - (/ (abs mouse-1-click-follows-link) 1000.0) - 0)))) - (if (if (and (numberp mouse-1-click-follows-link) - (>= mouse-1-click-follows-link 0)) - timedout (not timedout)) - nil - - (let ((event (read-event))) - (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-1 'mouse-1)) - ;; Turn the mouse-1 into a mouse-2 to follow links. - (let ((newup (if (eq mouse-1-click-follows-link 'double) - 'double-mouse-2 'mouse-2)) - (newdown (if (eq mouse-1-click-follows-link 'double) - 'double-down-mouse-2 'down-mouse-2))) - ;; If mouse-2 has never been done by the user, it doesn't have - ;; the necessary property to be interpreted correctly. - (put newup 'event-kind (get (car event) 'event-kind)) - (put newdown 'event-kind (get (car this-event) 'event-kind)) - (push (cons newup (cdr event)) unread-command-events) - ;; Modify the event in place, so read-key-sequence doesn't - ;; generate a second fake prefix key (see fake_prefixed_keys in - ;; src/keyboard.c). - (setcar this-event newdown) - (vector this-event)) - (push event unread-command-events) - nil)))))) + (when (and mouse-1-click-follows-link + (eq (if (eq mouse-1-click-follows-link 'double) + 'double-down-mouse-1 'down-mouse-1) + (car-safe last-input-event))) + (let ((action (mouse-on-link-p (event-start last-input-event)))) + (when (and action + (or mouse-1-click-in-non-selected-windows + (eq (selected-window) + (posn-window (event-start last-input-event))))) + (let ((timedout + (sit-for (if (numberp mouse-1-click-follows-link) + (/ (abs mouse-1-click-follows-link) 1000.0) + 0)))) + (if (if (and (numberp mouse-1-click-follows-link) + (>= mouse-1-click-follows-link 0)) + timedout (not timedout)) + nil + ;; Use read-key so it works for xterm-mouse-mode! + (let ((event (read-key))) + (if (eq (car-safe event) + (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-1 'mouse-1)) + (progn + ;; Turn the mouse-1 into a mouse-2 to follow links, + ;; but only if ‘mouse-on-link-p’ hasn’t returned a + ;; string or vector (see its docstring). + (if (or (stringp action) (vectorp action)) + (push (aref action 0) unread-command-events) + (let ((newup (if (eq mouse-1-click-follows-link 'double) + 'double-mouse-2 'mouse-2))) + ;; If mouse-2 has never been done by the user, it + ;; doesn't have the necessary property to be + ;; interpreted correctly. + (unless (get newup 'event-kind) + (put newup 'event-kind (get (car event) 'event-kind))) + (push (cons newup (cdr event)) unread-command-events))) + ;; Don't change the down event, only the up-event + ;; (bug#18212). + nil) + (push event unread-command-events) + nil)))))))) (define-key key-translation-map [down-mouse-1] #'mouse--down-1-maybe-follows-link) @@ -159,13 +161,16 @@ items `Turn Off' and `Help'." (setq menu (if menu (mouse-menu-non-singleton menu) - `(keymap - ,indicator - (turn-off menu-item "Turn Off minor mode" ,mm-fun) - (help menu-item "Help for minor mode" - (lambda () (interactive) - (describe-function ',mm-fun)))))) - (popup-menu menu)))) + (if (fboundp mm-fun) ; bug#20201 + `(keymap + ,indicator + (turn-off menu-item "Turn off minor mode" ,mm-fun) + (help menu-item "Help for minor mode" + (lambda () (interactive) + (describe-function ',mm-fun))))))) + (if menu + (popup-menu menu) + (message "No menu available"))))) (defun mouse-minor-mode-menu (event) "Show minor-mode menu for EVENT on minor modes area of the mode line." @@ -313,13 +318,14 @@ This command must be bound to a mouse click." (or (eq frame oframe) (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." +(define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4") +(defun tear-off-window (click) + "Delete the selected window, and create a new frame displaying its buffer." (interactive "e") (mouse-minibuffer-check click) (let* ((window (posn-window (event-start click))) (buf (window-buffer window)) - (frame (make-frame))) + (frame (make-frame))) ;FIXME: Use pop-to-buffer. (select-frame frame) (switch-to-buffer buf) (delete-window window))) @@ -341,9 +347,12 @@ This command must be bound to a mouse click." (first-line window-min-height) (last-line (- (window-height) window-min-height))) (if (< last-line first-line) - (error "Window too short to split") - (split-window-vertically - (min (max new-height first-line) last-line)))))) + (user-error "Window too short to split") + ;; Bind `window-combination-resize' to nil so we are sure to get + ;; the split right at the line clicked on. + (let (window-combination-resize) + (split-window-vertically + (min (max new-height first-line) last-line))))))) (defun mouse-split-window-horizontally (click) "Select Emacs window mouse is on, then split it horizontally in half. @@ -357,27 +366,12 @@ This command must be bound to a mouse click." (first-col window-min-width) (last-col (- (window-width) window-min-width))) (if (< last-col first-col) - (error "Window too narrow to split") - (split-window-horizontally - (min (max new-width first-col) last-col)))))) - -;; `mouse-drag-line' is now the common routine for handling all line -;; dragging events combining the earlier `mouse-drag-mode-line-1' and -;; `mouse-drag-vertical-line'. It should improve the behavior of line -;; dragging wrt Emacs 23 as follows: - -;; (1) Gratuitous error messages and restrictions have been (hopefully) -;; removed. (The help-echo that dragging the mode-line can resize a -;; one-window-frame's window will still show through via bindings.el.) - -;; (2) No gratuitous selection of other windows should happen. (This -;; has not been completely fixed for mouse-autoselected windows yet.) - -;; (3) Mouse clicks below a scroll-bar should pass through via unread -;; command events. - -;; Note that `window-in-direction' replaces `mouse-drag-window-above' -;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. + (user-error "Window too narrow to split") + ;; Bind `window-combination-resize' to nil so we are sure to get + ;; the split right at the column clicked on. + (let (window-combination-resize) + (split-window-horizontally + (min (max new-width first-col) last-col))))))) (defun mouse-drag-line (start-event line) "Drag a mode line, header line, or vertical line with the mouse. @@ -389,103 +383,145 @@ must be one of the symbols `header', `mode', or `vertical'." (start (event-start start-event)) (window (posn-window start)) (frame (window-frame window)) - (minibuffer-window (minibuffer-window frame)) - (side (and (eq line 'vertical) - (or (cdr (assq 'vertical-scroll-bars - (frame-parameters frame))) - 'right))) + ;; `position' records the x- or y-coordinate of the last + ;; sampled position. + (position (if (eq line 'vertical) + (+ (window-pixel-left window) + (car (posn-x-y start))) + (+ (window-pixel-top window) + (cdr (posn-x-y start))))) + ;; `last-position' records the x- or y-coordinate of the + ;; previously sampled position. The difference of `position' + ;; and `last-position' determines the size change of WINDOW. + (last-position position) (draggable t) - height finished event position growth dragged) + posn-window growth dragged) + ;; Decide on whether we are allowed to track at all and whose + ;; window's edge we drag. (cond ((eq line 'header) - ;; Check whether header-line can be dragged at all. (if (window-at-side-p window 'top) + ;; We can't drag the header line of a topmost window. (setq draggable nil) - (setq height (/ (window-header-line-height window) 2)) + ;; Drag bottom edge of window above the header line. (setq window (window-in-direction 'above window t)))) ((eq line 'mode) - ;; Check whether mode-line can be dragged at all. (if (and (window-at-side-p window 'bottom) - ;; Allow resizing the minibuffer window if it's on the same - ;; frame as and immediately below the clicked window, and - ;; it's active or `resize-mini-windows' is nil. - (not (and (eq (window-frame minibuffer-window) frame) - (= (nth 1 (window-pixel-edges minibuffer-window)) - (nth 3 (window-pixel-edges window))) - (or (not resize-mini-windows) - (eq minibuffer-window - (active-minibuffer-window)))))) - (setq draggable nil) - (setq height (/ (window-mode-line-height window) 2)))) + ;; Allow resizing the minibuffer window if it's on the + ;; same frame as and immediately below `window', and it's + ;; either active or `resize-mini-windows' is nil. + (let ((minibuffer-window (minibuffer-window frame))) + (not (and (eq (window-frame minibuffer-window) frame) + (or (not resize-mini-windows) + (eq minibuffer-window + (active-minibuffer-window))))))) + (setq draggable nil))) ((eq line 'vertical) - ;; Get the window to adjust for the vertical case. If the scroll - ;; bar is on the window's right or we drag a vertical divider, - ;; adjust the window where the start-event occurred. If the - ;; scroll bar is on the start-event window's left or there are no - ;; scrollbars, adjust the window on the left of it. - (unless (or (eq side 'right) - (not (zerop (window-right-divider-width window)))) - (setq window (window-in-direction 'left window t))))) - - ;; Start tracking. - (track-mouse + (let ((divider-width (frame-right-divider-width frame))) + (when (and (or (not (numberp divider-width)) + (zerop divider-width)) + (eq (frame-parameter frame 'vertical-scroll-bars) 'left)) + (setq window (window-in-direction 'left window t)))))) + + (let* ((exitfun nil) + (move + (lambda (event) (interactive "e") + (cond + ((not (consp event)) + nil) + ((eq line 'vertical) + ;; Drag right edge of `window'. + (setq start (event-start event)) + (setq position (car (posn-x-y start))) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be `window' or the window on the left or right of + ;; `window'. + (when (window-live-p (setq posn-window (posn-window start))) + ;; Add left edge of `posn-window' to `position'. + (setq position (+ (window-pixel-left posn-window) position)) + (unless (nth 1 start) + ;; Add width of objects on the left of the text area to + ;; `position'. + (when (eq (window-current-scroll-bars posn-window) 'left) + (setq position (+ (window-scroll-bar-width posn-window) + position))) + (setq position (+ (car (window-fringes posn-window)) + (or (car (window-margins posn-window)) 0) + position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-left window) + (window-pixel-width window)))) + (and (< growth 0) + (> position (+ (window-pixel-left window) + (window-pixel-width window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth t t)) + (setq last-position position)) + (draggable + ;; Drag bottom edge of `window'. + (setq start (event-start event)) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be either `window' or the window above or below of + ;; `window'. + (setq posn-window (posn-window start)) + (setq position (cdr (posn-x-y start))) + (when (window-live-p posn-window) + ;; Add top edge of `posn-window' to `position'. + (setq position (+ (window-pixel-top posn-window) position)) + ;; If necessary, add height of header line to `position' + (when (memq (posn-area start) + '(nil left-fringe right-fringe left-margin right-margin)) + (setq position (+ (window-header-line-height posn-window) position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-top window) + (window-pixel-height window)))) + (and (< growth 0) + (> position (+ (window-pixel-top window) + (window-pixel-height window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth nil t)) + (setq last-position position)))))) + ;; Start tracking. The special value 'dragging' signals the + ;; display engine to freeze the mouse pointer shape for as long + ;; as we drag. + (setq track-mouse 'dragging) ;; Loop reading events and sampling the position of the mouse. - (while (not finished) - (setq event (read-event)) - (setq position (mouse-pixel-position)) - ;; Do nothing if - ;; - there is a switch-frame event. - ;; - the mouse isn't in the frame that we started in - ;; - the mouse isn't in any Emacs frame - ;; Drag if - ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event (Why? -- cyd) - ;; (same as mouse movement for our purposes) - ;; Quit if - ;; - there is a keyboard event or some other unknown event. - (cond - ((not (consp event)) - (setq finished t)) - ((memq (car event) '(switch-frame select-window)) - nil) - ((not (memq (car event) '(mouse-movement scroll-bar-movement))) - (when (consp event) - ;; Do not unread a drag-mouse-1 event to avoid selecting - ;; some other window. For vertical line dragging do not - ;; unread mouse-1 events either (but only if we dragged at - ;; least once to allow mouse-1 clicks get through). - (unless (and dragged - (if (eq line 'vertical) - (memq (car event) '(drag-mouse-1 mouse-1)) - (eq (car event) 'drag-mouse-1))) - (push event unread-command-events))) - (setq finished t)) - ((not (and (eq (car position) frame) - (cadr position))) - nil) - ((eq line 'vertical) - ;; Drag vertical divider. This must be probably fixed like - ;; for the mode-line. - (setq growth (- (cadr position) - (if (eq side 'right) 0 2) - (nth 2 (window-pixel-edges window)) - -1)) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge window growth t t))) - (draggable - ;; Drag horizontal divider. - (setq growth - (if (eq line 'mode) - (- (+ (cddr position) height) - (nth 3 (window-pixel-edges window))) - ;; The window's top includes the header line! - (- (+ (nth 3 (window-pixel-edges window)) height) - (cddr position)))) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge - window (if (eq line 'mode) growth (- growth)) nil t)))))))) + (setq exitfun + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [scroll-bar-movement] #'ignore) + (define-key map [mouse-movement] move) + ;; Swallow drag-mouse-1 events to avoid selecting some other window. + (define-key map [drag-mouse-1] + (lambda () (interactive) (funcall exitfun))) + ;; For vertical line dragging swallow also a mouse-1 + ;; event (but only if we dragged at least once to allow mouse-1 + ;; clicks to get through). + (when (eq line 'vertical) + (define-key map [mouse-1] + `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) + :filter ,(lambda (cmd) (if dragged cmd))))) + ;; Some of the events will of course end up looked up + ;; with a mode-line, header-line or vertical-line prefix ... + (define-key map [mode-line] map) + (define-key map [header-line] map) + (define-key map [vertical-line] map) + ;; ... and some maybe even with a right- or bottom-divider + ;; prefix. + (define-key map [right-divider] map) + (define-key map [bottom-divider] map) + map) + t (lambda () (setq track-mouse nil))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -537,7 +573,12 @@ command alters the kill ring or not." (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click))) + (end + (if (eq (posn-window (event-end click)) (selected-window)) + (posn-point (event-end click)) + ;; If the mouse ends up in any other window or on the menu + ;; bar, use `window-point' of selected window (Bug#23707). + (window-point))) (click-count (event-click-count click))) (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) (when drag-start @@ -910,20 +951,29 @@ If MODE is 2 then do the same for lines." (= start end) (char-after start) (= (char-syntax (char-after start)) ?\()) - (list start - (save-excursion - (goto-char start) - (forward-sexp 1) - (point)))) + (if (/= (syntax-class (syntax-after start)) 4) ; raw syntax code for ?\( + ;; This happens in CC Mode when unbalanced parens in CPP + ;; constructs are given punctuation syntax with + ;; syntax-table text properties. (2016-02-21). + (signal 'scan-error (list "Containing expression ends prematurely" + start start)) + (list start + (save-excursion + (goto-char start) + (forward-sexp 1) + (point))))) ((and (= mode 1) (= start end) (char-after start) (= (char-syntax (char-after start)) ?\))) - (list (save-excursion - (goto-char (1+ start)) - (backward-sexp 1) - (point)) - (1+ start))) + (if (/= (syntax-class (syntax-after start)) 5) ; raw syntax code for ?\) + ;; See above comment about CC Mode. + (signal 'scan-error (list "Unbalanced parentheses" start start)) + (list (save-excursion + (goto-char (1+ start)) + (backward-sexp 1) + (point)) + (1+ start)))) ((and (= mode 1) (= start end) (char-after start) @@ -1006,7 +1056,7 @@ This must be bound to a mouse click." (interactive "e") (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) - ;; We don't use save-excursion because that preserves the mark too. + ;; FIXME: Use save-excursion (let ((point-save (point))) (unwind-protect (progn (mouse-set-point click) @@ -1060,24 +1110,7 @@ regardless of where you click." (let (select-active-regions) (deactivate-mark))) (or mouse-yank-at-point (mouse-set-point click)) - (let ((primary - (if (fboundp 'x-get-selection-value) - (if (eq (framep (selected-frame)) 'w32) - ;; MS-Windows emulates PRIMARY in x-get-selection, but not - ;; in x-get-selection-value (the latter only accesses the - ;; clipboard). So try PRIMARY first, in case they selected - ;; something with the mouse in the current Emacs session. - (or (x-get-selection 'PRIMARY) - (x-get-selection-value)) - ;; Else MS-DOS or X. - ;; On X, x-get-selection-value supports more formats and - ;; encodings, so use it in preference to x-get-selection. - (or (x-get-selection-value) - (x-get-selection 'PRIMARY))) - ;; FIXME: What about xterm-mouse-mode etc.? - (x-get-selection 'PRIMARY)))) - (unless primary - (error "No selection is available")) + (let ((primary (gui-get-primary-selection))) (push-mark (point)) (insert-for-yank primary))) @@ -1107,12 +1140,12 @@ This does not delete the region; it acts like \\[kill-ring-save]." ;; Delete, but make the undo-list entry share with the kill ring. ;; First, delete just one char, so in case buffer is being modified ;; for the first time, the undo list records that fact. - (let (before-change-functions after-change-functions) + (let ((inhibit-modification-hooks t)) (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! - (let (before-change-functions after-change-functions) + (let ((inhibit-modification-hooks t)) (primitive-undo 1 buffer-undo-list)) ;; Now delete the rest of the specified region, ;; but don't record it. @@ -1264,7 +1297,7 @@ This must be bound to a mouse drag event." (if (numberp (posn-point posn)) (setq beg (posn-point posn))) (move-overlay mouse-secondary-overlay beg (posn-point end)) - (x-set-selection + (gui-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)))))) @@ -1301,6 +1334,7 @@ The function returns a non-nil value if it creates a secondary selection." (setq mouse-secondary-start (make-marker))) (set-marker mouse-secondary-start start-point) (delete-overlay mouse-secondary-overlay)) + ;; FIXME: Use mouse-drag-track! (let (event end end-point) (track-mouse (while (progn @@ -1339,13 +1373,13 @@ The function returns a non-nil value if it creates a secondary selection." (if (marker-position mouse-secondary-start) (save-window-excursion (delete-overlay mouse-secondary-overlay) - (x-set-selection 'SECONDARY nil) + (gui-set-selection 'SECONDARY nil) (select-window start-window) (save-excursion (goto-char mouse-secondary-start) (sit-for 1) nil)) - (x-set-selection + (gui-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))))))))) @@ -1359,7 +1393,7 @@ regardless of where you click." ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) - (let ((secondary (x-get-selection 'SECONDARY))) + (let ((secondary (gui-get-selection 'SECONDARY))) (if secondary (insert-for-yank secondary) (error "No secondary selection")))) @@ -1478,7 +1512,7 @@ CLICK position, kill the secondary selection." (setq str (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))) (> (length str) 0) - (x-set-selection 'SECONDARY str)))) + (gui-set-selection 'SECONDARY str)))) (defcustom mouse-buffer-menu-maxlen 20 @@ -1523,8 +1557,17 @@ This switches buffers in the window that you clicked on, and selects that window." (interactive "e") (mouse-minibuffer-check event) - (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares) - ;; Make an alist of elements that look like (MENU-ITEM . BUFFER). + (let ((buf (x-popup-menu event (mouse-buffer-menu-map))) + (window (posn-window (event-start event)))) + (when buf + (select-window + (if (framep window) (frame-selected-window window) + window)) + (switch-to-buffer buf)))) + +(defun mouse-buffer-menu-map () + ;; Make an alist of elements that look like (MENU-ITEM . BUFFER). + (let ((buffers (buffer-list)) split-by-major-mode sum-of-squares) (dolist (buf buffers) ;; Divide all buffers into buckets for various major modes. ;; Each bucket looks like (MODE NAMESTRING BUFFERS...). @@ -1588,18 +1631,10 @@ and selects that window." (setq subdivided-menus (cons (cons "Others" others-list) subdivided-menus))))) - (setq menu (cons "Buffer Menu" (nreverse subdivided-menus)))) - (progn - (setq alist (mouse-buffer-menu-alist buffers)) - (setq menu (cons "Buffer Menu" - (mouse-buffer-menu-split "Select Buffer" alist))))) - (let ((buf (x-popup-menu event menu)) - (window (posn-window (event-start event)))) - (when buf - (select-window - (if (framep window) (frame-selected-window window) - window)) - (switch-to-buffer buf))))) + (cons "Buffer Menu" (nreverse subdivided-menus))) + (cons "Buffer Menu" + (mouse-buffer-menu-split "Select Buffer" + (mouse-buffer-menu-alist buffers)))))) (defun mouse-buffer-menu-alist (buffers) (let (tail @@ -1668,7 +1703,7 @@ and selects that window." ;; Font selection. (defun font-menu-add-default () - (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) + (let* ((default (frame-parameter nil 'font)) (font-alist x-fixed-font-alist) (elt (or (assoc "Misc" font-alist) (nth 1 font-alist)))) (if (assoc "Default" elt) @@ -1807,6 +1842,8 @@ choose a font." (declare-function buffer-face-mode-invoke "face-remap" (face arg &optional interactive)) (declare-function font-face-attributes "font.c" (font &optional frame)) +(defvar w32-use-w32-font-dialog) +(defvar w32-fixed-font-alist) (defun mouse-appearance-menu (event) "Show a menu for changing the default face in the current buffer." @@ -1826,13 +1863,18 @@ choose a font." (define-key mouse-appearance-menu-map [text-scale-increase] '(menu-item "Increase Buffer Text Size" text-scale-increase)) ;; Font selector - (if (functionp 'x-select-font) + (if (and (functionp 'x-select-font) + (or (not (boundp 'w32-use-w32-font-dialog)) + w32-use-w32-font-dialog)) (define-key mouse-appearance-menu-map [x-select-font] '(menu-item "Change Buffer Font..." x-select-font)) ;; If the select-font is unavailable, construct a menu. (let ((font-submenu (make-sparse-keymap "Change Text Font")) - (font-alist (cdr (append x-fixed-font-alist - (list (generate-fontset-menu)))))) + (font-alist (cdr (append + (if (eq system-type 'windows-nt) + w32-fixed-font-alist + x-fixed-font-alist) + (list (generate-fontset-menu)))))) (dolist (family font-alist) (let* ((submenu-name (car family)) (submenu-map (make-sparse-keymap submenu-name))) @@ -1908,20 +1950,25 @@ choose a font." ;; vertical-line prevents Emacs from signaling an error when the mouse ;; button is released after dragging these lines, on non-toolkit ;; versions. -(global-set-key [mode-line mouse-1] 'mouse-select-window) -(global-set-key [mode-line drag-mouse-1] 'mouse-select-window) -(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line) (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line) (global-set-key [header-line mouse-1] 'mouse-select-window) +;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window) +(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line) +(global-set-key [mode-line mouse-1] 'mouse-select-window) (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows) (global-set-key [mode-line mouse-3] 'mouse-delete-window) (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally) (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically) -(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically) +(global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally) (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line) +(global-set-key [vertical-line mouse-1] 'mouse-select-window) +(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically) (global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line) +(global-set-key [right-divider mouse-1] 'ignore) +(global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically) (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line) -(global-set-key [vertical-line mouse-1] 'mouse-select-window) +(global-set-key [bottom-divider mouse-1] 'ignore) +(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally) (provide 'mouse)