[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp b99a474: Merge remote-tracking branch 'savannah/mast
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp b99a474: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Wed, 23 Dec 2020 14:00:02 -0500 (EST) |
branch: feature/native-comp
commit b99a4744822a11e4af098b63db18f54a4e323d58
Merge: ffcd490 40bc77d
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
.clang-format | 2 +-
doc/lispref/debugging.texi | 13 +-
doc/lispref/strings.texi | 50 +++++++
etc/NEWS | 17 +++
lisp/cedet/ede/proj-elisp.el | 3 +-
lisp/emacs-lisp/shortdoc.el | 26 ++++
lisp/emacs-lisp/subr-x.el | 85 ++++++++++++
lisp/gnus/gnus-search.el | 5 +-
lisp/gnus/gnus-sum.el | 1 +
lisp/image-mode.el | 11 ++
lisp/net/shr.el | 5 +-
lisp/net/tramp-sh.el | 2 +-
lisp/net/tramp.el | 4 -
lisp/net/trampver.el | 12 +-
lisp/profiler.el | 34 +++--
lisp/progmodes/python.el | 96 ++++++++++----
lisp/progmodes/ruby-mode.el | 35 ++---
lisp/progmodes/xref.el | 28 +++-
lisp/server.el | 6 +-
lisp/wdired.el | 5 +-
src/alloc.c | 2 +-
src/callproc.c | 246 ++++++++++++++++++-----------------
src/coding.c | 18 ++-
src/fileio.c | 2 +-
src/image.c | 2 +-
src/lisp.h | 4 +-
src/nsfns.m | 8 +-
src/nsfont.m | 7 +-
src/nsimage.m | 4 +-
src/nsmenu.m | 2 +-
src/nsselect.m | 10 +-
src/nsterm.m | 10 +-
src/nsxwidget.m | 19 +--
src/pdumper.c | 2 +-
src/process.c | 14 +-
src/xterm.c | 9 +-
test/lisp/emacs-lisp/subr-x-tests.el | 41 ++++++
test/lisp/progmodes/xref-tests.el | 6 +-
test/src/fileio-tests.el | 6 +
39 files changed, 593 insertions(+), 259 deletions(-)
diff --git a/.clang-format b/.clang-format
index 7895ada..9ab09a8 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 3fea604..661961f 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 0f157c3..ef848ac 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
diff --git a/etc/NEWS b/etc/NEWS
index 332f846..556fc39 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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 bcd6721..9847a36 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 37d6170..0067495 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 e6abb39..7e17a34 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 16f3a02..3a3722c 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 a0e7173..38edc77 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 465bf86..143b68f 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 2e5dd5f..1648e56 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 e6e718e..0dbcb83 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 4d8118a..0260569 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 d6b582e..30e5ba8 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 bf8aacc..1c84372 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 d58b32f..50bb841 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 8cb0350..45b0f84 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 6e99e9d..181f94b 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 7773da0..d1183b9 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 b7dd4ee..c2e1d0c 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 22f37b0..2515362 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 4bca1e5..c7f560a 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 1afa4aa..8c24438 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 51f12e1..651e765 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 d0ae44e..29cd189 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 7dc517b..103ed07 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 c795649..f3c5a9e 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 378a640..9e4caca 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 f9fb368..c47a2b2 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 a286a80..efad978 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 7b1937f..95fce4d 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 7972fa4..2a117a0 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 dbd4cb2..915fd8b 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 b3abbd6..ae5bbef 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 9efefb1..15b4a23 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 3de0d2e..7f8728e 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 9d14a5a..3fc5f1d 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 038f9d0..e220d09 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 ed381d1..8d46abf 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