commit 72d7961d678f9c5f4cb812e0bb9b6dffafb47c68 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Apr 21 11:10:14 2017 +0300 Avoid infinite loop in redisplay when header-line-format is invalid * src/xdisp.c (handle_invisible_prop): Avoid inflooping when the string has an invalid %-construct in it and is displayed as part of mode-line or header-line. (Bug#26586) diff --git a/src/xdisp.c b/src/xdisp.c index 58b5ca2f01..3e6a3078ce 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4318,7 +4318,8 @@ handle_invisible_prop (struct it *it) bidi_move_to_visually_next (&it->bidi_it); } while (oldpos <= it->bidi_it.charpos - && it->bidi_it.charpos < endpos); + && it->bidi_it.charpos < endpos + && it->bidi_it.charpos < it->bidi_it.string.schars); IT_STRING_CHARPOS (*it) = it->bidi_it.charpos; IT_STRING_BYTEPOS (*it) = it->bidi_it.bytepos; commit b1fe497a445a8be1b50c5b5952f3380ee9546710 Author: Lars Ingebrigtsen Date: Fri Apr 21 06:12:53 2017 +0200 Add tests to check image scaling functionality This is in preparation to doing further work in this area to avoid regressions. * test/data/image/blank-200x100.png: New file for testing image scaling. * test/manual/image-size-tests.el: New file. diff --git a/test/data/image/blank-200x100.png b/test/data/image/blank-200x100.png new file mode 100644 index 0000000000..d516ad51d3 Binary files /dev/null and b/test/data/image/blank-200x100.png differ diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el new file mode 100644 index 0000000000..972361aa63 --- /dev/null +++ b/test/manual/image-size-tests.el @@ -0,0 +1,64 @@ +;;; image-size-tests.el -- tests for image scaling + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; To test: Load the file and eval (image-size-tests). +;; A non-erroring result is a success. + +;;; Code: + +(defmacro im-should (form) + `(unless ,form + (error "%s didn't succeed" ',form))) + +(defun im-image (&rest props) + (let ((image-scaling-factor 1)) + (apply + #'create-image + (expand-file-name "test/data/image/blank-200x100.png" source-directory) + 'imagemagick nil props))) + +(defun im-compare (image width height) + (let ((size (image-size image t))) + (and (= (car size) width) + (= (cdr size) height)))) + +(defun image-size-tests () + (unless (imagemagick-types) + (error "This only makes sense if ImageMagick is installed")) + ;; Default sizes. + (im-should (im-compare (im-image) 200 100)) + ;; Changing one dimension changes the other. + (im-should (im-compare (im-image :width 100) 100 50)) + (im-should (im-compare (im-image :height 50) 100 50)) + ;; The same with :max-width etc. + (im-should (im-compare (im-image :max-width 100) 100 50)) + (im-should (im-compare (im-image :max-height 50) 100 50)) + ;; :width wins over :max-width etc + (im-should (im-compare (im-image :width 300 :max-width 100) 300 150)) + (im-should (im-compare (im-image :height 200 :max-height 100) 400 200)) + ;; Specifying both width and height is fine. + (im-should (im-compare (im-image :width 300 :height 50) 300 50)) + ;; A too-large :max-width (etc) has no effect. + (im-should (im-compare (im-image :max-width 300) 200 100)) + (im-should (im-compare (im-image :max-height 300) 200 100)) + ;; Both max-width/height. + (im-should (im-compare (im-image :max-width 100 :max-height 75) 100 50)) + (im-should (im-compare (im-image :max-width 100 :max-height 25) 50 25))) + +;;; image-size-tests.el ends here commit 0ca61907cf4fe8afc723ed1e89e1a15ee69507ce Author: Lars Ingebrigtsen Date: Thu Apr 20 23:23:59 2017 +0200 Allow svg-image to take all create-image PROPS * lisp/svg.el (svg-image): Allow passing in PROPS when creating an image for convenience. diff --git a/lisp/svg.el b/lisp/svg.el index 2295e5f8d4..cb924f8163 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -222,13 +222,15 @@ otherwise. IMAGE-TYPE should be a MIME image type, like def) svg) -(defun svg-image (svg) - "Return an image object from SVG." - (create-image +(defun svg-image (svg &rest props) + "Return an image object from SVG. +PROPS is passed on to `create-image' as its PROPS list." + (apply + #'create-image (with-temp-buffer (svg-print svg) (buffer-string)) - 'svg t)) + 'svg t props)) (defun svg-insert-image (svg) "Insert SVG as an image at point. commit e8875bcbe067ea020dba95530ec4e9485942babd Author: George D. Plymale II Date: Thu Apr 20 14:05:11 2017 -0400 Treat non-erroring lisp call as successful eshell command (Bug#26161) This lets a compound command like 'cd .. && echo ok' print 'ok', similar to how most other shells behave. * lisp/eshell/esh-cmd.el (eshell-exit-success-p): Only check if the last exit code was zero, rather than first checking whether the last command returned nil. (eshell-exec-lisp): Set `eshell-last-command-status' to 1 on error. Copyright-paperwork-exempt: yes diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 583ba6ac42..86e7b83c28 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -575,14 +575,9 @@ must be implemented via rewriting, rather than as a function." (defvar eshell-last-command-result) ;Defined in esh-io.el. (defun eshell-exit-success-p () - "Return non-nil if the last command was \"successful\". -For a bit of Lisp code, this means a return value of non-nil. -For an external command, it means an exit code of 0." - (if (save-match-data - (string-match "#<\\(Lisp object\\|function .*\\)>" - eshell-last-command-name)) - eshell-last-command-result - (= eshell-last-command-status 0))) + "Return non-nil if the last command was successful. +This means an exit code of 0." + (= eshell-last-command-status 0)) (defvar eshell--cmd) @@ -1257,6 +1252,7 @@ represent a lisp form; ARGS will be ignored in that case." (and result (funcall printer result)) result) (error + (setq eshell-last-command-status 1) (let ((msg (error-message-string err))) (if (and (not form-p) (string-match "^Wrong number of arguments" msg) commit a6b375ba4bfc9453abc428dcb73e65bfcf61b794 Author: Reuben Thomas Date: Thu Mar 2 12:50:06 2017 +0000 Fix reading of tab settings in whitespace-mode lisp/whitespace.el (whitespace-indent-tabs-mode) whitespace-tab-width): Remove these variables. The underlying variables `indent-tabs-mode' and `tab-width' are already buffer-local when needed, and whitespace-mode never changes them. (whitespace-ensure-local-variables): Remove this function, which only existed to set the above variables. (whitespace-cleanup-region, whitespace-regexp) (whitespace-indentation-regexp, whitespace-report-region) (whitespace-turn-on, whitespace-color-on): Adjust these functions to use `indent-tabs-mode' and `tab-width' directly, and not call `whitespace-ensure-local-variables'. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 6c4f59d287..6aca47cd43 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1134,12 +1134,6 @@ SYMBOL is a valid symbol associated with CHAR. (defvar whitespace-active-style nil "Used to save locally `whitespace-style' value.") -(defvar whitespace-indent-tabs-mode indent-tabs-mode - "Used to save locally `indent-tabs-mode' value.") - -(defvar whitespace-tab-width tab-width - "Used to save locally `tab-width' value.") - (defvar whitespace-point (point) "Used to save locally current point value. Used by function `whitespace-trailing-regexp' (which see).") @@ -1415,12 +1409,6 @@ documentation." ;; PROBLEM 6: `tab-width' or more SPACEs after TAB (whitespace-cleanup-region (point-min) (point-max))))) -(defun whitespace-ensure-local-variables () - "Set `whitespace-indent-tabs-mode' and `whitespace-tab-width' locally." - (set (make-local-variable 'whitespace-indent-tabs-mode) - indent-tabs-mode) - (set (make-local-variable 'whitespace-tab-width) - tab-width)) ;;;###autoload (defun whitespace-cleanup-region (start end) @@ -1467,11 +1455,8 @@ documentation." ;; read-only buffer (whitespace-warn-read-only "cleanup region") ;; non-read-only buffer - (whitespace-ensure-local-variables) (let ((rstart (min start end)) (rend (copy-marker (max start end))) - (indent-tabs-mode whitespace-indent-tabs-mode) - (tab-width whitespace-tab-width) overwrite-mode ; enforce no overwrite tmp) (save-excursion @@ -1512,7 +1497,7 @@ documentation." ;; by SPACEs. ((memq 'space-after-tab whitespace-style) (whitespace-replace-action - (if whitespace-indent-tabs-mode 'tabify 'untabify) + (if indent-tabs-mode 'tabify 'untabify) rstart rend (whitespace-space-after-tab-regexp) 1)) ;; ACTION: replace `tab-width' or more SPACEs by TABs. ((memq 'space-after-tab::tab whitespace-style) @@ -1531,9 +1516,9 @@ documentation." ;; by SPACEs. ((memq 'space-before-tab whitespace-style) (whitespace-replace-action - (if whitespace-indent-tabs-mode 'tabify 'untabify) + (if indent-tabs-mode 'tabify 'untabify) rstart rend whitespace-space-before-tab-regexp - (if whitespace-indent-tabs-mode 0 2))) + (if indent-tabs-mode 0 2))) ;; ACTION: replace SPACEs before TAB by TABs. ((memq 'space-before-tab::tab whitespace-style) (whitespace-replace-action @@ -1564,25 +1549,25 @@ See also `tab-width'." (defun whitespace-regexp (regexp &optional kind) - "Return REGEXP depending on `whitespace-indent-tabs-mode'." + "Return REGEXP depending on `indent-tabs-mode'." (format (cond ((or (eq kind 'tab) - whitespace-indent-tabs-mode) + indent-tabs-mode) (car regexp)) ((or (eq kind 'space) - (not whitespace-indent-tabs-mode)) + (not indent-tabs-mode)) (cdr regexp))) - whitespace-tab-width)) + tab-width)) (defun whitespace-indentation-regexp (&optional kind) - "Return the indentation regexp depending on `whitespace-indent-tabs-mode'." + "Return the indentation regexp depending on `indent-tabs-mode'." (whitespace-regexp whitespace-indentation-regexp kind)) (defun whitespace-space-after-tab-regexp (&optional kind) - "Return the space-after-tab regexp depending on `whitespace-indent-tabs-mode'." + "Return the space-after-tab regexp depending on `indent-tabs-mode'." (whitespace-regexp whitespace-space-after-tab-regexp kind)) @@ -1744,10 +1729,10 @@ cleaning up these problems." whitespace-report-list))) (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) - ;; `whitespace-indent-tabs-mode' is local to current buffer - ;; `whitespace-tab-width' is local to current buffer - (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode) - (ws-tab-width whitespace-tab-width)) + ;; `indent-tabs-mode' may be local to current buffer + ;; `tab-width' may be local to current buffer + (let ((ws-indent-tabs-mode indent-tabs-mode) + (ws-tab-width tab-width)) (with-current-buffer (get-buffer-create whitespace-report-buffer-name) (erase-buffer) @@ -2027,7 +2012,6 @@ resultant list will be returned." (if (listp whitespace-style) whitespace-style (list whitespace-style))) - (whitespace-ensure-local-variables) ;; turn on whitespace (when whitespace-active-style (whitespace-color-on) @@ -2105,10 +2089,10 @@ resultant list will be returned." `((,(let ((line-column (or whitespace-line-column fill-column))) (format "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" - whitespace-tab-width - (1- whitespace-tab-width) - (/ line-column whitespace-tab-width) - (let ((rem (% line-column whitespace-tab-width))) + tab-width + (1- tab-width) + (/ line-column tab-width) + (let ((rem (% line-column tab-width))) (if (zerop rem) "" (format ".\\{%d\\}" rem))))) @@ -2123,7 +2107,7 @@ resultant list will be returned." ,(cond ((memq 'space-before-tab whitespace-active-style) ;; Show SPACEs before TAB (indent-tabs-mode). - (if whitespace-indent-tabs-mode 1 2)) + (if indent-tabs-mode 1 2)) ((memq 'space-before-tab::tab whitespace-active-style) 1) ((memq 'space-before-tab::space whitespace-active-style) commit d490770dd09f1121b637eebdad82531de654189b Author: Stefan Monnier Date: Thu Apr 20 17:38:21 2017 -0400 * lisp/vc/vc-hg.el (vc-hg-state-fast): Fix compiler warning by simplifying ascii-test. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index e10daad72f..5348341950 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -987,8 +987,7 @@ hg binary." repo dirstate dirstate-attr - repo-relative-filename - ascii-fname) + repo-relative-filename) (if (or ;; Explicit user disable (not vc-hg-parse-hg-data-structures) @@ -1013,18 +1012,12 @@ hg binary." (progn (setf repo-relative-filename (file-relative-name truename repo)) - (setf ascii-fname - (string-as-unibyte - (let (last-coding-system-used) - (encode-coding-string - repo-relative-filename - 'us-ascii t)))) ;; We only try dealing with ASCII filenames - (not (equal ascii-fname repo-relative-filename)))) + (string-match-p "[^[:ascii:]]" repo-relative-filename))) 'unsupported (let* ((dirstate-entry (vc-hg--cached-dirstate-search - dirstate dirstate-attr ascii-fname)) + dirstate dirstate-attr repo-relative-filename)) (state (car dirstate-entry)) (stat (file-attributes (concat repo repo-relative-filename)))) commit b389379c87481b6bc647ceb4d323f861281cad72 Author: Vibhav Pant Date: Thu Apr 20 20:59:15 2017 +0530 bytecomp: Don't inline functions that use byte-switch (Bug#26518) * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Don't inline FORM if the bytecode uses the byte-switch instruction. It is impossible to guess the correct stack depth while inlining such bytecode, resulting in faulty code. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f0f938da43..aba0710205 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3204,47 +3204,53 @@ for symbols generated by the byte compiler itself." (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. ;; (fmin (if (numberp fargs) (logand fargs 127))) (alen (length (cdr form))) - (dynbinds ())) + (dynbinds ()) + lap) (fetch-bytecode fun) - (mapc 'byte-compile-form (cdr form)) - (unless fmax2 - ;; Old-style byte-code. - (cl-assert (listp fargs)) - (while fargs - (pcase (car fargs) - (`&optional (setq fargs (cdr fargs))) - (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) - (push (cadr fargs) dynbinds) - (setq fargs nil)) - (_ (push (pop fargs) dynbinds)))) - (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) - (cond - ((<= (+ alen alen) fmax2) - ;; Add missing &optional (or &rest) arguments. - (dotimes (_ (- (/ (1+ fmax2) 2) alen)) - (byte-compile-push-constant nil))) - ((zerop (logand fmax2 1)) - (byte-compile-report-error - (format "Too many arguments for inlined function %S" form)) - (byte-compile-discard (- alen (/ fmax2 2)))) - (t - ;; Turn &rest args into a list. - (let ((n (- alen (/ (1- fmax2) 2)))) - (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) - (if (< n 5) - (byte-compile-out - (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) - 0) - (byte-compile-out 'byte-listN n))))) - (mapc #'byte-compile-dynamic-variable-bind dynbinds) - (byte-compile-inline-lapcode - (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t) - (1+ start-depth)) - ;; Unbind dynamic variables. - (when dynbinds - (byte-compile-out 'byte-unbind (length dynbinds))) - (cl-assert (eq byte-compile-depth (1+ start-depth)) - nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) + (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) + ;; optimized switch bytecode makes it impossible to guess the correct + ;; `byte-compile-depth', which can result in incorrect inlined code. + ;; therefore, we do not inline code that uses the `byte-switch' + ;; instruction. + (if (assq 'byte-switch lap) + (byte-compile-normal-call form) + (mapc 'byte-compile-form (cdr form)) + (unless fmax2 + ;; Old-style byte-code. + (cl-assert (listp fargs)) + (while fargs + (pcase (car fargs) + (`&optional (setq fargs (cdr fargs))) + (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (push (cadr fargs) dynbinds) + (setq fargs nil)) + (_ (push (pop fargs) dynbinds)))) + (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) + (cond + ((<= (+ alen alen) fmax2) + ;; Add missing &optional (or &rest) arguments. + (dotimes (_ (- (/ (1+ fmax2) 2) alen)) + (byte-compile-push-constant nil))) + ((zerop (logand fmax2 1)) + (byte-compile-report-error + (format "Too many arguments for inlined function %S" form)) + (byte-compile-discard (- alen (/ fmax2 2)))) + (t + ;; Turn &rest args into a list. + (let ((n (- alen (/ (1- fmax2) 2)))) + (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) + (if (< n 5) + (byte-compile-out + (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) + 0) + (byte-compile-out 'byte-listN n))))) + (mapc #'byte-compile-dynamic-variable-bind dynbinds) + (byte-compile-inline-lapcode lap (1+ start-depth)) + ;; Unbind dynamic variables. + (when dynbinds + (byte-compile-out 'byte-unbind (length dynbinds))) + (cl-assert (eq byte-compile-depth (1+ start-depth)) + nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))) (defun byte-compile-check-variable (var access-type) "Do various error checks before a use of the variable VAR." commit 4364a769b489c044c4e9eeac6cfbabcc844ab332 Author: Noam Postavsky Date: Wed Apr 19 23:01:43 2017 -0400 Don't register "def" as an autoload prefix (Bug#26412) * lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload): Don't accept "def" as a prefix. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 90e6aec4e7..ca46f31767 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -547,7 +547,9 @@ Don't try to split prefixes that are already longer than that.") ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes. (dolist (pair (prog1 prefixes (setq prefixes nil))) (let ((s (car pair))) - (if (or (> (length s) 2) ;Long enough! + (if (or (and (> (length s) 2) ; Long enough! + ;; But don't use "def" from deffoo-pkg-thing. + (not (string= "def" s))) (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix? (radix-tree-lookup (cdr pair) "")) ;Nothing to expand! (push pair prefixes) ;Keep it as is. commit cd56490fef9cf585708b9d11de2f3f2ec1e2d5b2 Author: Stefan Monnier Date: Wed Apr 19 20:43:41 2017 -0400 Use substring completion for Info menus and index * lisp/info.el (Info-complete-menu-item): Add `category' metadata. (Info-menu): Simplify now that we use the `default' arg of completing-read. * lisp/minibuffer.el (completion-category-defaults): Use substring completion for `info-menu`. diff --git a/etc/NEWS b/etc/NEWS index 76c9dbc331..7281827878 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -386,6 +386,10 @@ end of the word). * Changes in Specialized Modes and Packages in Emacs 26.1 +*** Info menu and index completion uses substring completion by default. +This can be customized via the `info-menu` category in +completion-category-override. + +++ *** The ancestor buffer is shown by default in 3way merges. A new option ediff-show-ancestor and a new toggle diff --git a/lisp/info.el b/lisp/info.el index 92e7c24ab1..a2071533d8 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1869,7 +1869,7 @@ a node in FILENAME. \"(FILENAME)\" is a short format to go to the Top node in FILENAME." (let* ((completion-ignore-case t) (Info-read-node-completion-table (Info-build-node-completions)) - (nodename (completing-read prompt 'Info-read-node-name-1 nil t))) + (nodename (completing-read prompt #'Info-read-node-name-1 nil t))) (if (equal nodename "") (Info-read-node-name prompt) nodename))) @@ -2583,7 +2583,8 @@ new buffer." "Follow reference named: ") completions nil t))) (list (if (equal input "") - default input) current-prefix-arg)) + default input) + current-prefix-arg)) (user-error "No cross-references in this node")))) (unless footnotename @@ -2703,6 +2704,7 @@ Because of ambiguities, this should be concatenated with something like (user-error "No menu in this node")) (cond ((eq (car-safe action) 'boundaries) nil) + ((eq action 'metadata) `(metadata (category . info-menu))) ((eq action 'lambda) (re-search-forward (concat "\n\\* +" (regexp-quote string) ":") nil t)) @@ -2783,15 +2785,7 @@ new buffer." default) "Menu item: ") #'Info-complete-menu-item nil t nil nil - default))) - ;; we rely on the fact that completing-read accepts an input - ;; of "" even when the require-match argument is true and "" - ;; is not a valid possibility - (if (string= item "") - (if default - (setq item default) - ;; ask again - (setq item nil)))) + default)))) (list item current-prefix-arg)))) ;; there is a problem here in that if several menu items have the same ;; name you can only go to the node of the first with this command. @@ -3308,7 +3302,7 @@ Give an empty topic name to go to the Index node itself." (unwind-protect (with-current-buffer Info-complete-menu-buffer (Info-goto-index) - (completing-read "Index topic: " 'Info-complete-menu-item)) + (completing-read "Index topic: " #'Info-complete-menu-item)) (kill-buffer Info-complete-menu-buffer))))) (if (equal Info-current-file "dir") (error "The Info directory node has no index; use m to select a manual")) @@ -3482,7 +3476,7 @@ search results." (unwind-protect (with-current-buffer Info-complete-menu-buffer (Info-goto-index) - (completing-read "Index topic: " 'Info-complete-menu-item)) + (completing-read "Index topic: " #'Info-complete-menu-item)) (kill-buffer Info-complete-menu-buffer))))) (if (equal topic "") (Info-find-node Info-current-file "*Index*") diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 00722ec4b1..0377cd549a 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -834,7 +834,8 @@ styles for specific categories, such as files, buffers, etc." (defvar completion-category-defaults '((buffer (styles . (basic substring))) (unicode-name (styles . (basic substring))) - (project-file (styles . (basic substring)))) + (project-file (styles . (basic substring))) + (info-menu (styles . (basic substring)))) "Default settings for specific completion categories. Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: commit 992e2019d3c535a61df064de25f664c01b8c309f Author: Glenn Morris Date: Wed Apr 19 16:32:04 2017 -0400 Remove some explicit runtime loads of pcase Pcase is macros, so these should have used eval-when-compile. Anyway, pcase entry points are autoloaded, so the compiler handles it. * lisp/profiler.el, lisp/emacs-lisp/eieio-core.el: * lisp/emacs-lisp/generator.el, lisp/emacs-lisp/subr-x.el: * lisp/progmodes/xref.el: No need to require pcase. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 7c149421d4..dfe1c06bfa 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -32,7 +32,6 @@ ;;; Code: (require 'cl-lib) -(require 'pcase) (require 'eieio-loaddefs nil t) ;;; diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 2ab01404ba..c96b400809 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -77,7 +77,6 @@ ;;; Code: (require 'cl-lib) -(require 'pcase) (defvar cps--bindings nil) (defvar cps--states nil) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index c0e5ae5984..440213eb38 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -35,7 +35,6 @@ ;;; Code: -(require 'pcase) (eval-when-compile (require 'cl-lib)) diff --git a/lisp/profiler.el b/lisp/profiler.el index 8af2c50a4d..15ff9b68ab 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -27,7 +27,6 @@ ;;; Code: (require 'cl-lib) -(require 'pcase) (defgroup profiler nil "Emacs profiler." diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 1ca3e1d153..d0636ba635 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -69,7 +69,6 @@ (require 'cl-lib) (require 'eieio) (require 'ring) -(require 'pcase) (require 'project) (eval-when-compile commit 41a5b76f79e2ef12a089e94406159e2d0e1fad1f Author: Glenn Morris Date: Wed Apr 19 16:28:48 2017 -0400 Stop cl-lib loading pcase at runtime The cause was an unexpanded pcase-defmacro in cl-loaddefs. * lisp/emacs-lisp/autoload.el (make-autoload): Treat pcase-defmacro like defmacro. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d1f3c359f3..90e6aec4e7 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -164,7 +164,8 @@ expression, in which case we want to handle forms differently." ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode define-globalized-minor-mode defun defmacro easy-mmode-define-minor-mode define-minor-mode - define-inline cl-defun cl-defmacro cl-defgeneric)) + define-inline cl-defun cl-defmacro cl-defgeneric + pcase-defmacro)) (macrop car) (setq expand (let ((load-file-name file)) (macroexpand form))) (memq (car expand) '(progn prog1 defalias))) commit 3533623c4a007df80d57fe2dbc47d7e40d85041c Author: Alan Third Date: Wed Apr 19 20:36:40 2017 +0100 Note frame documentation exceptions for NS builds * doc/lispref/frames.texi (Management Parameters, Child Frames): Note NS differences. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 8fc4d7d649..bed7873fe3 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1894,6 +1894,9 @@ display has been suspended via window manager settings. Under X, Emacs uses the Motif window manager hints to turn off decorations. Some window managers may not honor these hints. +NS builds consider the tool bar to be a decoration, and therefore hide +it on an undecorated frame. + @vindex override-redirect, a frame parameter @item override-redirect @cindex override redirect frames @@ -2846,6 +2849,10 @@ is resized, the relative position of the child frame remains unaltered. Hence, resizing either of these frames can hide or reveal parts of the child frame. + NS builds do not clip child frames at the parent frame's edges, +allowing them to be positioned so they do not obscure the parent +frame while still being visible themselves. + Usually, moving a parent frame moves along all its child frames and their descendants as well, keeping their relative positions unaltered. The hook @code{move-frame-functions} (@pxref{Frame Position}) is run for @@ -2856,12 +2863,13 @@ its parent. In this case, the position respective to the lower or right native edge of the parent frame is usually lost. A visible child frame always appears on top of its parent frame thus -obscuring parts of it. This is comparable to the window-system window -of a top-level frame which also always appears on top of its parent -window---the desktop's root window. When a parent frame is iconified or -made invisible (@pxref{Visibility of Frames}), its child frames are made -invisible. When a parent frame is deiconified or made visible, its -child frames are made visible. When a parent frame is about to be +obscuring parts of it, except on NS builds where it may be positioned +beneath the parent. This is comparable to the window-system window of +a top-level frame which also always appears on top of its parent +window---the desktop's root window. When a parent frame is iconified +or made invisible (@pxref{Visibility of Frames}), its child frames are +made invisible. When a parent frame is deiconified or made visible, +its child frames are made visible. When a parent frame is about to be deleted, (@pxref{Deleting Frames}) its child frames are recursively deleted before it. commit 21fa90b0488b2344b9b93ccc77263968d1b903b7 Author: Alan Third Date: Wed Apr 19 17:58:49 2017 +0100 Fix bug introduced by my last commit * src/nsterm.m (ns_draw_fringe_bitmap): Revert key-mashing accident. diff --git a/src/nsterm.m b/src/nsterm.m index fbbcdbe4bc..c53957f933 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2822,7 +2822,7 @@ so some key presses (TAB) are swallowed by the system. */ for (i = 0; i < full_height; i++) cbits[i] = bits[i]; - img = [[EmacsImage alloc] XBM: cbits width: 8 + img = [[EmacsImage alloc] initFromXBM: cbits width: 8 height: full_height fg: 0 bg: 0]; bimgs[p->which - 1] = img; commit aca21d42d3c1327ddc202a03585416f2821e6839 Author: Alan Third Date: Fri Apr 14 10:02:38 2017 +0100 Add new frame functionality to NS port * lisp/frame.el (frame-restack): Call ns-frame-restack. * src/keyboard.c (kbd_buffer_get_event) [HAVE_NS]: Enable MOVE_FRAME_EVENT handling. * src/frame.h: * src/frame.c: Enable 'z-group', 'undecorated' and 'parent' frame definitions. * src/nsfns.m: Add x_set_z_group, x_set_parent_frame and x_set_undecorated (Cocoa only) to handler struct. (Fx_create_frame): Handle 'z-group', 'parent-frame' and 'undecorated' frame parameter. (Fns_frame_restack): New function. * src/nsmenu.m (free_frame_tool_bar, update_frame_tool_bar): FRAME_TOOLBAR_HEIGHT is no longer a variable. * src/nsterm.h (NS_PARENT_WINDOW_LEFT_POS, NS_PARENT_WINDOW_TOP_POS): Add #defines to find the screen position of the parent frame. (NS_TOP_POS): Remove defun. (EmacsView): Remove redundant toolbar variables and add createToolbar method. (FRAME_NS_TITLEBAR_HEIGHT, FRAME_TOOLBAR_HEIGHT): Always calculate the values instead of storing them in a variable. * src/nsterm.m (x_set_offset, windowDidMove): Take parent frame position into account when positioning frames. (initFrameFromEmacs): Remove toolbar creation code and handle new frame parameters. (x_set_window_size): Remove toolbar height calculation. (x_set_z_group): (x_set_parent_frame): (x_set_undecorated) [NS_IMPL_COCOA]: New function. (x_destroy_window): Detach parent if child closes. (updateFrameSize): Change NSTRACE message to reflect new reality and no longer reset frame size. (windowWillResize): Don’t change NS window name when the titlebar is invisible. (createToolbar): Move toolbar creation code into it’s own method. (toggleFullScreen): FRAME_TOOLBAR_HEIGHT and FRAME_NS_TITLEBAR_HEIGHT are no longer variables. (windowDidMove): Fire MOVE_FRAME_EVENT Emacs event. diff --git a/lisp/frame.el b/lisp/frame.el index 86a0e26e39..e632b5943f 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1548,7 +1548,9 @@ Some window managers may refuse to restack windows. " ((eq frame-type 'x) (x-frame-restack frame1 frame2 above)) ((eq frame-type 'w32) - (w32-frame-restack frame1 frame2 above)))) + (w32-frame-restack frame1 frame2 above)) + ((eq frame-type 'ns) + (ns-frame-restack frame1 frame2 above)))) (error "Cannot restack frames"))) (defun frame-size-changed-p (&optional frame) diff --git a/src/frame.c b/src/frame.c index 282b691c27..681a245ee0 100644 --- a/src/frame.c +++ b/src/frame.c @@ -683,7 +683,6 @@ make_frame (bool mini_p) f->vertical_scroll_bar_type = vertical_scroll_bar_none; f->horizontal_scroll_bars = false; f->want_fullscreen = FULLSCREEN_NONE; -#if ! defined (HAVE_NS) f->undecorated = false; #ifndef HAVE_NTGUI f->override_redirect = false; @@ -692,7 +691,6 @@ make_frame (bool mini_p) f->no_focus_on_map = false; f->no_accept_focus = false; f->z_group = z_group_none; -#endif #if ! defined (USE_GTK) && ! defined (HAVE_NS) f->last_tool_bar_item = -1; #endif diff --git a/src/frame.h b/src/frame.h index 36af6e6780..4aa7c34a29 100644 --- a/src/frame.h +++ b/src/frame.h @@ -75,10 +75,10 @@ struct frame Usually it is nil. */ Lisp_Object title; -#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_NS) +#if defined (HAVE_WINDOW_SYSTEM) /* This frame's parent frame, if it has one. */ Lisp_Object parent_frame; -#endif /* HAVE_WINDOW_SYSTEM and not HAVE_NS */ +#endif /* HAVE_WINDOW_SYSTEM */ /* The frame which should receive keystrokes that occur in this frame, or nil if they should go to the frame itself. This is @@ -332,7 +332,7 @@ struct frame bool_bf horizontal_scroll_bars : 1; #endif /* HAVE_WINDOW_SYSTEM */ -#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_NS) +#if defined (HAVE_WINDOW_SYSTEM) /* True if this is an undecorated frame. */ bool_bf undecorated : 1; @@ -570,7 +570,7 @@ fset_face_alist (struct frame *f, Lisp_Object val) { f->face_alist = val; } -#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_NS) +#if defined (HAVE_WINDOW_SYSTEM) INLINE void fset_parent_frame (struct frame *f, Lisp_Object val) { @@ -914,7 +914,7 @@ default_pixels_per_inch_y (void) #define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) f, 0) #endif /* HAVE_WINDOW_SYSTEM */ -#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_NS) +#if defined (HAVE_WINDOW_SYSTEM) #define FRAME_UNDECORATED(f) ((f)->undecorated) #ifdef HAVE_NTGUI #define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0) @@ -934,7 +934,7 @@ default_pixels_per_inch_y (void) #define FRAME_Z_GROUP_ABOVE_SUSPENDED(f) \ ((f)->z_group == z_group_above_suspended) #define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below) -#else /* not HAVE_WINDOW_SYSTEM or HAVE_NS */ +#else /* not HAVE_WINDOW_SYSTEM */ #define FRAME_UNDECORATED(f) ((void) f, 0) #define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0) #define FRAME_PARENT_FRAME(f) ((void) f, NULL) @@ -945,7 +945,7 @@ default_pixels_per_inch_y (void) #define FRAME_Z_GROUP_NONE(f) ((void) f, true) #define FRAME_Z_GROUP_ABOVE(f) ((void) f, false) #define FRAME_Z_GROUP_BELOW(f) ((void) f, false) -#endif /* HAVE_WINDOW_SYSTEM and not HAVE_NS */ +#endif /* HAVE_WINDOW_SYSTEM */ /* Whether horizontal scroll bars are currently enabled for frame F. */ #if USE_HORIZONTAL_SCROLL_BARS diff --git a/src/keyboard.c b/src/keyboard.c index 3e50142f7c..c9fa2a9f5e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -4056,7 +4056,7 @@ kbd_buffer_get_event (KBOARD **kbp, kbd_fetch_ptr = event + 1; } #endif -#if defined (HAVE_X11) || defined (HAVE_NTGUI) +#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (HAVE_NS) else if (event->kind == MOVE_FRAME_EVENT) { /* Make an event (move-frame (FRAME)). */ diff --git a/src/nsfns.m b/src/nsfns.m index 8a923dd393..f1a5df8f27 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -972,12 +972,16 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side 0, /* x_set_sticky */ 0, /* x_set_tool_bar_position */ 0, /* x_set_inhibit_double_buffering */ - 0, /* x_set_undecorated */ - 0, /* x_set_parent_frame */ +#ifdef NS_IMPL_COCOA + x_set_undecorated, /* x_set_undecorated */ +#else + 0, /*x_set_undecorated */ +#endif + x_set_parent_frame, /* x_set_parent_frame */ 0, /* x_set_skip_taskbar */ 0, /* x_set_no_focus_on_map */ 0, /* x_set_no_accept_focus */ - 0, /* x_set_z_group */ + x_set_z_group, /* x_set_z_group */ 0, /* x_set_override_redirect */ }; @@ -1087,7 +1091,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side ptrdiff_t count = specpdl_ptr - specpdl; Lisp_Object display; struct ns_display_info *dpyinfo = NULL; - Lisp_Object parent; + Lisp_Object parent, parent_frame; struct kboard *kb; static int desc_ctr = 1; int x_width = 0, x_height = 0; @@ -1265,6 +1269,25 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, Qx_create_frame_1); + tem = x_get_arg (dpyinfo, parms, Qundecorated, NULL, NULL, RES_TYPE_BOOLEAN); + FRAME_UNDECORATED (f) = !NILP (tem) && !EQ (tem, Qunbound); + store_frame_param (f, Qundecorated, FRAME_UNDECORATED (f) ? Qt : Qnil); + + parent_frame = x_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, + RES_TYPE_SYMBOL); + /* Accept parent-frame iff parent-id was not specified. */ + if (!NILP (parent) + || EQ (parent_frame, Qunbound) + || NILP (parent_frame) + || !FRAMEP (parent_frame) + || !FRAME_LIVE_P (XFRAME (parent_frame))) + parent_frame = Qnil; + + fset_parent_frame (f, parent_frame); + store_frame_param (f, Qparent_frame, parent_frame); + + x_default_parameter (f, parms, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + /* The resources controlling the menu-bar and tool-bar are processed specially at startup, and reflected in the mode variables; ignore them here. */ @@ -1405,6 +1428,37 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side } } +DEFUN ("ns-frame-restack", Fns_frame_restack, Sns_frame_restack, 2, 3, 0, + doc: /* Restack FRAME1 below FRAME2. +This means that if both frames are visible and the display areas of +these frames overlap, FRAME2 (partially) obscures FRAME1. If optional +third argument ABOVE is non-nil, restack FRAME1 above FRAME2. This +means that if both frames are visible and the display areas of these +frames overlap, FRAME1 (partially) obscures FRAME2. + +Some window managers may refuse to restack windows. */) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) +{ + struct frame *f1 = decode_live_frame (frame1); + struct frame *f2 = decode_live_frame (frame2); + + if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2)) + { + NSWindow *window = [FRAME_NS_VIEW (f1) window]; + NSInteger window2 = [[FRAME_NS_VIEW (f2) window] windowNumber]; + NSWindowOrderingMode flag = NILP (above) ? NSWindowBelow : NSWindowAbove; + + [window orderWindow: flag + relativeTo: window2]; + + return Qt; + } + else + { + error ("Cannot restack frames"); + return Qnil; + } +} DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel, 0, 1, "", @@ -3134,6 +3188,7 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename defsubr (&Sns_display_monitor_attributes_list); defsubr (&Sns_frame_geometry); defsubr (&Sns_frame_edges); + defsubr (&Sns_frame_restack); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); diff --git a/src/nsmenu.m b/src/nsmenu.m index 59ea3855ed..1262c9cb4d 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -995,8 +995,6 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f block_input (); view->wait_for_tool_bar = NO; - FRAME_TOOLBAR_HEIGHT (f) = 0; - /* Note: This trigger an animation, which calls windowDidResize repeatedly. */ f->output_data.ns->in_animation = 1; @@ -1129,12 +1127,6 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f } #endif - FRAME_TOOLBAR_HEIGHT (f) = - NSHeight ([window frameRectForContentRect: NSMakeRect (0, 0, 0, 0)]) - - FRAME_NS_TITLEBAR_HEIGHT (f); - if (FRAME_TOOLBAR_HEIGHT (f) < 0) // happens if frame is fullscreen. - FRAME_TOOLBAR_HEIGHT (f) = 0; - if (oldh != FRAME_TOOLBAR_HEIGHT (f)) [view updateFrameSize:YES]; if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0) diff --git a/src/nsterm.h b/src/nsterm.h index 53d9344cc7..2f8c4269b0 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -430,7 +430,7 @@ char const * nstrace_fullscreen_type_name (int); NSString *workingText; BOOL processingCompose; int fs_state, fs_before_fs, next_maximized; - int tibar_height, tobar_height, bwidth; + int bwidth; int maximized_width, maximized_height; NSWindow *nonfs_window; BOOL fs_is_native; @@ -454,6 +454,7 @@ char const * nstrace_fullscreen_type_name (int); /* Emacs-side interface */ - initFrameFromEmacs: (struct frame *) f; +- (void) createToolbar: (struct frame *)f; - (void) setRows: (int) r andColumns: (int) c; - (void) setWindowClosing: (BOOL)closing; - (EmacsToolbar *) toolbar; @@ -1012,8 +1013,6 @@ struct x_output #define NS_FACE_FOREGROUND(f) ((f)->foreground) #define NS_FACE_BACKGROUND(f) ((f)->background) -#define FRAME_NS_TITLEBAR_HEIGHT(f) ((f)->output_data.ns->titlebar_height) -#define FRAME_TOOLBAR_HEIGHT(f) ((f)->output_data.ns->toolbar_height) #define FRAME_DEFAULT_FACE(f) FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID) @@ -1029,6 +1028,25 @@ struct x_output #define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec, 0) #endif +/* Compute pixel height of the frame's titlebar. */ +#define FRAME_NS_TITLEBAR_HEIGHT(f) \ + (NSHeight([FRAME_NS_VIEW (f) frame]) == 0 ? \ + 0 \ + : (int)(NSHeight([FRAME_NS_VIEW (f) window].frame) \ + - NSHeight([NSWindow contentRectForFrameRect: \ + [[FRAME_NS_VIEW (f) window] frame] \ + styleMask:[[FRAME_NS_VIEW (f) window] styleMask]]))) + +/* Compute pixel height of the toolbar. */ +#define FRAME_TOOLBAR_HEIGHT(f) \ + (([[FRAME_NS_VIEW (f) window] toolbar] == nil \ + || ! [[FRAME_NS_VIEW (f) window] toolbar].isVisible) ? \ + 0 \ + : (int)(NSHeight([NSWindow contentRectForFrameRect: \ + [[FRAME_NS_VIEW (f) window] frame] \ + styleMask:[[FRAME_NS_VIEW (f) window] styleMask]]) \ + - NSHeight([[[FRAME_NS_VIEW (f) window] contentView] frame]))) + /* Compute pixel size for vertical scroll bars */ #define NS_SCROLL_BAR_WIDTH(f) \ (FRAME_HAS_VERTICAL_SCROLL_BARS (f) \ @@ -1059,12 +1077,17 @@ struct x_output (FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f) \ - NS_SCROLL_BAR_HEIGHT (f)) : 0) -/* XXX: fix for GNUstep inconsistent accounting for titlebar */ -#ifdef NS_IMPL_GNUSTEP -#define NS_TOP_POS(f) ((f)->top_pos + 18) -#else -#define NS_TOP_POS(f) ((f)->top_pos) -#endif +/* Calculate system coordinates of the left and top of the parent + window or, if there is no parent window, the screen. */ +#define NS_PARENT_WINDOW_LEFT_POS(f) \ + (FRAME_PARENT_FRAME (f) != NULL \ + ? [[FRAME_NS_VIEW (f) window] parentWindow].frame.origin.x : 0) +#define NS_PARENT_WINDOW_TOP_POS(f) \ + (FRAME_PARENT_FRAME (f) != NULL \ + ? ([[FRAME_NS_VIEW (f) window] parentWindow].frame.origin.y \ + + [[FRAME_NS_VIEW (f) window] parentWindow].frame.size.height \ + - FRAME_NS_TITLEBAR_HEIGHT (FRAME_PARENT_FRAME (f))) \ + : [[[FRAME_NS_VIEW (f) window] screen] frame].size.height) #define FRAME_NS_FONT_TABLE(f) (FRAME_DISPLAY_INFO (f)->font_table) @@ -1185,6 +1208,12 @@ extern int x_display_pixel_width (struct ns_display_info *); /* This in nsterm.m */ extern float ns_antialias_threshold; extern void x_destroy_window (struct frame *f); +extern void x_set_undecorated (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value); +extern void x_set_parent_frame (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value); +extern void x_set_z_group (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value); extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timespec const *timeout, sigset_t const *sigmask); diff --git a/src/nsterm.m b/src/nsterm.m index 4725991aff..fbbcdbe4bc 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1668,6 +1668,17 @@ -(void)remove -------------------------------------------------------------------------- */ { NSTRACE ("x_destroy_window"); + + /* If this frame has a parent window, detach it as not doing so can + cause a crash in GNUStep. */ + if (FRAME_PARENT_FRAME (f) != NULL) + { + NSWindow *child = [FRAME_NS_VIEW (f) window]; + NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; + + [parent removeChildWindow: child]; + } + check_window_system (f); x_free_frame_resources (f); ns_window_num--; @@ -1706,14 +1717,18 @@ -(void)remove - FRAME_TOOLBAR_HEIGHT (f)) : f->top_pos; #ifdef NS_IMPL_GNUSTEP - if (f->left_pos < 100) - f->left_pos = 100; /* don't overlap menu */ + if (FRAME_PARENT_FRAME (f) == NULL) + { + if (f->left_pos < 100) + f->left_pos = 100; /* don't overlap menu */ + } #endif /* Constrain the setFrameTopLeftPoint so we don't move behind the menu bar. */ - NSPoint pt = NSMakePoint (SCREENMAXBOUND (f->left_pos), - SCREENMAXBOUND ([fscreen frame].size.height - - NS_TOP_POS (f))); + NSPoint pt = NSMakePoint (SCREENMAXBOUND (f->left_pos + + NS_PARENT_WINDOW_LEFT_POS (f)), + SCREENMAXBOUND (NS_PARENT_WINDOW_TOP_POS (f) + - f->top_pos)); NSTRACE_POINT ("setFrameTopLeftPoint", pt); [[view window] setFrameTopLeftPoint: pt]; f->size_hint_flags &= ~(XNegative|YNegative); @@ -1738,7 +1753,6 @@ -(void)remove EmacsView *view = FRAME_NS_VIEW (f); NSWindow *window = [view window]; NSRect wr = [window frame]; - int tb = FRAME_EXTERNAL_TOOL_BAR (f); int pixelwidth, pixelheight; int orig_height = wr.size.height; @@ -1764,25 +1778,6 @@ -(void)remove pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height); } - /* If we have a toolbar, take its height into account. */ - if (tb && ! [view isFullscreen]) - { - /* NOTE: previously this would generate wrong result if toolbar not - yet displayed and fixing toolbar_height=32 helped, but - now (200903) seems no longer needed */ - FRAME_TOOLBAR_HEIGHT (f) = - NSHeight ([window frameRectForContentRect: NSMakeRect (0, 0, 0, 0)]) - - FRAME_NS_TITLEBAR_HEIGHT (f); -#if 0 - /* Only breaks things here, removed by martin 2015-09-30. */ -#ifdef NS_IMPL_GNUSTEP - FRAME_TOOLBAR_HEIGHT (f) -= 3; -#endif -#endif - } - else - FRAME_TOOLBAR_HEIGHT (f) = 0; - wr.size.width = pixelwidth + f->border_width; wr.size.height = pixelheight; if (! [view isFullscreen]) @@ -1811,6 +1806,150 @@ -(void)remove unblock_input (); } +#ifdef NS_IMPL_COCOA +void +x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +/* -------------------------------------------------------------------------- + Set frame F's `undecorated' parameter. If non-nil, F's window-system + window is drawn without decorations, title, minimize/maximize boxes + and external borders. This usually means that the window cannot be + dragged, resized, iconified, maximized or deleted with the mouse. If + nil, draw the frame with all the elements listed above unless these + have been suspended via window manager settings. + + GNUStep cannot change an existing window's style. + -------------------------------------------------------------------------- */ +{ + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; + + if (!EQ (new_value, old_value)) + { + block_input (); + + if (NILP (new_value)) + { + FRAME_UNDECORATED (f) = false; + [window setStyleMask: ((window.styleMask + | NSWindowStyleMaskTitled + | NSWindowStyleMaskResizable + | NSWindowStyleMaskMiniaturizable + | NSWindowStyleMaskClosable) + ^ NSWindowStyleMaskBorderless)]; + + [view createToolbar: f]; + } + else + { + [window setToolbar: nil]; + /* Do I need to release the toolbar here? */ + + FRAME_UNDECORATED (f) = true; + [window setStyleMask: ((window.styleMask | NSWindowStyleMaskBorderless) + ^ (NSWindowStyleMaskTitled + | NSWindowStyleMaskResizable + | NSWindowStyleMaskMiniaturizable + | NSWindowStyleMaskClosable))]; + } + + /* At this point it seems we don't have an active NSResponder, + so some key presses (TAB) are swallowed by the system. */ + [window makeFirstResponder: view]; + + [view updateFrameSize: NO]; + unblock_input (); + } +} +#endif /* NS_IMPL_COCOA */ + +void +x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +/* -------------------------------------------------------------------------- + Set frame F's `parent-frame' parameter. If non-nil, make F a child + frame of the frame specified by that parameter. Technically, this + makes F's window-system window a child window of the parent frame's + window-system window. If nil, make F's window-system window a + top-level window--a child of its display's root window. + + A child frame's `left' and `top' parameters specify positions + relative to the top-left corner of its parent frame's native + rectangle. On macOS moving a parent frame moves all its child + frames too, keeping their position relative to the parent + unaltered. When a parent frame is iconified or made invisible, its + child frames are made invisible. When a parent frame is deleted, + its child frames are deleted too. + + Whether a child frame has a tool bar may be window-system or window + manager dependent. It's advisable to disable it via the frame + parameter settings. + + Some window managers may not honor this parameter. + -------------------------------------------------------------------------- */ +{ + struct frame *p = NULL; + NSWindow *parent, *child; + + if (!NILP (new_value) + && (!FRAMEP (new_value) + || !FRAME_LIVE_P (p = XFRAME (new_value)) + || !FRAME_X_P (p))) + { + store_frame_param (f, Qparent_frame, old_value); + error ("Invalid specification of `parent-frame'"); + } + + if (p != FRAME_PARENT_FRAME (f)) + { + parent = [FRAME_NS_VIEW (p) window]; + child = [FRAME_NS_VIEW (f) window]; + + block_input (); + [parent addChildWindow: child + ordered: NSWindowAbove]; + unblock_input (); + + fset_parent_frame (f, new_value); + } +} + +void +x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +/* Set frame F's `z-group' parameter. If `above', F's window-system + window is displayed above all windows that do not have the `above' + property set. If nil, F's window is shown below all windows that + have the `above' property set and above all windows that have the + `below' property set. If `below', F's window is displayed below + all windows that do. + + Some window managers may not honor this parameter. */ +{ + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; + + if (NILP (new_value)) + { + window.level = NSNormalWindowLevel; + FRAME_Z_GROUP (f) = z_group_none; + } + else if (EQ (new_value, Qabove)) + { + window.level = NSNormalWindowLevel + 1; + FRAME_Z_GROUP (f) = z_group_above; + } + else if (EQ (new_value, Qabove_suspended)) + { + /* Not sure what level this should be. */ + window.level = NSNormalWindowLevel + 1; + FRAME_Z_GROUP (f) = z_group_above_suspended; + } + else if (EQ (new_value, Qbelow)) + { + window.level = NSNormalWindowLevel - 1; + FRAME_Z_GROUP (f) = z_group_below; + } + else + error ("Invalid z-group specification"); +} static void ns_fullscreen_hook (struct frame *f) @@ -2683,7 +2822,7 @@ -(void)remove for (i = 0; i < full_height; i++) cbits[i] = bits[i]; - img = [[EmacsImage alloc] initFromXBM: cbits width: 8 + img = [[EmacsImage alloc] XBM: cbits width: 8 height: full_height fg: 0 bg: 0]; bimgs[p->which - 1] = img; @@ -6399,7 +6538,8 @@ - (void) updateFrameSize: (BOOL) delay; newh = (int)wr.size.height - extra; NSTRACE_SIZE ("New size", NSMakeSize (neww, newh)); - NSTRACE_MSG ("tool_bar_height: %d", emacsframe->tool_bar_height); + NSTRACE_MSG ("FRAME_TOOLBAR_HEIGHT: %d", FRAME_TOOLBAR_HEIGHT (emacsframe)); + NSTRACE_MSG ("FRAME_NS_TITLEBAR_HEIGHT: %d", FRAME_NS_TITLEBAR_HEIGHT (emacsframe)); cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, neww); rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (emacsframe, newh); @@ -6424,9 +6564,11 @@ - (void) updateFrameSize: (BOOL) delay; SET_FRAME_GARBAGED (emacsframe); cancel_mouse_face (emacsframe); - wr = NSMakeRect (0, 0, neww, newh); + /* The next two lines appear to be setting the frame to the same + size as it already is. Why are they there? */ + // wr = NSMakeRect (0, 0, neww, newh); - [view setFrame: wr]; + // [view setFrame: wr]; // to do: consider using [NSNotificationCenter postNotificationName:]. [self windowDidMove: // Update top/left. @@ -6489,7 +6631,8 @@ - (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize old_title = 0; } } - else if (fs_state == FULLSCREEN_NONE && ! maximizing_resize) + else if (fs_state == FULLSCREEN_NONE && ! maximizing_resize + && [[self window] titleVisibility]) { char *size_title; NSWindow *window = [self window]; @@ -6692,6 +6835,34 @@ - (BOOL)isOpaque } +- (void)createToolbar: (struct frame *)f +{ + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; + + toolbar = [[EmacsToolbar alloc] initForView: self withIdentifier: + [NSString stringWithFormat: @"Emacs Frame %d", + ns_window_num]]; + [toolbar setVisible: NO]; + [window setToolbar: toolbar]; + + /* Don't set frame garbaged until tool bar is up to date? + This avoids an extra clear and redraw (flicker) at frame creation. */ + if (FRAME_EXTERNAL_TOOL_BAR (f)) wait_for_tool_bar = YES; + else wait_for_tool_bar = NO; + + +#ifdef NS_IMPL_COCOA + { + NSButton *toggleButton; + toggleButton = [window standardWindowButton: NSWindowToolbarButton]; + [toggleButton setTarget: self]; + [toggleButton setAction: @selector (toggleToolbar: )]; + } +#endif +} + + - initFrameFromEmacs: (struct frame *)f { NSRect r, wr; @@ -6729,14 +6900,14 @@ - (BOOL)isOpaque maximizing_resize = NO; #endif - win = [[EmacsWindow alloc] + win = [[EmacsFSWindow alloc] initWithContentRect: r - styleMask: (NSWindowStyleMaskResizable | -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 - NSWindowStyleMaskTitled | -#endif - NSWindowStyleMaskMiniaturizable | - NSWindowStyleMaskClosable) + styleMask: (FRAME_UNDECORATED (f) + ? NSWindowStyleMaskBorderless + : NSWindowStyleMaskTitled + | NSWindowStyleMaskResizable + | NSWindowStyleMaskMiniaturizable + | NSWindowStyleMaskClosable) backing: NSBackingStoreBuffered defer: YES]; @@ -6746,7 +6917,6 @@ - (BOOL)isOpaque wr = [win frame]; bwidth = f->border_width = wr.size.width - r.size.width; - tibar_height = FRAME_NS_TITLEBAR_HEIGHT (f) = wr.size.height - r.size.height; [win setAcceptsMouseMovedEvents: YES]; [win setDelegate: self]; @@ -6766,42 +6936,36 @@ - (BOOL)isOpaque [win setTitle: name]; /* toolbar support */ - toolbar = [[EmacsToolbar alloc] initForView: self withIdentifier: - [NSString stringWithFormat: @"Emacs Frame %d", - ns_window_num]]; - [win setToolbar: toolbar]; - [toolbar setVisible: NO]; - - /* Don't set frame garbaged until tool bar is up to date? - This avoids an extra clear and redraw (flicker) at frame creation. */ - if (FRAME_EXTERNAL_TOOL_BAR (f)) wait_for_tool_bar = YES; - else wait_for_tool_bar = NO; - - -#ifdef NS_IMPL_COCOA - { - NSButton *toggleButton; - toggleButton = [win standardWindowButton: NSWindowToolbarButton]; - [toggleButton setTarget: self]; - [toggleButton setAction: @selector (toggleToolbar: )]; - } -#endif - FRAME_TOOLBAR_HEIGHT (f) = 0; + if (! FRAME_UNDECORATED (f)) + [self createToolbar: f]; tem = f->icon_name; if (!NILP (tem)) [win setMiniwindowTitle: [NSString stringWithUTF8String: SSDATA (tem)]]; + if (FRAME_PARENT_FRAME (f) != NULL) + { + NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; + [parent addChildWindow: win + ordered: NSWindowAbove]; + } + + if (!NILP (FRAME_Z_GROUP (f))) + win.level = NSNormalWindowLevel + + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1); + { NSScreen *screen = [win screen]; if (screen != 0) { NSPoint pt = NSMakePoint - (IN_BOUND (-SCREENMAX, f->left_pos, SCREENMAX), + (IN_BOUND (-SCREENMAX, f->left_pos + + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX), IN_BOUND (-SCREENMAX, - [screen frame].size.height - NS_TOP_POS (f), SCREENMAX)); + NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos, + SCREENMAX)); [win setFrameTopLeftPoint: pt]; @@ -6843,9 +7007,15 @@ - (void)windowDidMove: sender return; if (screen != nil) { - emacsframe->left_pos = r.origin.x; + emacsframe->left_pos = r.origin.x - NS_PARENT_WINDOW_LEFT_POS (emacsframe); emacsframe->top_pos = - [screen frame].size.height - (r.origin.y + r.size.height); + NS_PARENT_WINDOW_TOP_POS (emacsframe) - (r.origin.y + r.size.height); + + if (emacs_event) + { + emacs_event->kind = MOVE_FRAME_EVENT; + EV_TRAILER ((id)nil); + } } } @@ -7262,9 +7432,6 @@ - (void)toggleFullScreen: (id)sender [fw setOpaque: NO]; f->border_width = 0; - FRAME_NS_TITLEBAR_HEIGHT (f) = 0; - tobar_height = FRAME_TOOLBAR_HEIGHT (f); - FRAME_TOOLBAR_HEIGHT (f) = 0; nonfs_window = w; @@ -7298,9 +7465,6 @@ - (void)toggleFullScreen: (id)sender [w setOpaque: NO]; f->border_width = bwidth; - FRAME_NS_TITLEBAR_HEIGHT (f) = tibar_height; - if (FRAME_EXTERNAL_TOOL_BAR (f)) - FRAME_TOOLBAR_HEIGHT (f) = tobar_height; // to do: consider using [NSNotificationCenter postNotificationName:] to send notifications.