commit b05aa8d742d80aeb692c54289e8ccb074a68bf51 (HEAD, refs/remotes/origin/master) Author: Robert Pluim Date: Wed Nov 27 10:41:32 2019 +0100 Support wlan in network-interface-list on pre-Vista Windows * src/w32.c (network_interface_list): Check for 'Wireless' in adapter description to support pre-Vista Windows. diff --git a/src/w32.c b/src/w32.c index a6ebe55ee4..9f3c1b5d6e 100644 --- a/src/w32.c +++ b/src/w32.c @@ -9540,8 +9540,23 @@ network_interface_list (bool full, unsigned short match) switch (adapter->IfType) { case IF_TYPE_ETHERNET_CSMACD: - ifmt_idx = ETHERNET; - if_num = eth_count++; + /* Windows before Vista reports wireless adapters as + Ethernet. Work around by looking at the Description + string. */ + { + char description[MAX_UTF8_PATH]; + if (filename_from_utf16 (adapter->Description, description) == 0 + && strstr (description, "Wireless ")) + { + ifmt_idx = WLAN; + if_num = wlan_count++; + } + else + { + ifmt_idx = ETHERNET; + if_num = eth_count++; + } + } break; case IF_TYPE_ISO88025_TOKENRING: ifmt_idx = TOKENRING; commit 25d4bf4fe0f0765f04404399b50cda91e827315e Author: Stefan Monnier Date: Wed Nov 27 22:37:11 2019 -0500 * lisp/subr.el (do-after-load-evaluation): Fix thinko diff --git a/lisp/subr.el b/lisp/subr.el index 7e8c4fc23c..c1614c2e03 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4623,7 +4623,7 @@ This function is called directly from the C code." byte-compile-current-file byte-compile-root-dir))) (byte-compile-warn "%s" msg))) - (noninteractive (funcall fun)) ;; No timer will be run! + (noninteractive (funcall fun msg)) ;; No timer will be run! (t (run-with-idle-timer 0 nil fun msg)))))) ;; Finally, run any other hook. commit 7921811726b878c21df99208cbfcfdb9634378b9 Author: Juri Linkov Date: Thu Nov 28 00:35:53 2019 +0200 Menu bar rearrangements, move Print menu items to submenu, etc. (bug#37594) * lisp/menu-bar.el (menu-bar-print-menu): New defvar. (menu-bar-file-menu): Move print entries to submenu. Add menu entries for tab-new, tab-close, make-frame-on-monitor. (menu-bar-showhide-menu): Add menu entry for global-tab-line-mode. Don't add toggle-tab-bar-mode-from-frame on ns where it's unavailable. (menu-bar-tools-menu): Add rgrep. * lisp/bindings.el (next-buffer, previous-buffer): Advertise bindings 'C-x right' and 'C-x left' instead of 'XF86Forward' and 'XF86Back'. diff --git a/etc/NEWS b/etc/NEWS index f3f9f2f2c6..cb73e46358 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -508,6 +508,10 @@ RGB triplets with a single hexadecimal digit per component. --- ** The toolbar now shows the equivalent key binding in its tooltips. +--- +** The File menu-bar menu was re-arranged: Print menu items moved to +submenu, and also added the new entries for tabs. + --- ** 'scroll-lock-mode' is now bound to the 'Scroll_Lock' key globally. Note that this key binding will not work on MS-Windows systems if diff --git a/lisp/bindings.el b/lisp/bindings.el index 16da2bdf9a..738928b478 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -933,9 +933,11 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map [right] 'next-buffer) (define-key ctl-x-map [C-right] 'next-buffer) (define-key global-map [XF86Forward] 'next-buffer) +(put 'next-buffer :advertised-binding [?\C-x right]) (define-key ctl-x-map [left] 'previous-buffer) (define-key ctl-x-map [C-left] 'previous-buffer) (define-key global-map [XF86Back] 'previous-buffer) +(put 'previous-buffer :advertised-binding [?\C-x left]) (let ((map minibuffer-local-map)) (define-key map "\en" 'next-history-element) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index c404145dff..b6e7d06aa6 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -49,6 +49,36 @@ ;; It gets modified in place when menu-bar-update-buffers is called. (defvar global-buffers-menu-map (make-sparse-keymap "Buffers")) +(defvar menu-bar-print-menu + (let ((menu (make-sparse-keymap "Print"))) + (bindings--define-key menu [ps-print-region] + '(menu-item "PostScript Print Region (B+W)" ps-print-region + :enable mark-active + :help "Pretty-print marked region in black and white to PostScript printer")) + (bindings--define-key menu [ps-print-buffer] + '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer + :enable (menu-bar-menu-frame-live-and-visible-p) + :help "Pretty-print current buffer in black and white to PostScript printer")) + (bindings--define-key menu [ps-print-region-faces] + '(menu-item "PostScript Print Region" + ps-print-region-with-faces + :enable mark-active + :help "Pretty-print marked region to PostScript printer")) + (bindings--define-key menu [ps-print-buffer-faces] + '(menu-item "PostScript Print Buffer" + ps-print-buffer-with-faces + :enable (menu-bar-menu-frame-live-and-visible-p) + :help "Pretty-print current buffer to PostScript printer")) + (bindings--define-key menu [print-region] + '(menu-item "Print Region" print-region + :enable mark-active + :help "Print region between mark and current position")) + (bindings--define-key menu [print-buffer] + '(menu-item "Print Buffer" print-buffer + :enable (menu-bar-menu-frame-live-and-visible-p) + :help "Print current buffer with page headings")) + menu)) + ;; Only declared obsolete (and only made a proper alias) in 23.3. (define-obsolete-variable-alias 'menu-bar-files-menu 'menu-bar-file-menu "22.1") @@ -63,6 +93,25 @@ (bindings--define-key menu [separator-exit] menu-bar-separator) + (bindings--define-key menu [print] + `(menu-item "Print" ,menu-bar-print-menu)) + + (bindings--define-key menu [separator-print] + menu-bar-separator) + + (unless (featurep 'ns) + (bindings--define-key menu [close-tab] + '(menu-item "Close Tab" tab-close + :visible (fboundp 'tab-close) + :help "Close currently selected tab")) + (bindings--define-key menu [make-tab] + '(menu-item "New Tab" tab-new + :visible (fboundp 'tab-new) + :help "Open a new tab")) + + (bindings--define-key menu [separator-tab] + menu-bar-separator)) + ;; Don't use delete-frame as event name because that is a special ;; event. (bindings--define-key menu [delete-this-frame] @@ -70,6 +119,10 @@ :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) :help "Delete currently selected frame")) + (bindings--define-key menu [make-frame-on-monitor] + '(menu-item "New Frame on Monitor..." make-frame-on-monitor + :visible (fboundp 'make-frame-on-monitor) + :help "Open a new frame on another monitor")) (bindings--define-key menu [make-frame-on-display] '(menu-item "New Frame on Display..." make-frame-on-display :visible (fboundp 'make-frame-on-display) @@ -102,36 +155,6 @@ (bindings--define-key menu [separator-window] menu-bar-separator) - (bindings--define-key menu [ps-print-region] - '(menu-item "PostScript Print Region (B+W)" ps-print-region - :enable mark-active - :help "Pretty-print marked region in black and white to PostScript printer")) - (bindings--define-key menu [ps-print-buffer] - '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer - :enable (menu-bar-menu-frame-live-and-visible-p) - :help "Pretty-print current buffer in black and white to PostScript printer")) - (bindings--define-key menu [ps-print-region-faces] - '(menu-item "PostScript Print Region" - ps-print-region-with-faces - :enable mark-active - :help "Pretty-print marked region to PostScript printer")) - (bindings--define-key menu [ps-print-buffer-faces] - '(menu-item "PostScript Print Buffer" - ps-print-buffer-with-faces - :enable (menu-bar-menu-frame-live-and-visible-p) - :help "Pretty-print current buffer to PostScript printer")) - (bindings--define-key menu [print-region] - '(menu-item "Print Region" print-region - :enable mark-active - :help "Print region between mark and current position")) - (bindings--define-key menu [print-buffer] - '(menu-item "Print Buffer" print-buffer - :enable (menu-bar-menu-frame-live-and-visible-p) - :help "Print current buffer with page headings")) - - (bindings--define-key menu [separator-print] - menu-bar-separator) - (bindings--define-key menu [recover-session] '(menu-item "Recover Crashed Session" recover-session :enable @@ -1228,6 +1251,12 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) + (bindings--define-key menu [showhide-tab-line-mode] + '(menu-item "Window Tab Line" global-tab-line-mode + :help "Turn window-local tab-lines on/off" + :visible (fboundp 'global-tab-line-mode) + :button (:toggle . global-tab-line-mode))) + (bindings--define-key menu [showhide-window-divider] `(menu-item "Window Divider" ,menu-bar-showhide-window-divider-menu :visible (memq (window-system) '(x w32)))) @@ -1254,13 +1283,14 @@ mail status in mode line")) (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines))))) - (bindings--define-key menu [showhide-tab-bar] - '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame - :help "Turn tab bar on/off" - :button - (:toggle . (menu-bar-positive-p - (frame-parameter (menu-bar-frame-for-menubar) - 'tab-bar-lines))))) + (unless (featurep 'ns) + (bindings--define-key menu [showhide-tab-bar] + '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame + :help "Turn tab bar on/off" + :button + (:toggle . (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) + 'tab-bar-lines)))))) (if (and (boundp 'menu-bar-showhide-tool-bar-menu) (keymapp menu-bar-showhide-tool-bar-menu)) @@ -1720,6 +1750,9 @@ mail status in mode line")) (bindings--define-key menu [compile] '(menu-item "Compile..." compile :help "Invoke compiler or Make, view compilation errors")) + (bindings--define-key menu [rgrep] + '(menu-item "Recursive Grep..." rgrep + :help "Interactively ask for parameters and search recursively")) (bindings--define-key menu [grep] '(menu-item "Search Files (Grep)..." grep :help "Search files for strings or regexps (with Grep)")) commit f655967b83378b56390904a503ec0f1a19a1a7e9 Author: Juri Linkov Date: Thu Nov 28 00:14:46 2019 +0200 'C-1 C-x v L' asks for revision and shows its log entry with diff (bug#38044) * doc/emacs/maintaining.texi (VC Change Log): Explain the numeric prefix arg of 'C-x v L' (vc-print-root-log). * lisp/vc/vc-git.el (vc-git-print-log): Add command line option "-p" when vc-log-view-type is 'with-diff'. (vc-git-log-view-mode): Use long style when vc-log-view-type is 'with-diff'. * lisp/vc/vc.el (vc-print-log-internal): Add optional arg 'type'. (vc-log-internal-common): Use 'region-history-mode' when type is 'with-diff' and backend supports 'region-history-mode'. (vc-print-root-log): Add optional arg 'revision'. In interactive spec read a revision when current-prefix-arg is 1. Use current-prefix-arg "as is" when it is a number. Show revision in long style with diff when limit is 1 and revision is non-nil. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 33a1ec0be0..c1f7aed114 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -991,7 +991,10 @@ file listed on the current line. @file{*vc-change-log*} buffer showing the history of the entire version-controlled directory tree (RCS, SCCS, CVS, and SRC do not support this feature). With a prefix argument, the command prompts -for the maximum number of revisions to display. +for the maximum number of revisions to display. A numeric prefix +argument specifies the maximum number of revisions without prompting. +When the numeric prefix argument is @kbd{M-1}, the command prompts +for the revision ID, and displays its log entry with a diff of changes. The @kbd{C-x v L} history is shown in a compact form, usually showing only the first line of each log entry. However, you can type diff --git a/etc/NEWS b/etc/NEWS index db30450888..f3f9f2f2c6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -993,6 +993,9 @@ With a prefix argument asks for a command, so for example, 'C-u M-x vc-log-search RET git log -1 f302475 RET' will display just one log entry found by its revision number. ++++ +*** 'C-1 C-x v L' asks for a revision and shows its log entry with diff. + *** 'C-x v =' can now mimic Magit's diff format. Set the new user option 'diff-font-lock-prettify' to t for that, see below under "Diff mode". diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index ca4c66a06d..71307cdffd 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -708,7 +708,7 @@ or an empty string if none." '(menu-item "Snapshot Stash" vc-git-stash-snapshot :help "Snapshot stash")) (define-key map [cr] - '(menu-item "Create Samed Stash" vc-git-stash + '(menu-item "Create Named Stash" vc-git-stash :help "Create named stash")) (define-key map [de] '(menu-item "Delete Stash" vc-git-stash-delete-at-point @@ -1134,8 +1134,7 @@ If LIMIT is a revision string, use it as an end-revision." ;; If the buffer exists from a previous invocation it might be ;; read-only. (let ((inhibit-read-only t)) - (with-current-buffer - buffer + (with-current-buffer buffer (apply 'vc-git-command buffer 'async files (append @@ -1161,6 +1160,8 @@ If LIMIT is a revision string, use it as an end-revision." "HEAD" limit))) (list start-revision))) + (when (eq vc-log-view-type 'with-diff) + (list "-p")) '("--"))))))) (defun vc-git-log-outgoing (buffer remote-location) @@ -1226,7 +1227,7 @@ log entries." (set (make-local-variable 'log-view-file-re) regexp-unmatchable) (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - (if (not (memq vc-log-view-type '(long log-search))) + (if (not (memq vc-log-view-type '(long log-search with-diff))) (cadr vc-git-root-log-format) "^commit *\\([0-9a-z]+\\)")) ;; Allow expanding short log entries. @@ -1235,7 +1236,7 @@ log entries." (set (make-local-variable 'log-view-expanded-log-entry-function) 'vc-git-expanded-log-entry)) (set (make-local-variable 'log-view-font-lock-keywords) - (if (not (memq vc-log-view-type '(long log-search))) + (if (not (memq vc-log-view-type '(long log-search with-diff))) (list (cons (nth 1 vc-git-root-log-format) (nth 2 vc-git-root-log-format))) (append diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 0d29c80d02..d0d2c39ac3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2361,7 +2361,7 @@ or if PL-RETURN is `limit-unsupported'." 'help-echo "Show the log again, including all entries"))) (defun vc-print-log-internal (backend files working-revision - &optional is-start-revision limit) + &optional is-start-revision limit type) "For specified BACKEND and FILES, show the VC log. Leave point at WORKING-REVISION, if it is non-nil. If IS-START-REVISION is non-nil, start the log from WORKING-REVISION @@ -2377,7 +2377,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (shortlog (not (null (memq (if dir-present 'directory 'file) vc-log-short-style)))) (buffer-name "*vc-change-log*") - (type (if shortlog 'short 'long))) + (type (or type (if shortlog 'short 'long)))) (vc-log-internal-common backend buffer-name files type (lambda (bk buf _type-arg files-arg) @@ -2393,7 +2393,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (vc-call-backend bk 'show-log-entry working-revision))) (lambda (_ignore-auto _noconfirm) (vc-print-log-internal backend files working-revision - is-start-revision limit))))) + is-start-revision limit type))))) (defvar vc-log-view-type nil "Set this to differentiate the different types of logs.") @@ -2416,7 +2416,12 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." (let ((inhibit-read-only t)) ;; log-view-mode used to be called with inhibit-read-only bound ;; to t, so let's keep doing it, just in case. - (vc-call-backend backend 'log-view-mode) + (vc-call-backend backend + (if (and (eq type 'with-diff) + (vc-find-backend-function + backend 'region-history-mode)) + 'region-history-mode + 'log-view-mode)) (set (make-local-variable 'log-view-vc-backend) backend) (set (make-local-variable 'log-view-vc-fileset) files) (set (make-local-variable 'revert-buffer-function) @@ -2475,13 +2480,26 @@ WORKING-REVISION and LIMIT." (vc-print-log-internal backend files working-revision nil limit))) ;;;###autoload -(defun vc-print-root-log (&optional limit) +(defun vc-print-root-log (&optional limit revision) "List the change log for the current VC controlled tree in a window. If LIMIT is non-nil, it should be a number specifying the maximum number of revisions to show; the default is `vc-log-show-limit'. -When called interactively with a prefix argument, prompt for LIMIT." +When called interactively with a prefix argument, prompt for LIMIT. +When the prefix argument is a number, use it as LIMIT. +A special case is when the prefix argument is 1, in this case +it asks for the revision and shows it with its diff." (interactive (cond + ((eq current-prefix-arg 1) + (let* ((default (thing-at-point 'word)) + (revision (read-string + (if default + (format "Revision to show (default %s): " default) + "Revision to show: ") + nil nil default))) + (list 1 revision))) + ((numberp current-prefix-arg) + (list current-prefix-arg)) (current-prefix-arg (let ((lim (string-to-number (read-from-minibuffer @@ -2492,9 +2510,11 @@ When called interactively with a prefix argument, prompt for LIMIT." (list lim))) (t (list (when (> vc-log-show-limit 0) vc-log-show-limit))))) - (let ((backend (vc-deduce-backend)) - (default-directory default-directory) - rootdir) + (let* ((backend (vc-deduce-backend)) + (default-directory default-directory) + (with-diff (and (eq limit 1) revision)) + (vc-log-short-style (unless with-diff vc-log-short-style)) + rootdir) (if backend (setq rootdir (vc-call-backend backend 'root default-directory)) (setq rootdir (read-directory-name "Directory for VC root-log: ")) @@ -2502,7 +2522,8 @@ When called interactively with a prefix argument, prompt for LIMIT." (unless backend (error "Directory is not version controlled"))) (setq default-directory rootdir) - (vc-print-log-internal backend (list rootdir) nil nil limit))) + (vc-print-log-internal backend (list rootdir) revision revision limit + (when with-diff 'with-diff)))) ;;;###autoload (defun vc-print-branch-log (branch) commit b31a966e88b1b4fbc8148fda47becd1d209a67fd Author: Juri Linkov Date: Wed Nov 27 23:52:29 2019 +0200 * lisp/image-mode.el: Resize image on window resizing (bug#32672) * lisp/image-mode.el (image--window-change): New function. (image--window-change-function): New variable. (image-mode--setup-mode): Add buffer-local hook image--window-change to window-size-change-functions, window-state-change-functions, window-selection-change-functions. diff --git a/etc/NEWS b/etc/NEWS index 8233328fa3..db30450888 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2623,6 +2623,9 @@ pointer is over. To change this behaviour, you can customize the user option 'mouse-wheel-follow-mouse'. Note that this will also affect scrolling. +** Mouse scroll up and down with control key modifier also works on images +where it scales the image under the mouse pointer. + --- ** help-follow-symbol now signals 'user-error' if point (or the position pointed to by the argument POS) is not in a symbol. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index db6864649d..09d7828047 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -599,6 +599,10 @@ Key bindings: (add-hook 'change-major-mode-hook #'image-toggle-display-text nil t) (add-hook 'after-revert-hook #'image-after-revert-hook nil t) + (add-hook 'window-size-change-functions #'image--window-change nil t) + (add-hook 'window-state-change-functions #'image--window-change nil t) + (add-hook 'window-selection-change-functions #'image--window-change nil t) + (run-mode-hooks 'image-mode-hook) (let ((image (image-get-display-property)) (msg1 (substitute-command-keys @@ -856,6 +860,27 @@ Otherwise, display the image by calling `image-mode'." (get-buffer-window-list (current-buffer) 'nomini 'visible)) (image-toggle-display-image))) +(defvar image--window-change-function + (debounce 1.0 + (lambda (window) + (when (window-live-p window) + (with-current-buffer (window-buffer) + (when (derived-mode-p 'image-mode) + (let ((spec (image-get-display-property))) + (when (eq (car-safe spec) 'image) + (let* ((image-width (plist-get (cdr spec) :max-width)) + (image-height (plist-get (cdr spec) :max-height)) + (edges (window-inside-pixel-edges window)) + (window-width (- (nth 2 edges) (nth 0 edges))) + (window-height (- (nth 3 edges) (nth 1 edges)))) + (when (and image-width image-height + (or (not (= image-width window-width)) + (not (= image-height window-height)))) + (image-toggle-display-image))))))))))) + +(defun image--window-change (window) + (funcall image--window-change-function window)) + ;;; Animated images commit 2435f811b946ec54ab1da90aded52caddef977c8 Author: Eli Zaretskii Date: Wed Nov 27 18:19:30 2019 +0200 Make some anonymous faces extend to EOL * lisp/vc/log-edit.el (log-edit-font-lock-keywords): * lisp/mpc.el (mpc-separator): * lisp/help.el (describe-key): * lisp/help-fns.el (describe-symbol): Make the anonymous faces extend to EOL. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 14dea7de9b..40c57d05be 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1463,7 +1463,8 @@ current buffer and the selected frame, respectively." (progn (skip-chars-backward " \t\n") (point))) (insert "\n\n" (eval-when-compile - (propertize "\n" 'face '(:height 0.1 :inverse-video t))) + (propertize "\n" 'face + '(:height 0.1 :inverse-video t :extend t))) "\n") (when name (insert (symbol-name symbol) diff --git a/lisp/help.el b/lisp/help.el index c4402ece4e..604a365957 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -869,7 +869,8 @@ current buffer." (insert "\n\n" ;; FIXME: Can't use eval-when-compile because purified ;; strings lose their text properties :-( - (propertize "\n" 'face '(:height 0.1 :inverse-video t)) + (propertize "\n" 'face + '(:height 0.1 :inverse-video t :extend t)) "\n"))) (princ brief-desc) diff --git a/lisp/mpc.el b/lisp/mpc.el index 8e557ed2b3..c39257937b 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1606,7 +1606,7 @@ when constructing the set of constraints." (make-overlay (point) (point))) (overlay-put mpc-separator-ol 'after-string (propertize "\n" - 'face '(:height 0.05 :inverse-video t)))) + 'face '(:height 0.05 :inverse-video t :extend t)))) (goto-char (point-min)) (forward-line 1) (while diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 8d47d66ac3..03eccf3815 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -384,7 +384,7 @@ The first subexpression is the actual text of the field.") nil lax)) ("^\n" (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil - (0 '(:height 0.1 :inverse-video t)))) + (0 '(:height 0.1 :inverse-video t :extend t)))) (log-edit--match-first-line (0 'log-edit-summary)))) (defvar log-edit-font-lock-gnu-style nil commit 39b3bc0082050af08e19d80059ddca66355559ce Author: Eli Zaretskii Date: Wed Nov 27 18:16:37 2019 +0200 ; Fix recent change in w32.c * src/w32.c (network_interface_list): Correct an embarrassing typo and cleanup the code. diff --git a/src/w32.c b/src/w32.c index cb82d51fb9..a6ebe55ee4 100644 --- a/src/w32.c +++ b/src/w32.c @@ -9642,8 +9642,7 @@ network_interface_list (bool full, unsigned short match) #else /* Kludge alert! OnLinkPrefixLength is only defined when compiling for Vista and later. */ - numbits = *(UINT8 *) (address->LeaseLifetime - + sizeof (address->LeaseLifetime)); + numbits = *(UINT8 *) (&address->LeaseLifetime + 1); #endif } else /* Windows XP */ @@ -9652,14 +9651,14 @@ network_interface_list (bool full, unsigned short match) numbits = 0; for ( ; prefix; prefix = prefix->Next) { - /* We want the longest matching prefix. */ - if (prefix->Address.lpSockaddr->sa_family - != ifa_addr->sa_family - || prefix->PrefixLength <= numbits) - continue; - if (address_prefix_match (ifa_addr->sa_family, ifa_addr, - prefix->Address.lpSockaddr, - prefix->PrefixLength)) + /* We want the longest matching prefix. */ + if ((prefix->Address.lpSockaddr->sa_family + == ifa_addr->sa_family) + && (prefix->PrefixLength > numbits) + && address_prefix_match (ifa_addr->sa_family, + ifa_addr, + prefix->Address.lpSockaddr, + prefix->PrefixLength)) numbits = prefix->PrefixLength; } if (!numbits) commit 4eb7db5d4b84708912c63a77569c8adeeff6c640 Author: Mattias Engdegård Date: Fri Oct 25 11:16:39 2019 +0200 Mouse rectangular region selection (bug#38013) Make it possible to select a rectangular region using the mouse. The standard binding is C-M-mouse-1. * lisp/mouse.el (mouse-scroll-subr): Add ADJUST argument. (mouse-drag-region-rectangle): New. * lisp/rect.el (rectangle--reset-point-crutches): New. (rectangle--reset-crutches): Use 'rectangle--reset-point-crutches'. * src/xdisp.c (remember_mouse_glyph, syms_of_xdisp): Add 'mouse-fine-grained-tracking'. * doc/lispref/commands.texi (Motion Events): Document 'mouse-fine-grained-tracking'. * doc/emacs/frames.texi (Mouse Commands): * doc/emacs/killing.texi (Rectangles): * etc/NEWS: Document rectangular selection with the mouse. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 091c011fb9..f6c2d23913 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -91,6 +91,10 @@ If the region is active, move the nearer end of the region to the click position; otherwise, set mark at the current value of point and point at the click position. Save the resulting region in the kill ring; on a second click, kill it (@code{mouse-save-then-kill}). + +@item C-M-mouse-1 +Activate a rectangular region around the text selected by dragging. +@xref{Rectangles}. @end table @findex mouse-set-point diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 80e2868908..ce00cb38a7 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -732,6 +732,9 @@ region is controlled. But remember that a given combination of point and mark values can be interpreted either as a region or as a rectangle, depending on the command that uses them. + A rectangular region can also be marked using the mouse: click and drag +@kbd{C-M-mouse-1} from one corner of the rectangle to the opposite. + @table @kbd @item C-x r k Kill the text of the region-rectangle, saving its contents as the diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 0c848a8025..032f005e9c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1661,6 +1661,12 @@ events within its body. Outside of @code{track-mouse} forms, Emacs does not generate events for mere motion of the mouse, and these events do not appear. @xref{Mouse Tracking}. +@defvar mouse-fine-grained-tracking +When non-@code{nil}, mouse motion events are generated even for very +small movements. Otherwise, motion events are not generated as long +as the mouse cursor remains pointing to the same glyph in the text. +@end defvar + @node Focus Events @subsection Focus Events @cindex focus event diff --git a/etc/NEWS b/etc/NEWS index 98a3520622..8233328fa3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -613,6 +613,9 @@ region using a given replacement-function in a non-destructive manner arguments mitigating performance issues when operating on huge buffers. ++++ +** Dragging 'C-M-mouse-1' now marks rectangular regions. + +++ ** The command 'delete-indentation' now operates on the active region. If the region is active, the command joins all the lines in the diff --git a/lisp/mouse.el b/lisp/mouse.el index c91760a734..f076e90bd9 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1045,10 +1045,12 @@ the mouse has moved. However, it always scrolls at least the number of lines specified by this variable." :type 'integer) -(defun mouse-scroll-subr (window jump &optional overlay start) +(defun mouse-scroll-subr (window jump &optional overlay start adjust) "Scroll the window WINDOW, JUMP lines at a time, until new input arrives. If OVERLAY is an overlay, let it stretch from START to the far edge of the newly visible text. +ADJUST, if non-nil, is a function, without arguments, to call after +setting point. Upon exit, point is at the far edge of the newly visible text." (cond ((and (> jump 0) (< jump mouse-scroll-min-lines)) @@ -1077,6 +1079,8 @@ Upon exit, point is at the far edge of the newly visible text." ;; so that we don't mess up the selected window. (or (eq window (selected-window)) (goto-char opoint)) + (when adjust + (funcall adjust)) (sit-for mouse-scroll-delay))))) (or (eq window (selected-window)) (goto-char opoint)))) @@ -1959,6 +1963,113 @@ When there is no region, this function does nothing." (delete-overlay mouse-secondary-overlay) ; Delete the secondary selection even on a different buffer. (move-overlay mouse-secondary-overlay (region-beginning) (region-end)))) + +(defun mouse-drag-region-rectangle (start-event) + "Set the region to the rectangle that the mouse is dragged over. +This must be bound to a button-down mouse event." + (interactive "e") + (let* ((scroll-margin 0) + (start-pos (event-start start-event)) + (start-posn (event-start start-event)) + (start-point (posn-point start-posn)) + (start-window (posn-window start-posn)) + (start-hscroll (window-hscroll start-window)) + (start-col (+ (car (posn-col-row start-pos)) start-hscroll)) + (bounds (window-edges start-window)) + (top (nth 1 bounds)) + (bottom (if (window-minibuffer-p start-window) + (nth 3 bounds) + (1- (nth 3 bounds)))) + (dragged nil) + (old-track-mouse track-mouse) + (old-mouse-fine-grained-tracking mouse-fine-grained-tracking) + ;; For right-to-left text, columns are counted from the right margin; + ;; translate from mouse events, which always count from the left. + (adjusted-col (lambda (col) + (if (eq (current-bidi-paragraph-direction) + 'right-to-left) + (- (frame-text-cols) col -1) + col))) + (map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) + (interactive "e") + (unless dragged + ;; This is actually a drag. + (setq dragged t) + (mouse-minibuffer-check start-event) + (deactivate-mark) + (posn-set-point start-pos) + (rectangle-mark-mode) + ;; Only tell rectangle about the exact column if we are possibly + ;; beyond end-of-line or in a tab, since the column we got from + ;; the mouse position isn't necessarily accurate for use in + ;; specifying a rectangle (which uses the `move-to-column' + ;; measure). + (when (or (eolp) (eq (following-char) ?\t)) + (let ((col (funcall adjusted-col start-col))) + (rectangle--col-pos col 'mark) + (rectangle--col-pos col 'point)))) + + (let* ((posn (event-end event)) + (window (posn-window posn)) + (hscroll (if (window-live-p window) + (window-hscroll window) + 0)) + (mouse-pos (mouse-position)) + (mouse-col (+ (cadr mouse-pos) hscroll)) + (mouse-row (cddr mouse-pos)) + (set-col (lambda () + (if (or (eolp) (eq (following-char) ?\t)) + (rectangle--col-pos + (funcall adjusted-col mouse-col) 'point) + (rectangle--reset-point-crutches))))) + (if (and (eq window start-window) + mouse-row + (<= top mouse-row (1- bottom))) + ;; Drag inside the same window. + (progn + (posn-set-point posn) + (funcall set-col)) + ;; Drag outside the window: scroll. + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr + start-window (- mouse-row top) nil start-point + set-col)) + ((>= mouse-row bottom) + (mouse-scroll-subr + start-window (1+ (- mouse-row bottom)) nil start-point + set-col))))))) + (condition-case err + (progn + (setq track-mouse t) + (setq mouse-fine-grained-tracking t) + (set-transient-map + map t + (lambda () + (setq track-mouse old-track-mouse) + (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking) + (when (or (not dragged) + (not (mark)) + (equal (rectangle-dimensions (mark) (point)) '(0 . 1))) + ;; No nontrivial region selected; deactivate rectangle mode. + (deactivate-mark))))) + ;; Clean up in case something went wrong. + (error (setq track-mouse old-track-mouse) + (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking) + (signal (car err) (cdr err)))))) + +;; The drag event must be bound to something but does not need any effect, +;; as everything takes place in `mouse-drag-region-rectangle'. +;; The click event can be anything; `mouse-set-point' is just a convenience. +(global-set-key [C-M-down-mouse-1] #'mouse-drag-region-rectangle) +(global-set-key [C-M-drag-mouse-1] #'ignore) +(global-set-key [C-M-mouse-1] #'mouse-set-point) + (defcustom mouse-buffer-menu-maxlen 20 "Number of buffers in one pane (submenu) of the buffer menu. diff --git a/lisp/rect.el b/lisp/rect.el index 4d4d6146f2..1109786fc5 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -133,11 +133,15 @@ Point is at the end of the segment of this line within the rectangle." (defun rectangle--crutches () (cons rectangle--mark-crutches (window-parameter nil 'rectangle--point-crutches))) -(defun rectangle--reset-crutches () - (kill-local-variable 'rectangle--mark-crutches) + +(defun rectangle--reset-point-crutches () (if (window-parameter nil 'rectangle--point-crutches) (setf (window-parameter nil 'rectangle--point-crutches) nil))) +(defun rectangle--reset-crutches () + (kill-local-variable 'rectangle--mark-crutches) + (rectangle--reset-point-crutches)) + ;;; Rectangle operations. (defun apply-on-rectangle (function start end &rest args) diff --git a/src/xdisp.c b/src/xdisp.c index 2b4dda2715..c4d23be4cd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2491,6 +2491,12 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) enum glyph_row_area area; int x, y, width, height; + if (mouse_fine_grained_tracking) + { + STORE_NATIVE_RECT (*rect, gx, gy, 1, 1); + return; + } + /* Try to determine frame pixel position and size of the glyph under frame pixel coordinates X/Y on frame F. */ @@ -34946,6 +34952,12 @@ The default is to use octal format (\200) whereas hexadecimal (\x80) may be more familiar to users. */); display_raw_bytes_as_hex = false; + DEFVAR_BOOL ("mouse-fine-grained-tracking", mouse_fine_grained_tracking, + doc: /* Non-nil for pixel-wise mouse-movement. +When nil, mouse-movement events will not be generated as long as the +mouse stays within the extent of a single glyph (except for images). */); + mouse_fine_grained_tracking = false; + } commit e7b4c248a6d2a2eca19a2a362103a7f24cfe30fc Author: Andrii Kolomoiets Date: Wed Nov 27 14:13:12 2019 +0200 Call vc-setup-buffer in vc-hg-log-incoming and vc-hg-log-outgoing * lisp/vc/vc-hg.el (vc-hg-log-incoming, vc-hg-log-outgoing): Call vc-setup-buffer. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 17d38fa400..5ff1a6204b 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1378,10 +1378,12 @@ REV is the revision to check out into WORKFILE." ))) (defun vc-hg-log-incoming (buffer remote-location) + (vc-setup-buffer buffer) (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "") remote-location))) (defun vc-hg-log-outgoing (buffer remote-location) + (vc-setup-buffer buffer) (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") remote-location))) commit 99532a87bccb136b81db79de8df02168a65b43de Author: Lars Ingebrigtsen Date: Wed Nov 27 13:12:39 2019 +0100 Fix documentation of eieio-class-name * doc/misc/eieio.texi (Predicates): Update the documentation of eieio-class-name to say what it really returns (bug#38365). diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 29d459f041..e9ba74829a 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -1043,9 +1043,7 @@ make a slot unbound. @end defun @defun eieio-class-name class -Return a string of the form @samp{#} which should look -similar to other Lisp objects like buffers and processes. Printing a -class results only in a symbol. +Return the class name as a symbol. @end defun @defun class-option class option commit fd63880540bc8853a709e5a52c2565301a3d74eb Author: Lars Ingebrigtsen Date: Wed Nov 27 12:44:58 2019 +0100 Make message-allow-no-recipients 'always work * lisp/gnus/message.el (message-send): Make message-allow-no-recipients 'always work. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c66b551c1e..f33454e704 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4247,9 +4247,9 @@ It should typically alter the sending method in some way or other." (let ((fcc (message-fetch-field "Fcc")) (gcc (message-fetch-field "Gcc"))) (when (or fcc gcc) - (or (eq message-allow-no-recipients 'always) - (and (not (eq message-allow-no-recipients 'never)) - (setq dont-barf-on-no-method + (setq dont-barf-on-no-method + (or (eq message-allow-no-recipients 'always) + (and (not (eq message-allow-no-recipients 'never)) (y-or-n-p (format "No receiver, perform %s anyway? " (cond ((and fcc gcc) "Fcc and Gcc") commit 215f678c7262db2ed353f2bf1e0a97c59a452605 Author: Mattias Engdegård Date: Mon Nov 25 18:54:20 2019 +0100 Fine-grained NS modifier key settings (bug#38296) For the ns-KEY-modifier and ns-right-KEY-modifier variables, KEY being 'control', 'command', 'alternate' and 'function', allow values on the form (:ordinary SYMBOL :function :SYMBOL :mouse SYMBOL), so that the key can be used for different modifiers (or none) in different contexts. This is particularly useful for using the macOS Option key for extended character entry while still using it as an Emacs modifier for function keys and mouse clicks. * src/nsterm.m (mod_of_kind, right_mod, nil_or_none): Helper functions. (EV_MODIFIERS2): Add KIND argument. (EV_MODIFIERS): Adapt call to EV_MODIFIERS2. (ns_get_shifted_character): Use correct event kind for modifiers. (ns-alternate-modifier, ns-right-alternate-modifier) (ns-command-modifier, ns-right-command-modifier) (ns-control-modifier, ns-right-control-modifier) (ns-function-modifier): Rewrite doc strings for new data format. (QCordinary, QCfunction, QCmouse): Define symbols. * lisp/cus-start.el: Conform to new data types. * doc/emacs/macos.texi (Mac / GNUstep Basics) (Mac / GNUstep Customization): Improved documentation. * etc/NEWS: Mention the change. diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index d9920957ad..87484f00e4 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -48,18 +48,8 @@ Support}), but we hope to improve it in the future. Emacs provides a set of key bindings using this modifier key that mimic other Mac / GNUstep applications (@pxref{Mac / GNUstep Events}). You can change these bindings in the usual way (@pxref{Key Bindings}). - -@vindex ns-alternate-modifier -@vindex ns-right-alternate-modifier - The variable @code{ns-right-alternate-modifier} controls the -behavior of the right @key{Alt} and @key{Option} keys. These keys -behave like the left-hand keys if the value is @code{left} (the -default). A value of @code{control}, @code{meta}, @code{alt}, -@code{super}, or @code{hyper} makes them behave like the corresponding -modifier keys; a value of @code{left} means be the same key as -@code{ns-alternate-modifier}; a value of @code{none} tells Emacs to -ignore them, in which case you get the default behavior of macOS -accentuation system from the right @key{Option} key. +The modifiers themselves can be customized; +@pxref{Mac / GNUstep Customization}. @kbd{S-mouse-1} adjusts the region to the click position, just like @kbd{mouse-3} (@code{mouse-save-then-kill}); it does not pop @@ -107,6 +97,52 @@ Nextstep port. For example, they affect things such as the modifier keys and the fullscreen behavior. To see all such options, use @kbd{M-x customize-group @key{RET} ns @key{RET}}. +@subsection Modifier keys + +The following variables control the behaviour of the actual modifier +keys: + +@table @code +@vindex ns-alternate-modifier +@vindex ns-right-alternate-modifier +@item ns-alternate-modifier +@itemx ns-right-alternate-modifier +The left and right @key{Option} or @key{Alt} keys. + +@vindex ns-command-modifier +@vindex ns-right-command-modifier +@item ns-command-modifier +@itemx ns-right-command-modifier +The left and right @key{Command} keys. + +@vindex ns-control-modifier +@vindex ns-right-control-modifier +@item ns-control-modifier +@itemx ns-right-control-modifier +The left and right @key{Control} keys. + +@vindex ns-function-modifier +@item ns-function-modifier +The @key{Function} (fn) key. +@end table + +The value of each variable is either a symbol, describing the key for +any purpose, or a list of the form +@code{(:ordinary @var{symbol} :function @var{symbol} :mouse @var{symbol})}, +which describes the modifier when used with ordinary keys, function keys +(that do not produce a character, such as arrow keys), and mouse clicks. + +If the @var{symbol} is one of @code{control}, @code{meta}, @code{alt}, +@code{super} or @code{hyper}, this describes the Emacs modifier it +represents. If @var{symbol} is @code{none}, Emacs does not use the +key, which retains its standard behaviour. For instance, the +@key{Option} key in macOS is then used for composing additional +characters. + +The variables for right-hand keys, like @code{ns-right-alternate-modifier}, +may also be set to @code{left}, which means to use the same behaviour as +the corresponding left-hand key. + @subsection Font Panel @findex ns-popup-font-panel diff --git a/etc/NEWS b/etc/NEWS index eb32d70f57..98a3520622 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3273,6 +3273,12 @@ Previously it was supported only in the Cygwin-w32 build. ** Emacs now handles key combinations involving the macOS "command" and "option" modifier keys more correctly. +** MacOS modifier key behaviour is now more adjustable. +The behaviour of the macOS "Option", "Command", "Control" and +"Function" keys can now be specified separately for use with +ordinary keys, function keys and mouse clicks. This allows using them +in their standard macOS way for composing characters. + ** The special handling of 'frame-title-format' on NS where setting it to 't' would enable the macOS proxy icon has been replaced with a separate variable, 'ns-use-proxy-icon'. 'frame-title-format' will now diff --git a/lisp/cus-start.el b/lisp/cus-start.el index e4b6d8f2d6..1c497ee5ae 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -424,16 +424,23 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; msdos.c (dos-unsupported-char-glyph display integer) ;; nsterm.m - ;; - ;; FIXME: Why does ⌃ use nil instead of none? Also the - ;; description is confusing; setting it to nil disables ⌃ - ;; entirely. (ns-control-modifier ns - (choice (const :tag "No modifier" nil) + (choice (const :tag "No modifier" none) (const control) (const meta) (const alt) (const hyper) - (const super)) "23.1") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "23.1") (ns-right-control-modifier ns (choice (const :tag "No modifier (work as control)" none) @@ -441,13 +448,35 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of left) (const control) (const meta) (const alt) (const hyper) - (const super)) "24.1") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "24.1") (ns-command-modifier ns (choice (const :tag "No modifier (work as layout switch)" none) (const control) (const meta) (const alt) (const hyper) - (const super)) "23.1") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "23.1") (ns-right-command-modifier ns (choice (const :tag "No modifier (work as layout switch)" none) @@ -455,13 +484,35 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of left) (const control) (const meta) (const alt) (const hyper) - (const super)) "24.1") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "24.1") (ns-alternate-modifier ns (choice (const :tag "No modifier (work as alternate/option)" none) (const control) (const meta) (const alt) (const hyper) - (const super)) "23.1") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "23.1") (ns-right-alternate-modifier ns (choice (const :tag "No modifier (work as alternate/option)" none) @@ -469,13 +520,35 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of left) (const control) (const meta) (const alt) (const hyper) - (const super)) "23.3") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "23.3") (ns-function-modifier ns (choice (const :tag "No modifier (work as function)" none) (const control) (const meta) (const alt) (const hyper) - (const super)) "23.1") + (const super) + (plist :key-type (choice (const :ordinary) + (const :function) + (const :mouse)) + :value-type (choice (const control) + (const meta) + (const alt) + (const hyper) + (const super) + (const :tag "No modifier" + none)))) + "23.1") (ns-antialias-text ns boolean "23.1") (ns-auto-hide-menu-bar ns boolean "24.1") (ns-confirm-quit ns boolean "25.1") diff --git a/src/nsterm.m b/src/nsterm.m index e1d745e332..52a9830be8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -354,6 +354,19 @@ - (NSColor *)colorUsingDefaultColorSpace #define NSLeftAlternateKeyMask (0x000020 | NSEventModifierFlagOption) #define NSRightAlternateKeyMask (0x000040 | NSEventModifierFlagOption) +/* MODIFIER if a symbol; otherwise its property KIND, if a symbol. */ +static Lisp_Object +mod_of_kind (Lisp_Object modifier, Lisp_Object kind) +{ + if (SYMBOLP (modifier)) + return modifier; + else + { + Lisp_Object val = Fplist_get (modifier, kind); + return SYMBOLP (val) ? val : Qnil; + } +} + static unsigned int ev_modifiers_helper (unsigned int flags, unsigned int left_mask, unsigned int right_mask, unsigned int either_mask, @@ -380,30 +393,35 @@ - (NSColor *)colorUsingDefaultColorSpace return modifiers; } -#define EV_MODIFIERS2(flags) \ +#define EV_MODIFIERS2(flags, kind) \ (((flags & NSEventModifierFlagHelp) ? \ hyper_modifier : 0) \ | ((flags & NSEventModifierFlagShift) ? \ shift_modifier : 0) \ - | ((flags & NS_FUNCTION_KEY_MASK) ? \ - parse_solitary_modifier (ns_function_modifier) : 0) \ + | ((flags & NS_FUNCTION_KEY_MASK) \ + ? parse_solitary_modifier (mod_of_kind (ns_function_modifier, \ + kind)) \ + : 0) \ | ev_modifiers_helper (flags, NSLeftControlKeyMask, \ NSRightControlKeyMask, \ NSEventModifierFlagControl, \ - ns_control_modifier, \ - ns_right_control_modifier) \ + mod_of_kind (ns_control_modifier, kind), \ + mod_of_kind (ns_right_control_modifier, \ + kind)) \ | ev_modifiers_helper (flags, NSLeftCommandKeyMask, \ NSRightCommandKeyMask, \ NSEventModifierFlagCommand, \ - ns_command_modifier, \ - ns_right_command_modifier) \ + mod_of_kind (ns_command_modifier, kind), \ + mod_of_kind (ns_right_command_modifier, \ + kind)) \ | ev_modifiers_helper (flags, NSLeftAlternateKeyMask, \ NSRightAlternateKeyMask, \ NSEventModifierFlagOption, \ - ns_alternate_modifier, \ - ns_right_alternate_modifier)) + mod_of_kind (ns_alternate_modifier, kind), \ + mod_of_kind (ns_right_alternate_modifier, \ + kind))) -#define EV_MODIFIERS(e) EV_MODIFIERS2 ([e modifierFlags]) +#define EV_MODIFIERS(e) EV_MODIFIERS2 ([e modifierFlags], QCmouse) #define EV_UDMODIFIERS(e) \ ((([e type] == NSEventTypeLeftMouseDown) ? down_modifier : 0) \ @@ -2599,6 +2617,18 @@ so some key presses (TAB) are swallowed by the system. */ } #ifdef NS_IMPL_COCOA +static Lisp_Object +right_mod (Lisp_Object left, Lisp_Object right) +{ + return EQ (right, Qleft) ? left : right; +} + +static bool +nil_or_none (Lisp_Object val) +{ + return NILP (val) || EQ (val, Qnone); +} + static UniChar ns_get_shifted_character (NSEvent *event) /* Look up the character corresponding to the key pressed on the @@ -2630,25 +2660,25 @@ so some key presses (TAB) are swallowed by the system. */ NSTRACE ("ns_get_shifted_character"); if ((flags & NSRightAlternateKeyMask) == NSRightAlternateKeyMask - && (EQ (ns_right_alternate_modifier, Qnone) - || (EQ (ns_right_alternate_modifier, Qleft) - && EQ (ns_alternate_modifier, Qnone)))) + && nil_or_none (mod_of_kind (right_mod (ns_alternate_modifier, + ns_right_alternate_modifier), + QCordinary))) modifiers |= rightOptionKey; if ((flags & NSLeftAlternateKeyMask) == NSLeftAlternateKeyMask - && EQ (ns_alternate_modifier, Qnone)) + && nil_or_none (mod_of_kind (ns_alternate_modifier, QCordinary))) modifiers |= optionKey; if ((flags & NSRightCommandKeyMask) == NSRightCommandKeyMask - && (EQ (ns_right_command_modifier, Qnone) - || (EQ (ns_right_command_modifier, Qleft) - && EQ (ns_command_modifier, Qnone)))) + && nil_or_none (mod_of_kind (right_mod (ns_command_modifier, + ns_right_command_modifier), + QCordinary))) /* Carbon doesn't differentiate between left and right command keys. */ modifiers |= cmdKey; if ((flags & NSLeftCommandKeyMask) == NSLeftCommandKeyMask - && EQ (ns_command_modifier, Qnone)) + && nil_or_none (mod_of_kind (ns_command_modifier, QCordinary))) modifiers |= cmdKey; result = UCKeyTranslate (layout, [event keyCode], kUCKeyActionDown, @@ -6287,7 +6317,8 @@ In that case we use UCKeyTranslate (ns_get_shifted_character) modifier keys, which returns 0 for shift-like modifiers. Therefore its return value is the set of control-like modifiers. */ - emacs_event->modifiers = EV_MODIFIERS2 (flags); + Lisp_Object kind = fnKeysym ? QCfunction : QCordinary; + emacs_event->modifiers = EV_MODIFIERS2 (flags, kind); /* Function keys (such as the F-keys, arrow keys, etc.) set modifiers as though the fn key has been pressed when it @@ -6296,7 +6327,9 @@ In that case we use UCKeyTranslate (ns_get_shifted_character) ). We need to unset the fn modifier in these cases. FIXME: Can we avoid setting it in the first place? */ if (fnKeysym && (flags & NS_FUNCTION_KEY_MASK)) - emacs_event->modifiers ^= parse_solitary_modifier (ns_function_modifier); + emacs_event->modifiers + ^= parse_solitary_modifier (mod_of_kind (ns_function_modifier, + QCfunction)); if (NS_KEYLOG) fprintf (stderr, "keyDown: code =%x\tfnKey =%x\tflags = %x\tmods = %x\n", @@ -9399,57 +9432,75 @@ Convert an X font name (XLFD) to an NS font name. DEFVAR_LISP ("ns-alternate-modifier", ns_alternate_modifier, "This variable describes the behavior of the alternate or option key.\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key.\n\ -Set to none means that the alternate / option key is not interpreted by Emacs\n\ -at all, allowing it to be used at a lower level for accented character entry."); +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_alternate_modifier = Qmeta; DEFVAR_LISP ("ns-right-alternate-modifier", ns_right_alternate_modifier, "This variable describes the behavior of the right alternate or option key.\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key.\n\ -Set to left means be the same key as `ns-alternate-modifier'.\n\ -Set to none means that the alternate / option key is not interpreted by Emacs\n\ -at all, allowing it to be used at a lower level for accented character entry."); +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +It can also be `left' to use the value of `ns-alternate-modifier' instead.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_right_alternate_modifier = Qleft; DEFVAR_LISP ("ns-command-modifier", ns_command_modifier, "This variable describes the behavior of the command key.\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key."); +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_command_modifier = Qsuper; DEFVAR_LISP ("ns-right-command-modifier", ns_right_command_modifier, "This variable describes the behavior of the right command key.\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key.\n\ -Set to left means be the same key as `ns-command-modifier'.\n\ -Set to none means that the command / option key is not interpreted by Emacs\n\ -at all, allowing it to be used at a lower level for accented character entry."); +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +It can also be `left' to use the value of `ns-command-modifier' instead.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_right_command_modifier = Qleft; DEFVAR_LISP ("ns-control-modifier", ns_control_modifier, "This variable describes the behavior of the control key.\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key."); +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_control_modifier = Qcontrol; DEFVAR_LISP ("ns-right-control-modifier", ns_right_control_modifier, "This variable describes the behavior of the right control key.\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key.\n\ -Set to left means be the same key as `ns-control-modifier'.\n\ -Set to none means that the control / option key is not interpreted by Emacs\n\ -at all, allowing it to be used at a lower level for accented character entry."); +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +It can also be `left' to use the value of `ns-control-modifier' instead.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_right_control_modifier = Qleft; DEFVAR_LISP ("ns-function-modifier", ns_function_modifier, - "This variable describes the behavior of the function key (on laptops).\n\ -Set to the symbol control, meta, alt, super, or hyper means it is taken to be\n\ -that key.\n\ -Set to none means that the function key is not interpreted by Emacs at all,\n\ -allowing it to be used at a lower level for accented character entry."); + "This variable describes the behavior of the function (fn) key.\n\ +Either SYMBOL, describing the behaviour for any event,\n\ +or (:ordinary SYMBOL :function SYMBOL :mouse SYMBOL), describing behaviour\n\ +separately for ordinary keys, function keys, and mouse events.\n\ +\n\ +Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'.\n\ +If `none', the key is ignored by Emacs and retains its standard meaning."); ns_function_modifier = Qnone; DEFVAR_LISP ("ns-antialias-text", ns_antialias_text, @@ -9529,6 +9580,9 @@ Nil means use fullscreen the old (< 10.7) way. The old way works better with DEFSYM (Qcocoa, "cocoa"); DEFSYM (Qgnustep, "gnustep"); + DEFSYM (QCordinary, ":ordinary"); + DEFSYM (QCfunction, ":function"); + DEFSYM (QCmouse, ":mouse"); #ifdef NS_IMPL_COCOA Fprovide (Qcocoa, Qnil);