commit 517a0394d2ba15b517e2a2b7384a7cc98b11b80d (HEAD, refs/remotes/origin/master) Author: Alan Third Date: Sat Jun 10 22:44:01 2017 +0100 Don't wait for toolbar in NS native fullscreen * src/nsterm.m (EmacsView:updateFrameSize): Don't short-circuit the function when in fullscreen. diff --git a/src/nsterm.m b/src/nsterm.m index e69aa43dd3..633ca3bf76 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6560,7 +6560,10 @@ - (void) updateFrameSize: (BOOL) delay if (wait_for_tool_bar) { - if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0) + /* The toolbar height is always 0 in fullscreen, so don't wait + for it to become available. */ + if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0 + && ! [self isFullscreen]) { NSTRACE_MSG ("Waiting for toolbar"); return; commit b94472f18853c6075938cc5f9ac2856d7ad499b7 Author: Paul Eggert Date: Sat Jun 10 11:44:27 2017 -0700 ; Spelling fixes diff --git a/ChangeLog.2 b/ChangeLog.2 index ab15b277ce..96a647d9b4 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -4640,7 +4640,7 @@ Fill the doc string of font-lock-keywords * lisp/font-lock.el (font-lock-keywords): Fill the lines and - reorganise some explanations (bug#21427). + reorganize some explanations (bug#21427). (cherry picked from commit c05716d3a26ea7518b89eacfccaf70c9d0731df7) diff --git a/ChangeLog.3 b/ChangeLog.3 index 51245e7760..60bedb6db1 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -12785,7 +12785,7 @@ Fill the doc string of font-lock-keywords * lisp/font-lock.el (font-lock-keywords): Fill the lines and - reorganise some explanations (bug#21427). + reorganize some explanations (bug#21427). 2016-04-30 Lars Ingebrigtsen diff --git a/lisp/frame.el b/lisp/frame.el index dc7bb24bb3..b7a5516928 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1535,7 +1535,7 @@ FRAME can be a frame name, a terminal name, or a frame. If FRAME is omitted or nil, use the currently selected frame. By default, the current monitor is said to be the physical -monitor dominating teh selected frame. A frame is dominated by +monitor dominating the selected frame. A frame is dominated by a physical monitor when either the largest area of the frame resides in the monitor, or the monitor is the closest to the frame if the frame does not intersect any physical monitors. diff --git a/src/xdisp.c b/src/xdisp.c index 17a1cae004..34ee877e6b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32257,7 +32257,7 @@ display table takes effect; in this case, Emacs does not consult DEFVAR_BOOL ("display-raw-bytes-as-hex", display_raw_bytes_as_hex, doc: /* Non-nil means display raw bytes in hexadecimal format. The default is to use octal format (\200) whereas hexadecimal (\x80) -may be more familar to users. */); +may be more familiar to users. */); display_raw_bytes_as_hex = false; } commit bdf41152af3434307218ac2863b737c4486f740e Author: Alexander Gramiak Date: Sat Jun 10 12:28:03 2017 +0300 Fix the placement of GTK menus on multi-monitor systems menu_position_func did not properly use the current monitor's resolution. Also see commit '2016-02-06 22:12:53 +0100'. * lisp/frame.el (frame-monitor-attribute, frame-monitor-geometry) (frame-monitor-workarea): New functions. * src/xmenu.c (menu_position_func): Take into account the workarea of the monitor that contains the mouse. (Bug#23568) diff --git a/lisp/frame.el b/lisp/frame.el index 02871e0551..dc7bb24bb3 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1498,6 +1498,75 @@ keys and their meanings." for frames = (cdr (assq 'frames attributes)) if (memq frame frames) return attributes)) +(defun frame-monitor-attribute (attribute &optional frame x y) + "Return the value of ATTRIBUTE on FRAME's monitor. +If FRAME is omitted or nil, use currently selected frame. + +By default, the current monitor is the physical monitor +dominating the selected frame. A frame is dominated by a +physical monitor when either the largest area of the frame +resides in the monitor, or the monitor is the closest to the +frame if the frame does not intersect any physical monitors. + +If X and Y are both numbers, then ignore the value of FRAME; the +monitor is determined to be the physical monitor that contains +the pixel coordinate (X, Y). + +See `display-monitor-attributes-list' for the list of attribute +keys and their meanings." + (if (and (numberp x) + (numberp y)) + (cl-loop for monitor in (display-monitor-attributes-list) + for geometry = (alist-get 'geometry monitor) + for min-x = (pop geometry) + for min-y = (pop geometry) + for max-x = (+ min-x (pop geometry)) + for max-y = (+ min-y (car geometry)) + when (and (<= min-x x) + (< x max-x) + (<= min-y y) + (< y max-y)) + return (alist-get attribute monitor)) + (alist-get attribute (frame-monitor-attributes frame)))) + +(defun frame-monitor-geometry (&optional frame x y) + "Return the geometry of FRAME's monitor. +FRAME can be a frame name, a terminal name, or a frame. +If FRAME is omitted or nil, use the currently selected frame. + +By default, the current monitor is said to be the physical +monitor dominating teh selected frame. A frame is dominated by +a physical monitor when either the largest area of the frame resides +in the monitor, or the monitor is the closest to the frame if the +frame does not intersect any physical monitors. + +If X and Y are both numbers, then ignore the value of FRAME; the +monitor is determined to be the physical monitor that contains +the pixel coordinate (X, Y). + +See `display-monitor-attributes-list' for information on the +geometry attribute." + (frame-monitor-attribute 'geometry frame x y)) + +(defun frame-monitor-workarea (&optional frame x y) + "Return the workarea of FRAME's monitor. +FRAME can be a frame name, a terminal name, or a frame. +If FRAME is omitted or nil, use currently selected frame. + +By default, the current monitor is said to be the physical +monitor dominating the selected frame. A frame is dominated by +a physical monitor when either the largest area of the frame resides +in the monitor, or the monitor is the closest to the frame if the +frame does not intersect any physical monitors. + +If X and Y are both numbers, then ignore the value of FRAME; the +monitor is determined to be the physical monitor that contains +the pixel coordinate (X, Y). + +See `display-monitor-attributes-list' for information on the +workarea attribute." + (frame-monitor-attribute 'workarea frame x y)) + (declare-function x-frame-list-z-order "xfns.c" (&optional display)) (declare-function w32-frame-list-z-order "w32fns.c" (&optional display)) (declare-function ns-frame-list-z-order "nsfns.m" (&optional display)) diff --git a/src/xmenu.c b/src/xmenu.c index 2805249164..6c8a0c506c 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1160,9 +1160,37 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer { struct next_popup_x_y *data = user_data; GtkRequisition req; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (data->f); - int disp_width = x_display_pixel_width (dpyinfo); - int disp_height = x_display_pixel_height (dpyinfo); + int max_x = -1; + int max_y = -1; + + Lisp_Object frame, workarea; + + XSETFRAME (frame, data->f); + + /* TODO: Get the monitor workarea directly without calculating other + items in x-display-monitor-attributes-list. */ + workarea = call3 (Qframe_monitor_workarea, + Qnil, + make_number (data->x), + make_number (data->y)); + + if (CONSP (workarea)) + { + int min_x, min_y; + + min_x = XINT (XCAR (workarea)); + min_y = XINT (Fnth (make_number (1), workarea)); + max_x = min_x + XINT (Fnth (make_number (2), workarea)); + max_y = min_y + XINT (Fnth (make_number (3), workarea)); + } + + if (max_x < 0 || max_y < 0) + { + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (data->f); + + max_x = x_display_pixel_width (dpyinfo); + max_y = x_display_pixel_height (dpyinfo); + } *x = data->x; *y = data->y; @@ -1170,10 +1198,10 @@ menu_position_func (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer /* Check if there is room for the menu. If not, adjust x/y so that the menu is fully visible. */ gtk_widget_get_preferred_size (GTK_WIDGET (menu), NULL, &req); - if (data->x + req.width > disp_width) - *x -= data->x + req.width - disp_width; - if (data->y + req.height > disp_height) - *y -= data->y + req.height - disp_height; + if (data->x + req.width > max_x) + *x -= data->x + req.width - max_x; + if (data->y + req.height > max_y) + *y -= data->y + req.height - max_y; } static void @@ -2361,6 +2389,10 @@ syms_of_xmenu (void) DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); defsubr (&Smenu_or_popup_active_p); +#ifdef USE_GTK + DEFSYM (Qframe_monitor_workarea, "frame-monitor-workarea"); +#endif + #if defined (USE_GTK) || defined (USE_X_TOOLKIT) defsubr (&Sx_menu_bar_open_internal); Ffset (intern_c_string ("accelerate-menu"), commit 187a71df596a331a23bf86ee314c12035f42aff2 Author: Eli Zaretskii Date: Sat Jun 10 12:08:45 2017 +0300 Clarify documentation of 'face-spec-set' * lisp/faces.el (face-spec-set): Clarify the description of SPEC-TYPE in the doc string. * doc/lispref/display.texi (Defining Faces): Clarify the description of 'face-spec-set's SPEC-TYPE argument. (Bug#27246) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index aa75dcf5a0..4a895f74a5 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2531,16 +2531,20 @@ This function also defines @var{face} as a valid face name if it is not already one, and (re)calculates its attributes on existing frames. @cindex override spec @r{(for a face)} -The argument @var{spec-type} determines which spec to set. If it is -@code{nil} or @code{face-override-spec}, this function sets the -@dfn{override spec}, which overrides over all other face specs on -@var{face}. If it is @code{customized-face} or @code{saved-face}, -this function sets the customized spec or the saved custom spec. If -it is @code{face-defface-spec}, this function sets the default face -spec (the same one set by @code{defface}). If it is @code{reset}, -this function clears out all customization specs and override specs -from @var{face} (in this case, the value of @var{spec} is ignored). -Any other value of @var{spec-type} is reserved for internal use. +The optional argument @var{spec-type} determines which spec to set. +If it is omitted or @code{nil} or @code{face-override-spec}, this +function sets the @dfn{override spec}, which overrides face specs on +@var{face} of all the other types mentioned below. This is useful +when calling this function outside of Custom code. If @var{spec-type} +is @code{customized-face} or @code{saved-face}, this function sets the +customized spec or the saved custom spec, respectively. If it is +@code{face-defface-spec}, this function sets the default face spec +(the same one set by @code{defface}). If it is @code{reset}, this +function clears out all customization specs and override specs from +@var{face} (in this case, the value of @var{spec} is ignored). The +effect of any other value of @var{spec-type} on the face specs is +reserved for internal use, but the function will still define +@var{face} itself and recalculate its attributes, as described above. @end defun @node Attribute Functions diff --git a/lisp/faces.el b/lisp/faces.el index 1f9b3974c7..9a8a1344ca 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1667,7 +1667,7 @@ is given, in which case return its value instead." face--attributes-unspecified))) (defun face-spec-set (face spec &optional spec-type) - "Set the face spec SPEC for FACE. + "Set the FACE's spec SPEC, define FACE, and recalculate its attributes. See `defface' for the format of SPEC. The appearance of each face is controlled by its specs (set via @@ -1678,10 +1678,11 @@ This function also defines FACE as a valid face name if it is not already one, and (re)calculates its attributes on existing frames. -The argument SPEC-TYPE determines which spec to set: - nil or `face-override-spec' means the override spec (which is - usually what you want if calling this function outside of - Custom code); +The optional argument SPEC-TYPE determines which spec to set: + nil, omitted or `face-override-spec' means the override spec, + which overrides all the other types of spec mentioned below + (this is usually what you want if calling this function + outside of Custom code); `customized-face' or `saved-face' means the customized spec or the saved custom spec; `face-defface-spec' means the default spec @@ -1689,7 +1690,7 @@ The argument SPEC-TYPE determines which spec to set: `reset' means to ignore SPEC, but clear the `customized-face' and `face-override-spec' specs; Any other value means not to set any spec, but to run the -function for its other effects." +function for defining FACE and recalculating its attributes." (if (get face 'face-alias) (setq face (get face 'face-alias))) ;; Save SPEC to the relevant symbol property. commit f361c54e6abc5ba5fa5ce6cc9734b5283e0e6aa3 Author: Michael Albinus Date: Sat Jun 10 10:57:19 2017 +0200 Fix domain port and handling in tramp-gvfs.el * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-byte-array-to-string): Return nil if BYTE-ARRAY is nil. (tramp-gvfs-url-file-name, tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec): Fix domain and port handling. * lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p): Ignore errors. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index d031c73c3f..119efa53f3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -562,14 +562,16 @@ pass to the OPERATION." (concat string (string 0)) string))) (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) - "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists." + "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists. +Return nil for null BYTE-ARRAY." ;; The byte array could be a variant. Take care. (let ((byte-array (if (and (consp byte-array) (atom (car byte-array))) byte-array (car byte-array)))) - (dbus-byte-array-to-string - (if (and (consp byte-array) (zerop (car (last byte-array)))) - (butlast byte-array) byte-array)))) + (and byte-array + (dbus-byte-array-to-string + (if (and (consp byte-array) (zerop (car (last byte-array)))) + (butlast byte-array) byte-array))))) (defun tramp-gvfs-stringify-dbus-message (message) "Convert a D-Bus message into readable UTF8 strings, used for traces." @@ -815,8 +817,7 @@ file names." ;; `expand-file-name' (this does "/./" and "/../"). (tramp-make-tramp-file-name method user domain host port - (tramp-run-real-handler - 'expand-file-name (list localname)))))) + (tramp-run-real-handler 'expand-file-name (list localname)))))) (defun tramp-gvfs-get-directory-attributes (directory) "Return GVFS attributes association list of all files in DIRECTORY." @@ -1227,12 +1228,11 @@ file-notify events." (with-parsed-tramp-file-name filename nil (when (string-equal "gdrive" method) (setq method "google-drive")) - (when (and user (string-match tramp-user-with-domain-regexp user)) - (setq user - (concat (match-string 2 user) ";" (match-string 1 user)))) + (when (and user domain) + (setq user (concat domain ";" user))) (url-parse-make-urlobj - method (and user (url-hexify-string user)) nil - (tramp-file-name-host v) (tramp-file-name-port v) + method (and user (url-hexify-string user)) nil host + (if (stringp port) (string-to-number port) port) (and localname (url-hexify-string localname)) nil nil t)) (url-parse-make-urlobj "file" nil nil nil nil @@ -1398,10 +1398,6 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq method "davs")) (when (string-equal "google-drive" method) (setq method "gdrive")) - (unless (zerop (length domain)) - (setq user (concat user tramp-prefix-domain-format domain))) - (unless (zerop (length port)) - (setq host (concat host tramp-prefix-port-format port))) (with-parsed-tramp-file-name (tramp-make-tramp-file-name method user domain host port "") nil (tramp-message @@ -1487,14 +1483,12 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (setq method "gdrive")) (when (and (string-equal "synce" method) (zerop (length user))) (setq user (or (tramp-file-name-user vec) ""))) - (unless (zerop (length domain)) - (setq user (concat user tramp-prefix-domain-format domain))) - (unless (zerop (length port)) - (setq host (concat host tramp-prefix-port-format port))) (when (and (string-equal method (tramp-file-name-method vec)) - (string-equal user (or (tramp-file-name-user vec) "")) + (string-equal user (tramp-file-name-user vec)) + (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) + (string-equal port (tramp-file-name-port vec)) (string-match (concat "^" (regexp-quote prefix)) (tramp-file-name-unquote-localname vec))) ;; Set prefix, mountpoint and location. @@ -1554,8 +1548,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when domain (list (tramp-gvfs-mount-spec-entry "domain" domain))) ,@(when port - (list (tramp-gvfs-mount-spec-entry - "port" (number-to-string port)))))) + (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref (if (and (string-match "\\`dav" method) (string-match "^/?[^/]+" localname)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 05d197fce0..8758fb61e4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2878,42 +2878,45 @@ User is always nil." ;; There isn't. So we must check, in case there's a connection already. (and (tramp-connectable-p filename) (with-tramp-connection-property v "case-insensitive" - (with-tramp-progress-reporter v 5 "Checking case-insensitive" - ;; The idea is to compare a file with lower case letters - ;; with the same file with upper case letters. - (let ((candidate - (tramp-compat-file-name-unquote - (directory-file-name filename))) - tmpfile) - ;; Check, whether we find an existing file with lower - ;; case letters. This avoids us to create a temporary - ;; file. - (while (and (string-match - "[a-z]" (file-remote-p candidate 'localname)) - (not (file-exists-p candidate))) - (setq candidate - (directory-file-name (file-name-directory candidate)))) - ;; Nothing found, so we must use a temporary file for - ;; comparison. `make-nearby-temp-file' is added to - ;; Emacs 26+ like `file-name-case-insensitive-p', so - ;; there is no compatibility problem calling it. - (unless - (string-match "[a-z]" (file-remote-p candidate 'localname)) - (setq tmpfile - (let ((default-directory - (file-name-directory filename))) - (tramp-compat-funcall - 'make-nearby-temp-file "tramp.")) - candidate tmpfile)) - ;; Check for the existence of the same file with upper - ;; case letters. - (unwind-protect - (file-exists-p - (concat - (file-remote-p candidate) - (upcase (file-remote-p candidate 'localname)))) - ;; Cleanup. - (when tmpfile (delete-file tmpfile)))))))))) + (ignore-errors + (with-tramp-progress-reporter v 5 "Checking case-insensitive" + ;; The idea is to compare a file with lower case + ;; letters with the same file with upper case letters. + (let ((candidate + (tramp-compat-file-name-unquote + (directory-file-name filename))) + tmpfile) + ;; Check, whether we find an existing file with + ;; lower case letters. This avoids us to create a + ;; temporary file. + (while (and (string-match + "[a-z]" (file-remote-p candidate 'localname)) + (not (file-exists-p candidate))) + (setq candidate + (directory-file-name + (file-name-directory candidate)))) + ;; Nothing found, so we must use a temporary file + ;; for comparison. `make-nearby-temp-file' is added + ;; to Emacs 26+ like `file-name-case-insensitive-p', + ;; so there is no compatibility problem calling it. + (unless + (string-match + "[a-z]" (file-remote-p candidate 'localname)) + (setq tmpfile + (let ((default-directory + (file-name-directory filename))) + (tramp-compat-funcall + 'make-nearby-temp-file "tramp.")) + candidate tmpfile)) + ;; Check for the existence of the same file with + ;; upper case letters. + (unwind-protect + (file-exists-p + (concat + (file-remote-p candidate) + (upcase (file-remote-p candidate 'localname)))) + ;; Cleanup. + (when tmpfile (delete-file tmpfile))))))))))) (defun tramp-handle-file-name-completion (filename directory &optional predicate) commit 1a3feb8eade24eaff6dcd9edc032cfcd35e41dd7 Author: Eli Zaretskii Date: Sat Jun 10 11:39:59 2017 +0300 Improve documentation of 'face-spec-set-2' * lisp/faces.el (face-spec-recalc, face-spec-set-2): Rename 'spec' to 'face-attrs'. (face-spec-choose, face-spec-set-2): Doc fix. (Bug#27238) diff --git a/lisp/faces.el b/lisp/faces.el index a6ffd1ecd3..1f9b3974c7 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1594,6 +1594,7 @@ If FRAME is nil, the current FRAME is used." (defun face-spec-choose (spec &optional frame no-match-retval) "Return the proper attributes for FRAME, out of SPEC. +Value is a plist of face attributes in the form of attribute-value pairs. If no match is found or SPEC is nil, return nil, unless NO-MATCH-RETVAL is given, in which case return its value instead." (unless frame @@ -1734,32 +1735,34 @@ The following sources are applied in this order: ;; `theme-face' records. (let ((theme-faces (get face 'theme-face)) (no-match-found 0) - spec theme-face-applied) + face-attrs theme-face-applied) (if theme-faces (dolist (elt (reverse theme-faces)) - (setq spec (face-spec-choose (cadr elt) frame no-match-found)) - (unless (eq spec no-match-found) - (face-spec-set-2 face frame spec) + (setq face-attrs (face-spec-choose (cadr elt) frame no-match-found)) + (unless (eq face-attrs no-match-found) + (face-spec-set-2 face frame face-attrs) (setq theme-face-applied t)))) ;; If there was a spec applicable to FRAME, that overrides the ;; defface spec entirely (rather than inheriting from it). If ;; there was no spec applicable to FRAME, apply the defface spec ;; as well as any applicable X resources. (unless theme-face-applied - (setq spec (face-spec-choose (face-default-spec face) frame)) - (face-spec-set-2 face frame spec) + (setq face-attrs (face-spec-choose (face-default-spec face) frame)) + (face-spec-set-2 face frame face-attrs) (make-face-x-resource-internal face frame)) - (setq spec (face-spec-choose (get face 'face-override-spec) frame)) - (face-spec-set-2 face frame spec))) + (setq face-attrs (face-spec-choose (get face 'face-override-spec) frame)) + (face-spec-set-2 face frame face-attrs))) -(defun face-spec-set-2 (face frame spec) - "Set the face attributes of FACE on FRAME according to SPEC." +(defun face-spec-set-2 (face frame face-attrs) + "Set the face attributes of FACE on FRAME according to FACE-ATTRS. +FACE-ATTRS is a plist of face attributes in the form of attribute-value +pairs." (let (attrs) - (while spec - (when (assq (car spec) face-x-resources) - (push (car spec) attrs) - (push (cadr spec) attrs)) - (setq spec (cddr spec))) + (while face-attrs + (when (assq (car face-attrs) face-x-resources) + (push (car face-attrs) attrs) + (push (cadr face-attrs) attrs)) + (setq face-attrs (cddr face-attrs))) (apply 'set-face-attribute face frame (nreverse attrs)))) (defun face-attr-match-p (face attrs &optional frame)