diff options
| author | Andrea Corallo <akrl@sdf.org> | 2020-12-23 19:49:58 +0100 |
|---|---|---|
| committer | Andrea Corallo <akrl@sdf.org> | 2020-12-23 19:49:58 +0100 |
| commit | b99a4744822a11e4af098b63db18f54a4e323d58 (patch) | |
| tree | a3836dfbd6bf4ebfc5b61c566d146cfd65984f62 | |
| parent | ffcd490cb49ba86d625288ea425d98e8cac22a05 (diff) | |
| parent | 40bc77d9a6b8d824690fb6ee3003d74951bb3ae5 (diff) | |
| download | emacs-b99a4744822a11e4af098b63db18f54a4e323d58.tar.gz emacs-b99a4744822a11e4af098b63db18f54a4e323d58.tar.bz2 emacs-b99a4744822a11e4af098b63db18f54a4e323d58.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
39 files changed, 593 insertions, 259 deletions
diff --git a/.clang-format b/.clang-format index 7895ada36da..9ab09a86ff2 100644 --- a/.clang-format +++ b/.clang-format @@ -4,7 +4,7 @@ AlignEscapedNewlinesLeft: true AlwaysBreakAfterReturnType: TopLevelDefinitions BreakBeforeBinaryOperators: All BreakBeforeBraces: GNU -ColumnLimit: 80 +ColumnLimit: 70 ContinuationIndentWidth: 2 ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE] IncludeCategories: diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 3fea604184c..661961f9379 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -1009,13 +1009,14 @@ profiling, so we don't recommend leaving it active except when you are actually running the code you want to examine). The profiler report buffer shows, on each line, a function that was -called, followed by how much resources (cpu or memory) it used in +called, preceded by how much resources (cpu or memory) it used in absolute and percentage terms since profiling started. If a given -line has a @samp{+} symbol at the left-hand side, you can expand that -line by typing @kbd{@key{RET}}, in order to see the function(s) called -by the higher-level function. Use a prefix argument (@kbd{C-u -@key{RET}}) to see the whole call tree below a function. Pressing -@kbd{@key{RET}} again will collapse back to the original state. +line has a @samp{+} symbol to the left of the function name, you can +expand that line by typing @kbd{@key{RET}}, in order to see the +function(s) called by the higher-level function. Use a prefix +argument (@kbd{C-u @key{RET}}) to see the whole call tree below a +function. Pressing @kbd{@key{RET}} again will collapse back to the +original state. Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function at point. Press @kbd{d} to view a function's documentation. You can diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 0f157c39d63..ef848ac5107 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -381,6 +381,56 @@ The default value of @var{separators} for @code{split-string}. Its usual value is @w{@code{"[ \f\t\n\r\v]+"}}. @end defvar +@defun string-slice string regexp +Split @var{string} into a list of strings on @var{regexp} boundaries. +As opposed to @code{split-string}, the boundaries are included in the +result set: + +@example +(string-slice " two words " " +") + @result{} (" two" " words" " ") +@end example +@end defun + +@defun string-clean-whitespace string +Clean up the whitespace in @var{string} by collapsing stretches of +whitespace to a single space character, as well as removing all +whitespace from the start and the end of @var{string}. +@end defun + +@defun string-fill string length +Attempt to Word-wrap @var{string} so that no lines are longer than +@var{length}. Filling is done on whitespace boundaries only. If +there are individual words that are longer than @var{length}, these +will not be shortened. +@end defun + +@defun string-limit string length &optional end +If @var{string} is shorter than @var{length}, @var{string} is returned +as is. Otherwise, return a substring of @var{string} consisting of +the first @var{length} characters. If the optional @var{end} +parameter is given, return a string of the @var{length} last +characters instead. +@end defun + +@defun string-lines string &optional omit-nulls +Split @var{string} into a list of strings on newline boundaries. If +@var{omit-nulls}, remove empty lines from the results. +@end defun + +@defun string-pad string length &optional padding start +Pad @var{string} to the be of @var{length} using @var{padding} as the +padding character (defaulting to the space character). If +@var{string} is shorter than @var{length}, no padding is done. If +@var{start} is @code{nil} (or not present), the padding is done to the +end of the string, and if it's non-@code{nil}, to the start of the +string. +@end defun + +@defun string-chop-newline string +Remove the final newline, if any, from @var{string}. +@end defun + @node Modifying Strings @section Modifying Strings @cindex modifying strings @@ -303,6 +303,14 @@ the buffer cycles the whole buffer between "only top-level headings", * Changes in Specialized Modes and Packages in Emacs 28.1 ++++ +** profiler.el +The results displayed by 'profiler-report' now have the usage figures +at the left hand side followed by the function name. This is intended +to make better use of the horizontal space, in particular eliminating +the truncation of function names. There is no way to get the former +layout back. + ** Loading dunnet.el in batch mode doesn't start the game any more. Instead you need to do "emacs -f dun-batch" to start the game in batch mode. @@ -1445,6 +1453,11 @@ that makes it a valid button. ** Miscellaneous +++ +*** A number of new string manipulation functions have been added. +'string-clean-whitespace', 'string-fill', 'string-limit', +'string-lines', 'string-pad', 'string-chop-newline' and 'string-slice'. + ++++ *** New variable 'current-minibuffer-command'. This is like 'this-command', but it is bound recursively when entering the minibuffer. @@ -2203,6 +2216,10 @@ presented to users or passed on to other applications. ** 'start-process-shell-command' and 'start-file-process-shell-command' do not support the old calling conventions any longer. +** Functions operating on local filenames now check that the filenames +don't contain any NUL bytes. This avoids subtle bugs caused by +silently using only the part of the filename until the first NUL byte. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index bcd672133db..9847a367467 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -36,7 +36,7 @@ (keybindings :initform nil) (phony :initform t) (sourcetype :initform '(ede-source-emacs)) - (availablecompilers :initform '(ede-emacs-compiler ede-xemacs-compiler)) + (availablecompilers :initform '(ede-emacs-compiler)) (aux-packages :initarg :aux-packages :initform nil :type list @@ -104,6 +104,7 @@ For Emacs Lisp, return addsuffix command on source files." :name "xemacs" :variables '(("EMACS" . "xemacs"))) "Compile Emacs Lisp programs with XEmacs.") +(make-obsolete-variable 'ede-xemacs-compiler 'ede-emacs-compiler "28.1") ;;; Claiming files (cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 37d6170fee5..0067495fea0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -131,6 +131,10 @@ There can be any number of :example/:result elements." (mapconcat :eval (mapconcat (lambda (a) (concat "[" a "]")) '("foo" "bar" "zot") " ")) + (string-pad + :eval (string-pad "foo" 5) + :eval (string-pad "foobar" 5) + :eval (string-pad "foo" 5 ?- t)) (mapcar :eval (mapcar #'identity "123")) (format @@ -139,10 +143,23 @@ There can be any number of :example/:result elements." (substring :eval (substring "foobar" 0 3) :eval (substring "foobar" 3)) + (string-limit + :eval (string-limit "foobar" 3) + :eval (string-limit "foobar" 3 t) + :eval (string-limit "foobar" 10)) + (truncate-string-to-width + :eval (truncate-string-to-width "foobar" 3) + :eval (truncate-string-to-width "你好bar" 5)) (split-string :eval (split-string "foo bar") :eval (split-string "|foo|bar|" "|") :eval (split-string "|foo|bar|" "|" t)) + (string-slice + :eval (string-slice "foo-bar" "-") + :eval (string-slice "foo-bar--zot-" "-+")) + (string-lines + :eval (string-lines "foo\n\nbar") + :eval (string-lines "foo\n\nbar" t)) (string-replace :eval (string-replace "foo" "bar" "foozot")) (replace-regexp-in-string @@ -167,10 +184,19 @@ There can be any number of :example/:result elements." (string-remove-prefix :no-manual t :eval (string-remove-prefix "foo" "foobar")) + (string-chop-newline + :eval (string-chop-newline "foo\n")) + (string-clean-whitespace + :eval (string-clean-whitespace " foo bar ")) + (string-fill + :eval (string-fill "Three short words" 12) + :eval (string-fill "Long-word" 3)) (reverse :eval (reverse "foo")) (substring-no-properties :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) + (try-completion + :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) "Predicates for Strings" (string-equal :eval (string-equal "foo" "foo")) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index e6abb39ddc6..7e17a3464e6 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -264,6 +264,91 @@ carriage return." (substring string 0 (- (length string) (length suffix))) string)) +(defun string-clean-whitespace (string) + "Clean up whitespace in STRING. +All sequences of whitespaces in STRING are collapsed into a +single space character, and leading/trailing whitespace is +removed." + (let ((blank "[[:blank:]\r\n]+")) + (string-trim (replace-regexp-in-string blank " " string t t) + blank blank))) + +(defun string-fill (string length) + "Try to word-wrap STRING so that no lines are longer than LENGTH. +Wrapping is done where there is whitespace. If there are +individual words in STRING that are longer than LENGTH, the +result will have lines that are longer than LENGTH." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((fill-column length) + (adaptive-fill-mode nil)) + (fill-region (point-min) (point-max))) + (buffer-string))) + +(defun string-limit (string length &optional end) + "Return (up to) a LENGTH substring of STRING. +If STRING is shorter than or equal to LENGTH, the entire string +is returned unchanged. + +If STRING is longer than LENGTH, return a substring consisting of +the first LENGTH characters of STRING. If END is non-nil, return +the last LENGTH characters instead. + +When shortening strings for display purposes, +`truncate-string-to-width' is almost always a better alternative +than this function." + (unless (natnump length) + (signal 'wrong-type-argument (list 'natnump length))) + (cond + ((<= (length string) length) string) + (end (substring string (- (length string) length))) + (t (substring string 0 length)))) + +(defun string-lines (string &optional omit-nulls) + "Split STRING into a list of lines. +If OMIT-NULLS, empty lines will be removed from the results." + (split-string string "\n" omit-nulls)) + +(defun string-slice (string regexp) + "Split STRING at REGEXP boundaries and return a list of slices. +The boundaries that match REGEXP are included in the result. + +Also see `split-string'." + (if (zerop (length string)) + (list "") + (let ((i (string-match-p regexp string 1))) + (if i + (cons (substring string 0 i) + (string-slice (substring string i) regexp)) + (list string))))) + +(defun string-pad (string length &optional padding start) + "Pad STRING to LENGTH using PADDING. +If PADDING is nil, the space character is used. If not nil, it +should be a character. + +If STRING is longer than the absolute value of LENGTH, no padding +is done. + +If START is nil (or not present), the padding is done to the end +of the string, and if non-nil, padding is done to the start of +the string." + (unless (natnump length) + (signal 'wrong-type-argument (list 'natnump length))) + (let ((pad-length (- length (length string)))) + (if (< pad-length 0) + string + (concat (and start + (make-string pad-length (or padding ?\s))) + string + (and (not start) + (make-string pad-length (or padding ?\s))))))) + +(defun string-chop-newline (string) + "Remove the final newline (if any) from STRING." + (string-remove-suffix "\n" string)) + (defun replace-region-contents (beg end replace-fn &optional max-secs max-costs) "Replace the region between BEG and END using REPLACE-FN. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 16f3a024aa6..3a3722c90a3 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1050,6 +1050,7 @@ Responsible for handling and, or, and parenthetical expressions.") (grouplist (or groups (gnus-search-get-active srv))) q-string artlist group) (message "Opening server %s" server) + (gnus-open-server srv) ;; We should only be doing this once, in ;; `nnimap-open-connection', but it's too frustrating to try to ;; get to the server from the process buffer. @@ -1071,7 +1072,7 @@ Responsible for handling and, or, and parenthetical expressions.") ;; A bit of backward-compatibility slash convenience: if the ;; query string doesn't start with any known IMAP search ;; keyword, assume it is a "TEXT" search. - (unless (and (string-match "\\`[^ [:blank:]]+" q-string) + (unless (and (string-match "\\`[^[:blank:]]+" q-string) (memql (intern-soft (downcase (match-string 0 q-string))) gnus-search-imap-search-keys)) @@ -1424,7 +1425,7 @@ Returns a list of [group article score] vectors." (string-to-number article) (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) - group nil)) + group (string-remove-prefix "nnmaildir:" server))) (if (numberp score) score (string-to-number score))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a0e7173998b..38edc772f8f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3658,6 +3658,7 @@ buffer that was in action when the last article was fetched." ;; so we don't call gnus-data-<field> accessors on nil. (gnus-newsgroup-data gnus--dummy-data-list) (gnus-newsgroup-downloadable '(0)) + (gnus-visual nil) case-fold-search ignores) ;; Here, all marks are bound to Z. (gnus-summary-insert-line gnus--dummy-mail-header diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 465bf867627..143b68f52e7 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -667,6 +667,9 @@ Key bindings: (when image-auto-resize-on-window-resize (add-hook 'window-state-change-functions #'image--window-state-change nil t)) + (add-function :before-while (local 'isearch-filter-predicate) + #'image-mode-isearch-filter) + (run-mode-hooks 'image-mode-hook) (let ((image (image-get-display-property)) (msg1 (substitute-command-keys @@ -782,6 +785,14 @@ Remove text properties that display the image." (if (called-interactively-p 'any) (message "Repeat this command to go back to displaying the image")))) +(defun image-mode-isearch-filter (_beg _end) + "Show image as text when trying to search/replace in the image buffer." + (save-match-data + (when (and (derived-mode-p 'image-mode) + (image-get-display-property)) + (image-mode-as-text))) + t) + (defvar archive-superior-buffer) (defvar tar-superior-buffer) (declare-function image-flush "image.c" (spec &optional frame)) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2e5dd5ffa50..1648e56cfb4 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1516,8 +1516,9 @@ ones, in case fg and bg are nil." plist))) (defun shr-tag-base (dom) - (when-let* ((base (dom-attr dom 'href))) - (setq shr-base (shr-parse-base base))) + (let ((base (dom-attr dom 'href))) + (when (> (length base) 0) + (setq shr-base (shr-parse-base base)))) (shr-generic dom)) (defun shr-tag-a (dom) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e6e718ebe3b..0dbcb835363 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2234,7 +2234,7 @@ the uid and gid from FILENAME." (file-writable-p (concat prefix localname2)))) (tramp-do-copy-or-rename-file-directly op (concat prefix localname1) (concat prefix localname2) - ok-if-already-exists keep-date t) + ok-if-already-exists keep-date preserve-uid-gid) ;; We must change the ownership to the local user. (tramp-set-file-uid-gid (concat prefix localname2) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4d8118a728b..0260569aa95 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -7,10 +7,6 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.5.0-pre -;; Package-Requires: ((emacs "25.1")) -;; Package-Type: multi -;; URL: https://savannah.gnu.org/projects/tramp ;; This file is part of GNU Emacs. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index d6b582edf87..30e5ba8151b 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,6 +7,10 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp +;; Version: 2.5.0-pre +;; Package-Requires: ((emacs "25.1")) +;; Package-Type: multi +;; URL: https://www.gnu.org/software/tramp/ ;; This file is part of GNU Emacs. @@ -30,10 +34,10 @@ ;;; Code: -;; In the Tramp GIT, the version number is auto-frobbed from tramp.el, -;; and the bug report address is auto-frobbed from configure.ac. -;; Emacs version check is defined in macro AC_EMACS_INFO of -;; aclocal.m4; should be changed only there. +;; In the Tramp GIT repository, the version number, the bug report +;; address and the required Emacs version are auto-frobbed from +;; configure.ac, so you should edit that file and run "autoconf && +;; ./configure" to change them. ;;;###tramp-autoload (defconst tramp-version "2.5.0-pre" diff --git a/lisp/profiler.el b/lisp/profiler.el index bf8aacccc37..1c843727cc8 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -34,7 +34,7 @@ :version "24.3" :prefix "profiler-") -(defconst profiler-version "24.3") +(defconst profiler-version "28.1") (defcustom profiler-sampling-interval 1000000 "Default sampling interval in nanoseconds." @@ -85,6 +85,9 @@ (t (profiler-ensure-string arg))) for len = (length str) + if (zerop width) + collect str into frags + else if (< width len) collect (progn (put-text-property (max 0 (- width 2)) len 'invisible 'profiler str) @@ -445,14 +448,16 @@ Optional argument MODE means only check for the specified mode (cpu or mem)." :group 'profiler) (defvar profiler-report-cpu-line-format - '((50 left) - (24 right ((19 right) - (5 right))))) + '((17 right ((12 right) + (5 right))) + (1 left "%s") + (0 left))) (defvar profiler-report-memory-line-format - '((55 left) - (19 right ((14 right profiler-format-number) - (5 right))))) + '((20 right ((15 right profiler-format-number) + (5 right))) + (1 left "%s") + (0 left))) (defvar-local profiler-report-profile nil "The current profile.") @@ -495,7 +500,11 @@ RET: expand or collapse")) (defun profiler-report-header-line-format (fmt &rest args) (let* ((header (apply #'profiler-format fmt args)) (escaped (replace-regexp-in-string "%" "%%" header))) - (concat " " escaped))) + (concat + (propertize " " + 'display '(space :align-to 0) + 'face 'fixed-pitch) + escaped))) (defun profiler-report-line-format (tree) (let ((diff-p (profiler-profile-diff-p profiler-report-profile)) @@ -505,13 +514,14 @@ RET: expand or collapse")) (profiler-format (cl-ecase (profiler-profile-type profiler-report-profile) (cpu profiler-report-cpu-line-format) (memory profiler-report-memory-line-format)) - name-part (if diff-p (list (if (> count 0) (format "+%s" count) count) "") - (list count count-percent))))) + (list count count-percent)) + " " + name-part))) (defun profiler-report-insert-calltree (tree) (let ((line (profiler-report-line-format tree))) @@ -735,11 +745,11 @@ below entry at point." (cpu (profiler-report-header-line-format profiler-report-cpu-line-format - "Function" (list "CPU samples" "%"))) + (list "Samples" "%") " " " Function")) (memory (profiler-report-header-line-format profiler-report-memory-line-format - "Function" (list "Bytes" "%"))))) + (list "Bytes" "%") " " " Function")))) (let ((predicate (cl-ecase order (ascending #'profiler-calltree-count<) (descending #'profiler-calltree-count>)))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d58b32f3c3c..50bb841111f 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -394,6 +394,12 @@ This variant of `rx' supports common Python named REGEXPS." (any ?' ?\") "__main__" (any ?' ?\") (* space) ?:)) (symbol-name (seq (any letter ?_) (* (any word ?_)))) + (assignment-target (seq (? ?*) + (* symbol-name ?.) symbol-name + (? ?\[ (+ (not ?\])) ?\]))) + (grouped-assignment-target (seq (? ?*) + (* symbol-name ?.) (group symbol-name) + (? ?\[ (+ (not ?\])) ?\]))) (open-paren (or "{" "[" "(")) (close-paren (or "}" "]" ")")) (simple-operator (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)) @@ -605,6 +611,18 @@ This is the medium decoration level, including everything in `python-font-lock-keywords-level-1', as well as keywords and builtins.") +(defun python-font-lock-assignment-matcher (regexp) + "Font lock matcher for assignments based on REGEXP. +Return nil if REGEXP matched within a `paren' context (to avoid, +e.g., default values for arguments or passing arguments by name +being treated as assignments) or is followed by an '=' sign (to +avoid '==' being treated as an assignment." + (lambda (limit) + (let ((res (re-search-forward regexp limit t))) + (unless (or (python-syntax-context 'paren) + (equal (char-after (point)) ?=)) + res)))) + (defvar python-font-lock-keywords-maximum-decoration `((python--font-lock-f-strings) ,@python-font-lock-keywords-level-2 @@ -652,33 +670,57 @@ builtins.") ) symbol-end) . font-lock-type-face) - ;; assignments - ;; support for a = b = c = 5 - (,(lambda (limit) - (let ((re (python-rx (group symbol-name) - ;; subscript, like "[5]" - (? ?\[ (+ (not ?\])) ?\]) (* space) - ;; type hint, like ": int" or ": Mapping[int, str]" - (? ?: (* space) (+ not-simple-operator) (* space)) - assignment-operator)) - (res nil)) - (while (and (setq res (re-search-forward re limit t)) - (or (python-syntax-context 'paren) - (equal (char-after (point)) ?=)))) - res)) - (1 font-lock-variable-name-face nil nil)) - ;; support for a, b, c = (1, 2, 3) - (,(lambda (limit) - (let ((re (python-rx (group symbol-name) (* space) - (* ?, (* space) symbol-name (* space)) - ?, (* space) symbol-name (* space) - assignment-operator)) - (res nil)) - (while (and (setq res (re-search-forward re limit t)) - (goto-char (match-end 1)) - (python-syntax-context 'paren))) - res)) - (1 font-lock-variable-name-face nil nil))) + ;; multiple assignment + ;; (note that type hints are not allowed for multiple assignments) + ;; a, b, c = 1, 2, 3 + ;; a, *b, c = 1, 2, 3, 4, 5 + ;; [a, b] = (1, 2) + ;; (l[1], l[2]) = (10, 11) + ;; (a, b, c, *d) = *x, y = 5, 6, 7, 8, 9 + ;; (a,) = 'foo' + ;; (*a,) = ['foo', 'bar', 'baz'] + ;; d.x, d.y[0], *d.z = 'a', 'b', 'c', 'd', 'e' + ;; and variants thereof + ;; the cases + ;; (a) = 5 + ;; [a] = 5 + ;; [*a] = 5, 6 + ;; are handled separately below + (,(python-font-lock-assignment-matcher + (python-rx (? (or "[" "(") (* space)) + grouped-assignment-target (* space) ?, (* space) + (* assignment-target (* space) ?, (* space)) + (? assignment-target (* space)) + (? ?, (* space)) + (? (or ")" "]") (* space)) + (group assignment-operator))) + (1 font-lock-variable-name-face) + (,(python-rx grouped-assignment-target) + (progn + (goto-char (match-end 1)) ; go back after the first symbol + (match-beginning 2)) ; limit the search until the assignment + nil + (1 font-lock-variable-name-face))) + ;; single assignment with type hints, e.g. + ;; a: int = 5 + ;; b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo') + ;; c: Collection = {1, 2, 3} + ;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'} + (,(python-font-lock-assignment-matcher + (python-rx grouped-assignment-target (* space) + (? ?: (* space) (+ not-simple-operator) (* space)) + assignment-operator)) + (1 font-lock-variable-name-face)) + ;; special cases + ;; (a) = 5 + ;; [a] = 5 + ;; [*a] = 5, 6 + (,(python-font-lock-assignment-matcher + (python-rx (or "[" "(") (* space) + grouped-assignment-target (* space) + (or ")" "]") (* space) + assignment-operator)) + (1 font-lock-variable-name-face))) "Font lock keywords to use in python-mode for maximum decoration. This decoration level includes everything in diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 8cb0350dc06..45b0f84e332 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -780,24 +780,25 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'." (defun ruby-mode-set-encoding () "Insert a magic comment header with the proper encoding if necessary." (save-excursion - (widen) - (goto-char (point-min)) - (when (ruby--encoding-comment-required-p) + (save-restriction + (widen) (goto-char (point-min)) - (let ((coding-system (ruby--detect-encoding))) - (when coding-system - (if (looking-at "^#!") (beginning-of-line 2)) - (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") - ;; update existing encoding comment if necessary - (unless (string= (match-string 2) coding-system) - (goto-char (match-beginning 2)) - (delete-region (point) (match-end 2)) - (insert coding-system))) - ((looking-at "\\s *#.*coding\\s *[:=]")) - (t (when ruby-insert-encoding-magic-comment - (ruby--insert-coding-comment coding-system)))) - (when (buffer-modified-p) - (basic-save-buffer-1))))))) + (when (ruby--encoding-comment-required-p) + (goto-char (point-min)) + (let ((coding-system (ruby--detect-encoding))) + (when coding-system + (if (looking-at "^#!") (beginning-of-line 2)) + (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") + ;; update existing encoding comment if necessary + (unless (string= (match-string 2) coding-system) + (goto-char (match-beginning 2)) + (delete-region (point) (match-end 2)) + (insert coding-system))) + ((looking-at "\\s *#.*coding\\s *[:=]")) + (t (when ruby-insert-encoding-magic-comment + (ruby--insert-coding-comment coding-system)))) + (when (buffer-modified-p) + (basic-save-buffer-1)))))))) (defvar ruby--electric-indent-chars '(?. ?\) ?} ?\])) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 6e99e9d8ace..181f94b0bc6 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -97,6 +97,10 @@ This is typically the filename.") "Return the line number corresponding to the location." nil) +(cl-defgeneric xref-location-column (_location) + "Return the exact column corresponding to the location." + nil) + (cl-defgeneric xref-match-length (_item) "Return the length of the match." nil) @@ -118,7 +122,7 @@ part of the file name." (defclass xref-file-location (xref-location) ((file :type string :initarg :file) (line :type fixnum :initarg :line :reader xref-location-line) - (column :type fixnum :initarg :column :reader xref-file-location-column)) + (column :type fixnum :initarg :column :reader xref-location-column)) :documentation "A file location is a file/line/column triple. Line numbers start from 1 and columns from 0.") @@ -613,9 +617,9 @@ SELECT is `quit', also quit the *xref* window." (xref-show-location-at-point)) (defun xref--item-at-point () - (save-excursion - (back-to-indentation) - (get-text-property (point) 'xref-item))) + (get-text-property + (if (eolp) (1- (point)) (point)) + 'xref-item)) (defun xref-goto-xref (&optional quit) "Jump to the xref on the current line and select its window. @@ -853,17 +857,30 @@ GROUP is a string for decoration purposes and XREF is an (length (and line (format "%d" line))))) for line-format = (and max-line-width (format "%%%dd: " max-line-width)) + with prev-line-key = nil do (xref--insert-propertized '(face xref-file-header xref-group t) group "\n") (cl-loop for (xref . more2) on xrefs do (with-slots (summary location) xref (let* ((line (xref-location-line location)) + (new-summary summary) + (line-key (list (xref-location-group location) line)) (prefix (if line (propertize (format line-format line) 'face 'xref-line-number) " "))) + ;; Render multiple matches on the same line, together. + (when (and line (equal prev-line-key line-key)) + (when-let ((column (xref-location-column location))) + (delete-region + (save-excursion + (forward-line -1) + (move-to-column (+ (length prefix) column)) + (point)) + (point)) + (setq new-summary (substring summary column) prefix ""))) (xref--insert-propertized (list 'xref-item xref 'mouse-face 'highlight @@ -871,7 +888,8 @@ GROUP is a string for decoration purposes and XREF is an 'help-echo (concat "mouse-2: display in another window, " "RET or mouse-1: follow reference")) - prefix summary))) + prefix new-summary) + (setq prev-line-key line-key))) (insert "\n")))) (defun xref--analyze (xrefs) diff --git a/lisp/server.el b/lisp/server.el index 7773da09c76..d1183b95d36 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1327,8 +1327,6 @@ The following commands are accepted by the client: (t (server-return-error proc err)))) (defun server-execute (proc files nowait commands dontkill frame tty-name) - (when server-raise-frame - (select-frame-set-input-focus (or frame (selected-frame)))) ;; This is run from timers and process-filters, i.e. "asynchronously". ;; But w.r.t the user, this is not really asynchronous since the timer ;; is run after 0s and the process-filter is run in response to the @@ -1688,7 +1686,9 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)." (switch-to-buffer next-buffer)) ;; After all the above, we might still have ended up with ;; a minibuffer/dedicated-window (if there's no other). - (error (pop-to-buffer next-buffer))))))))) + (error (pop-to-buffer next-buffer))))))) + (when server-raise-frame + (select-frame-set-input-focus (window-frame))))) ;;;###autoload (defun server-save-buffers-kill-terminal (arg) diff --git a/lisp/wdired.el b/lisp/wdired.el index b7dd4ee9496..c2e1d0cafce 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -355,7 +355,10 @@ non-nil means return old filename." dired-permission-flags-regexp nil t) (goto-char (match-beginning 0)) (looking-at "l") - (search-forward " -> " (line-end-position) t))) + (if (and used-F + dired-ls-F-marks-symlinks) + (re-search-forward "@? -> " (line-end-position) t) + (search-forward " -> " (line-end-position) t)))) (goto-char (match-beginning 0)) (setq end (point))) (when (and used-F diff --git a/src/alloc.c b/src/alloc.c index 22f37b0cedd..25153621298 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -664,7 +664,7 @@ display_malloc_warning (void) call3 (intern ("display-warning"), intern ("alloc"), build_string (pending_malloc_warning), - intern ("emergency")); + intern (":emergency")); pending_malloc_warning = 0; } diff --git a/src/callproc.c b/src/callproc.c index 4bca1e5ebd3..c7f560ac3da 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -541,8 +541,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, callproc_fd[CALLPROC_STDERR] = fd_error; } + char *const *env = make_environment_block (current_dir); + #ifdef MSDOS /* MW, July 1993 */ - status = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + status = child_setup (filefd, fd_output, fd_error, new_argv, env, + SSDATA (current_dir)); if (status < 0) { @@ -589,7 +592,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, block_child_signal (&oldset); #ifdef WINDOWSNT - pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + pid = child_setup (filefd, fd_output, fd_error, new_argv, env, + SSDATA (current_dir)); #else /* not WINDOWSNT */ /* vfork, and prevent local vars from being clobbered by the vfork. */ @@ -604,6 +608,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, ptrdiff_t volatile sa_avail_volatile = sa_avail; ptrdiff_t volatile sa_count_volatile = sa_count; char **volatile new_argv_volatile = new_argv; + char *const *volatile env_volatile = env; int volatile callproc_fd_volatile[CALLPROC_FDS]; for (i = 0; i < CALLPROC_FDS; i++) callproc_fd_volatile[i] = callproc_fd[i]; @@ -620,6 +625,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, sa_avail = sa_avail_volatile; sa_count = sa_count_volatile; new_argv = new_argv_volatile; + env = env_volatile; for (i = 0; i < CALLPROC_FDS; i++) callproc_fd[i] = callproc_fd_volatile[i]; @@ -646,7 +652,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, signal (SIGPROF, SIG_DFL); #endif - child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir); + child_setup (filefd, fd_output, fd_error, new_argv, env, + SSDATA (current_dir)); } #endif /* not WINDOWSNT */ @@ -1205,8 +1212,6 @@ exec_failed (char const *name, int err) Initialize inferior's priority, pgrp, connected dir and environment. then exec another program based on new_argv. - If SET_PGRP, put the subprocess into a separate process group. - CURRENT_DIR is an elisp string giving the path of the current directory the subprocess should have. Since we can't really signal a decent error from within the child, this should be verified as an @@ -1217,11 +1222,9 @@ exec_failed (char const *name, int err) On MS-DOS, either return an exit status or signal an error. */ CHILD_SETUP_TYPE -child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, - Lisp_Object current_dir) +child_setup (int in, int out, int err, char *const *new_argv, + char *const *env, const char *current_dir) { - char **env; - char *pwd_var; #ifdef WINDOWSNT int cpid; HANDLE handles[3]; @@ -1235,24 +1238,6 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, src/alloca.c) it is safe because that changes the superior's static variables as if the superior had done alloca and will be cleaned up in the usual way. */ - { - char *temp; - ptrdiff_t i; - - i = SBYTES (current_dir); -#ifdef MSDOS - /* MSDOS must have all environment variables malloc'ed, because - low-level libc functions that launch subsidiary processes rely - on that. */ - pwd_var = xmalloc (i + 5); -#else - if (MAX_ALLOCA - 5 < i) - exec_failed (new_argv[0], ENOMEM); - pwd_var = alloca (i + 5); -#endif - temp = pwd_var + 4; - memcpy (pwd_var, "PWD=", 4); - lispstpcpy (temp, current_dir); #ifndef DOS_NT /* We can't signal an Elisp error here; we're in a vfork. Since @@ -1260,101 +1245,13 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, should only return an error if the directory's permissions are changed between the check and this chdir, but we should at least check. */ - if (chdir (temp) < 0) + if (chdir (current_dir) < 0) _exit (EXIT_CANCELED); -#else /* DOS_NT */ - /* Get past the drive letter, so that d:/ is left alone. */ - if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2])) - { - temp += 2; - i -= 2; - } -#endif /* DOS_NT */ - - /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */ - while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1])) - temp[--i] = 0; - } - - /* Set `env' to a vector of the strings in the environment. */ - { - register Lisp_Object tem; - register char **new_env; - char **p, **q; - register int new_length; - Lisp_Object display = Qnil; - - new_length = 0; - - for (tem = Vprocess_environment; - CONSP (tem) && STRINGP (XCAR (tem)); - tem = XCDR (tem)) - { - if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0 - && (SDATA (XCAR (tem)) [7] == '\0' - || SDATA (XCAR (tem)) [7] == '=')) - /* DISPLAY is specified in process-environment. */ - display = Qt; - new_length++; - } - - /* If not provided yet, use the frame's DISPLAY. */ - if (NILP (display)) - { - Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay); - if (!STRINGP (tmp) && CONSP (Vinitial_environment)) - /* If still not found, Look for DISPLAY in Vinitial_environment. */ - tmp = Fgetenv_internal (build_string ("DISPLAY"), - Vinitial_environment); - if (STRINGP (tmp)) - { - display = tmp; - new_length++; - } - } - - /* new_length + 2 to include PWD and terminating 0. */ - if (MAX_ALLOCA / sizeof *env - 2 < new_length) - exec_failed (new_argv[0], ENOMEM); - env = new_env = alloca ((new_length + 2) * sizeof *env); - /* If we have a PWD envvar, pass one down, - but with corrected value. */ - if (egetenv ("PWD")) - *new_env++ = pwd_var; - - if (STRINGP (display)) - { - if (MAX_ALLOCA - sizeof "DISPLAY=" < SBYTES (display)) - exec_failed (new_argv[0], ENOMEM); - char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display)); - lispstpcpy (stpcpy (vdata, "DISPLAY="), display); - new_env = add_env (env, new_env, vdata); - } - - /* Overrides. */ - for (tem = Vprocess_environment; - CONSP (tem) && STRINGP (XCAR (tem)); - tem = XCDR (tem)) - new_env = add_env (env, new_env, SSDATA (XCAR (tem))); - - *new_env = 0; - - /* Remove variable names without values. */ - p = q = env; - while (*p != 0) - { - while (*q != 0 && strchr (*q, '=') == NULL) - q++; - *p = *q++; - if (*p != 0) - p++; - } - } - +#endif #ifdef WINDOWSNT prepare_standard_handles (in, out, err, handles); - set_process_dir (SSDATA (current_dir)); + set_process_dir (current_dir); /* Spawn the child. (See w32proc.c:sys_spawnve). */ cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); reset_standard_handles (in, out, err, handles); @@ -1513,6 +1410,119 @@ egetenv_internal (const char *var, ptrdiff_t len) return 0; } +/* Create a new environment block. You can pass the returned pointer + to `execve'. Add unwind protections for all newly-allocated + objects. Don't call any Lisp code or the garbage collector while + the block is active. */ + +char *const * +make_environment_block (Lisp_Object current_dir) +{ + char **env; + char *pwd_var; + + { + char *temp; + ptrdiff_t i; + + i = SBYTES (current_dir); + pwd_var = xmalloc (i + 5); + record_unwind_protect_ptr (xfree, pwd_var); + temp = pwd_var + 4; + memcpy (pwd_var, "PWD=", 4); + lispstpcpy (temp, current_dir); + +#ifdef DOS_NT + /* Get past the drive letter, so that d:/ is left alone. */ + if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2])) + { + temp += 2; + i -= 2; + } +#endif /* DOS_NT */ + + /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */ + while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1])) + temp[--i] = 0; + } + + /* Set `env' to a vector of the strings in the environment. */ + + { + register Lisp_Object tem; + register char **new_env; + char **p, **q; + register int new_length; + Lisp_Object display = Qnil; + + new_length = 0; + + for (tem = Vprocess_environment; + CONSP (tem) && STRINGP (XCAR (tem)); + tem = XCDR (tem)) + { + if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0 + && (SDATA (XCAR (tem)) [7] == '\0' + || SDATA (XCAR (tem)) [7] == '=')) + /* DISPLAY is specified in process-environment. */ + display = Qt; + new_length++; + } + + /* If not provided yet, use the frame's DISPLAY. */ + if (NILP (display)) + { + Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay); + if (!STRINGP (tmp) && CONSP (Vinitial_environment)) + /* If still not found, Look for DISPLAY in Vinitial_environment. */ + tmp = Fgetenv_internal (build_string ("DISPLAY"), + Vinitial_environment); + if (STRINGP (tmp)) + { + display = tmp; + new_length++; + } + } + + /* new_length + 2 to include PWD and terminating 0. */ + env = new_env = xnmalloc (new_length + 2, sizeof *env); + record_unwind_protect_ptr (xfree, env); + /* If we have a PWD envvar, pass one down, + but with corrected value. */ + if (egetenv ("PWD")) + *new_env++ = pwd_var; + + if (STRINGP (display)) + { + char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display)); + record_unwind_protect_ptr (xfree, vdata); + lispstpcpy (stpcpy (vdata, "DISPLAY="), display); + new_env = add_env (env, new_env, vdata); + } + + /* Overrides. */ + for (tem = Vprocess_environment; + CONSP (tem) && STRINGP (XCAR (tem)); + tem = XCDR (tem)) + new_env = add_env (env, new_env, SSDATA (XCAR (tem))); + + *new_env = 0; + + /* Remove variable names without values. */ + p = q = env; + while (*p != 0) + { + while (*q != 0 && strchr (*q, '=') == NULL) + q++; + *p = *q++; + if (*p != 0) + p++; + } + } + + return env; +} + /* This is run before init_cmdargs. */ diff --git a/src/coding.c b/src/coding.c index 1afa4aa4749..8c2443889d4 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10354,8 +10354,8 @@ decode_file_name (Lisp_Object fname) #endif } -Lisp_Object -encode_file_name (Lisp_Object fname) +static Lisp_Object +encode_file_name_1 (Lisp_Object fname) { /* This is especially important during bootstrap and dumping, when file-name encoding is not yet known, and therefore any non-ASCII @@ -10380,6 +10380,19 @@ encode_file_name (Lisp_Object fname) #endif } +Lisp_Object +encode_file_name (Lisp_Object fname) +{ + Lisp_Object encoded = encode_file_name_1 (fname); + /* No system accepts NUL bytes in filenames. Allowing them can + cause subtle bugs because the system would silently use a + different filename than expected. Perform this check after + encoding to not miss NUL bytes introduced through encoding. */ + CHECK_TYPE (memchr (SSDATA (encoded), '\0', SBYTES (encoded)) == NULL, + Qfilenamep, fname); + return encoded; +} + DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string, 2, 4, 0, doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result. @@ -11780,6 +11793,7 @@ syms_of_coding (void) DEFSYM (Qignored, "ignored"); DEFSYM (Qutf_8_string_p, "utf-8-string-p"); + DEFSYM (Qfilenamep, "filenamep"); defsubr (&Scoding_system_p); defsubr (&Sread_coding_system); diff --git a/src/fileio.c b/src/fileio.c index 51f12e104ef..651e765fca4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5752,7 +5752,7 @@ auto_save_error (Lisp_Object error_val) Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name), Ferror_message_string (error_val)); call3 (intern ("display-warning"), - intern ("auto-save"), msg, intern ("error")); + intern ("auto-save"), msg, intern (":error")); return Qnil; } diff --git a/src/image.c b/src/image.c index d0ae44e7df7..29cd189f177 100644 --- a/src/image.c +++ b/src/image.c @@ -2414,7 +2414,7 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) /* Look up SPEC in the hash table of the image cache. */ hash = sxhash (spec); - img = search_image_cache (f, spec, hash, foreground, background, true); + img = search_image_cache (f, spec, hash, foreground, background, false); if (img && img->load_failed_p) { free_image (f, img); diff --git a/src/lisp.h b/src/lisp.h index 7dc517be727..103ed079559 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4522,7 +4522,9 @@ extern void setup_process_coding_systems (Lisp_Object); # define CHILD_SETUP_ERROR_DESC "Doing vfork" #endif -extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, bool, Lisp_Object); +extern CHILD_SETUP_TYPE child_setup (int, int, int, char *const *, + char *const *, const char *); +extern char *const *make_environment_block (Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); diff --git a/src/nsfns.m b/src/nsfns.m index c7956497c4c..f3c5a9ef679 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -456,7 +456,7 @@ ns_set_name (struct frame *f, Lisp_Object name, int explicit) static void ns_set_represented_filename (struct frame *f) { - Lisp_Object filename, encoded_filename; + Lisp_Object filename; Lisp_Object buf = XWINDOW (f->selected_window)->contents; NSAutoreleasePool *pool; NSString *fstr; @@ -473,9 +473,7 @@ ns_set_represented_filename (struct frame *f) if (! NILP (filename)) { - encoded_filename = ENCODE_UTF_8 (filename); - - fstr = [NSString stringWithLispString:encoded_filename]; + fstr = [NSString stringWithLispString:filename]; if (fstr == nil) fstr = @""; } else @@ -3012,7 +3010,7 @@ DEFUN ("ns-show-character-palette", #endif -/* Whether N bytes at STR are in the [0,127] range. */ +/* Whether N bytes at STR are in the [1,127] range. */ static bool all_nonzero_ascii (unsigned char *str, ptrdiff_t n) { diff --git a/src/nsfont.m b/src/nsfont.m index 378a6408401..9e4caca9102 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -329,7 +329,7 @@ static NSString { Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist); return CONSP (script) - ? [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (XCDR ((script))))] + ? [NSString stringWithLispString: SYMBOL_NAME (XCDR ((script)))] : @""; } @@ -345,7 +345,7 @@ static NSString if (!strncmp (SSDATA (r), reg, SBYTES (r))) { script = XCDR (XCAR (rts)); - return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (script))]; + return [NSString stringWithLispString: SYMBOL_NAME (script)]; } rts = XCDR (rts); } @@ -370,8 +370,7 @@ static NSString { Lisp_Object key = XCAR (tmp), val = XCDR (tmp); if (EQ (key, QCscript) && SYMBOLP (val)) - return [NSString stringWithUTF8String: - SSDATA (SYMBOL_NAME (val))]; + return [NSString stringWithLispString: SYMBOL_NAME (val)]; if (EQ (key, QClang) && SYMBOLP (val)) return ns_lang_to_script (val); if (EQ (key, QCotf) && CONSP (val) && SYMBOLP (XCAR (val))) diff --git a/src/nsimage.m b/src/nsimage.m index f9fb368ba80..c47a2b2d64a 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -262,7 +262,7 @@ ns_image_size_in_bytes (void *img) found = ENCODE_FILE (found); image = [[EmacsImage alloc] initByReferencingFile: - [NSString stringWithUTF8String: SSDATA (found)]]; + [NSString stringWithLispString: found]]; image->bmRep = nil; #ifdef NS_IMPL_COCOA @@ -278,7 +278,7 @@ ns_image_size_in_bytes (void *img) [image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])]; - [image setName: [NSString stringWithUTF8String: SSDATA (file)]]; + [image setName: [NSString stringWithLispString: file]]; return image; } diff --git a/src/nsmenu.m b/src/nsmenu.m index a286a80da17..efad978316e 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -970,7 +970,7 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, } pmenu = [[EmacsMenu alloc] initWithTitle: - [NSString stringWithUTF8String: SSDATA (title)]]; + [NSString stringWithLispString: title]]; [pmenu fillWithWidgetValue: first_wv->contents]; free_menubar_widget_value_tree (first_wv); unbind_to (specpdl_count, Qnil); diff --git a/src/nsselect.m b/src/nsselect.m index 7b1937f5d99..95fce4d0f78 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -58,7 +58,7 @@ symbol_to_nsstring (Lisp_Object sym) if (EQ (sym, QPRIMARY)) return NXPrimaryPboard; if (EQ (sym, QSECONDARY)) return NXSecondaryPboard; if (EQ (sym, QTEXT)) return NSPasteboardTypeString; - return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))]; + return [NSString stringWithLispString: SYMBOL_NAME (sym)]; } static NSPasteboard * @@ -170,17 +170,12 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype) } else { - char *utfStr; NSString *type, *nsStr; NSEnumerator *tenum; CHECK_STRING (str); - utfStr = SSDATA (str); - nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr - length: SBYTES (str) - encoding: NSUTF8StringEncoding - freeWhenDone: NO]; + nsStr = [NSString stringWithLispString: str]; // FIXME: Why those 2 different code paths? if (gtype == nil) { @@ -196,7 +191,6 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype) eassert (gtype == NSPasteboardTypeString); [pb setString: nsStr forType: gtype]; } - [nsStr release]; ns_store_pb_change_count (pb); } } diff --git a/src/nsterm.m b/src/nsterm.m index 7972fa4dabb..2a117a07801 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5541,9 +5541,8 @@ ns_term_init (Lisp_Object display_name) /* There are 752 colors defined in rgb.txt. */ if ( cl == nil || [[cl allKeys] count] < 752) { - Lisp_Object color_file, color_map, color; + Lisp_Object color_file, color_map, color, name; unsigned long c; - char *name; color_file = Fexpand_file_name (build_string ("rgb.txt"), Fsymbol_value (intern ("data-directory"))); @@ -5556,14 +5555,14 @@ ns_term_init (Lisp_Object display_name) for ( ; CONSP (color_map); color_map = XCDR (color_map)) { color = XCAR (color_map); - name = SSDATA (XCAR (color)); + name = XCAR (color); c = XFIXNUM (XCDR (color)); [cl setColor: [NSColor colorForEmacsRed: RED_FROM_ULONG (c) / 255.0 green: GREEN_FROM_ULONG (c) / 255.0 blue: BLUE_FROM_ULONG (c) / 255.0 alpha: 1.0] - forKey: [NSString stringWithUTF8String: name]]; + forKey: [NSString stringWithLispString: name]]; } /* FIXME: Report any errors writing the color file below. */ @@ -7619,8 +7618,7 @@ not_in_argv (NSString *arg) [self registerForDraggedTypes: ns_drag_types]; tem = f->name; - name = [NSString stringWithUTF8String: - NILP (tem) ? "Emacs" : SSDATA (tem)]; + name = NILP (tem) ? @"Emacs" : [NSString stringWithLispString:tem]; [win setTitle: name]; /* toolbar support */ diff --git a/src/nsxwidget.m b/src/nsxwidget.m index dbd4cb29a62..915fd8b59ce 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -296,8 +296,6 @@ static NSString *xwScript; /* Xwidget webkit commands. */ -static Lisp_Object build_string_with_nsstr (NSString *nsstr); - bool nsxwidget_is_web_view (struct xwidget *xw) { @@ -309,14 +307,14 @@ Lisp_Object nsxwidget_webkit_uri (struct xwidget *xw) { XwWebView *xwWebView = (XwWebView *) xw->xwWidget; - return build_string_with_nsstr (xwWebView.URL.absoluteString); + return [xwWebView.URL.absoluteString lispString]; } Lisp_Object nsxwidget_webkit_title (struct xwidget *xw) { XwWebView *xwWebView = (XwWebView *) xw->xwWidget; - return build_string_with_nsstr (xwWebView.title); + return [xwWebView.title lispString]; } /* @Note ATS - Need application transport security in 'Info.plist' or @@ -350,15 +348,6 @@ nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change) /* TODO: setMagnification:centeredAtPoint. */ } -/* Build lisp string */ -static Lisp_Object -build_string_with_nsstr (NSString *nsstr) -{ - const char *utfstr = [nsstr UTF8String]; - NSUInteger bytes = [nsstr lengthOfBytesUsingEncoding:NSUTF8StringEncoding]; - return make_string (utfstr, bytes); -} - /* Recursively convert an objc native type JavaScript value to a Lisp value. Mostly copied from GTK xwidget 'webkit_js_to_lisp'. */ static Lisp_Object @@ -367,7 +356,7 @@ js_to_lisp (id value) if (value == nil || [value isKindOfClass:NSNull.class]) return Qnil; else if ([value isKindOfClass:NSString.class]) - return build_string_with_nsstr ((NSString *) value); + return [(NSString *) value lispString]; else if ([value isKindOfClass:NSNumber.class]) { NSNumber *nsnum = (NSNumber *) value; @@ -407,7 +396,7 @@ js_to_lisp (id value) { NSString *prop_key = (NSString *) [keys objectAtIndex:i]; id prop_value = [nsdict valueForKey:prop_key]; - p->contents[i] = Fcons (build_string_with_nsstr (prop_key), + p->contents[i] = Fcons ([prop_key lispString], js_to_lisp (prop_value)); } XSETVECTOR (obj, p); diff --git a/src/pdumper.c b/src/pdumper.c index b3abbd66f0c..ae5bbef9b77 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2709,7 +2709,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_EE36B4292E +#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; diff --git a/src/process.c b/src/process.c index 9efefb1de73..15b4a23784e 100644 --- a/src/process.c +++ b/src/process.c @@ -2124,8 +2124,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (!EQ (p->command, Qt)) add_process_read_fd (inchannel); + ptrdiff_t count = SPECPDL_INDEX (); + /* This may signal an error. */ setup_process_coding_systems (process); + char *const *env = make_environment_block (current_dir); block_input (); block_child_signal (&oldset); @@ -2139,6 +2142,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) int volatile forkout_volatile = forkout; int volatile forkerr_volatile = forkerr; struct Lisp_Process *p_volatile = p; + char *const *volatile env_volatile = env; #ifdef DARWIN_OS /* Darwin doesn't let us run setsid after a vfork, so use fork when @@ -2163,6 +2167,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) forkout = forkout_volatile; forkerr = forkerr_volatile; p = p_volatile; + env = env_volatile; pty_flag = p->pty_flag; @@ -2254,9 +2259,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (forkerr < 0) forkerr = forkout; #ifdef WINDOWSNT - pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir); + pid = child_setup (forkin, forkout, forkerr, new_argv, env, + SSDATA (current_dir)); #else /* not WINDOWSNT */ - child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir); + child_setup (forkin, forkout, forkerr, new_argv, env, + SSDATA (current_dir)); #endif /* not WINDOWSNT */ } @@ -2271,6 +2278,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) unblock_child_signal (&oldset); unblock_input (); + /* Environment block no longer needed. */ + unbind_to (count, Qnil); + if (pid < 0) report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, vfork_errno); else diff --git a/src/xterm.c b/src/xterm.c index 3de0d2e73c0..7f8728e47c4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8947,7 +8947,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!f && (f = any) && configureEvent.xconfigure.window == FRAME_X_WINDOW (f) - && FRAME_VISIBLE_P(f)) + && (FRAME_VISIBLE_P(f) + || !(configureEvent.xconfigure.width <= 1 + && configureEvent.xconfigure.height <= 1))) { block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) @@ -8962,7 +8964,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = 0; } #endif - if (f && FRAME_VISIBLE_P(f)) + if (f + && (FRAME_VISIBLE_P(f) + || !(configureEvent.xconfigure.width <= 1 + && configureEvent.xconfigure.height <= 1))) { #ifdef USE_GTK /* For GTK+ don't call x_net_wm_state for the scroll bar diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 9d14a5ab7ec..3fc5f1d3ed3 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -582,5 +582,46 @@ (should (equal (string-remove-suffix "a" "aa") "a")) (should (equal (string-remove-suffix "a" "ba") "b"))) +(ert-deftest subr-clean-whitespace () + (should (equal (string-clean-whitespace " foo ") "foo")) + (should (equal (string-clean-whitespace " foo \r\n\t Bar") "foo Bar"))) + +(ert-deftest subr-string-fill () + (should (equal (string-fill "foo" 10) "foo")) + (should (equal (string-fill "foobar" 5) "foobar")) + (should (equal (string-fill "foo bar zot" 5) "foo\nbar\nzot")) + (should (equal (string-fill "foo bar zot" 7) "foo bar\nzot"))) + +(ert-deftest subr-string-limit () + (should (equal (string-limit "foo" 10) "foo")) + (should (equal (string-limit "foo" 2) "fo")) + (should (equal (string-limit "foo" 2 t) "oo")) + (should (equal (string-limit "abc" 10 t) "abc")) + (should (equal (string-limit "foo" 0) "")) + (should-error (string-limit "foo" -1))) + +(ert-deftest subr-string-lines () + (should (equal (string-lines "foo") '("foo"))) + (should (equal (string-lines "foo \nbar") '("foo " "bar")))) + +(ert-deftest subr-string-slice () + (should (equal (string-slice "foo-bar" "-") '("foo" "-bar"))) + (should (equal (string-slice "foo-bar-" "-") '("foo" "-bar" "-"))) + (should (equal (string-slice "-foo-bar-" "-") '("-foo" "-bar" "-"))) + (should (equal (string-slice "ooo" "lala") '("ooo"))) + (should (equal (string-slice "foo bar" "\\b") '("foo" " " "bar" ""))) + (should (equal (string-slice "foo bar" "\\b\\|a") '("foo" " " "b" "ar" "")))) + +(ert-deftest subr-string-pad () + (should (equal (string-pad "foo" 5) "foo ")) + (should (equal (string-pad "foo" 5 ?-) "foo--")) + (should (equal (string-pad "foo" 5 ?- t) "--foo")) + (should (equal (string-pad "foo" 2 ?-) "foo"))) + +(ert-deftest subr-string-chop-newline () + (should (equal (string-chop-newline "foo\n") "foo")) + (should (equal (string-chop-newline "foo\nbar\n") "foo\nbar")) + (should (equal (string-chop-newline "foo\nbar") "foo\nbar"))) + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index 038f9d0e304..e220d09dada 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -52,8 +52,8 @@ (should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 1 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 1 locs)))) - (should (equal 0 (xref-file-location-column (nth 0 locs)))) - (should (equal 4 (xref-file-location-column (nth 1 locs)))))) + (should (equal 0 (xref-location-column (nth 0 locs)))) + (should (equal 4 (xref-location-column (nth 1 locs)))))) (ert-deftest xref-matches-in-directory-finds-an-empty-line-regexp-match () (let* ((matches (xref-matches-in-directory "^$" "*" xref-tests-data-dir nil)) @@ -61,7 +61,7 @@ (should (= 1 (length matches))) (should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) - (should (equal 0 (xref-file-location-column (nth 0 locs)))))) + (should (equal 0 (xref-location-column (nth 0 locs)))))) (ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 () (let* ((xrefs (xref-matches-in-directory "foo" "*" xref-tests-data-dir nil)) diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index ed381d151ee..8d46abf342a 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -155,3 +155,9 @@ Also check that an encoding error can appear in a symlink." (write-region "hello\n" nil f nil 'silent) (should-error (insert-file-contents f) :type 'circular-list) (delete-file f))) + +(ert-deftest fileio-tests/null-character () + (should-error (file-exists-p "/foo\0bar") + :type 'wrong-type-argument)) + +;;; fileio-tests.el ends here |