[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android a61c5fb9a21: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android a61c5fb9a21: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Wed, 21 Jun 2023 21:02:49 -0400 (EDT) |
branch: feature/android
commit a61c5fb9a212ca0bcfcca5d1652bd9d7841d95bd
Merge: bdaeecd1759 72f1c12e58e
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
configure.ac | 2 +-
doc/lispref/searching.texi | 6 +-
doc/misc/cc-mode.texi | 10 +
doc/misc/tramp.texi | 18 +-
etc/NEWS | 13 +-
lisp/emacs-lisp/byte-opt.el | 8 +-
lisp/emacs-lisp/subr-x.el | 5 -
lisp/kmacro.el | 13 +-
lisp/net/tramp.el | 11 +-
lisp/progmodes/cc-align.el | 10 +
lisp/progmodes/cc-defs.el | 26 +-
lisp/progmodes/cc-engine.el | 378 ++++++++++---
lisp/progmodes/cc-fonts.el | 4 +-
lisp/progmodes/cc-langs.el | 4 +
lisp/progmodes/cc-mode.el | 7 +-
lisp/progmodes/cc-vars.el | 3 +-
lisp/progmodes/elisp-mode.el | 3 +
lisp/startup.el | 28 +-
src/nsterm.m | 2 +-
src/pgtkfns.c | 7 +-
src/regex-emacs.c | 15 +-
test/lisp/emacs-lisp/bytecomp-tests.el | 4 +
test/lisp/emacs-lisp/edebug-tests.el | 1 +
test/lisp/net/tramp-tests.el | 990 +++++++++++++++++++--------------
test/src/regex-emacs-tests.el | 66 +++
25 files changed, 1073 insertions(+), 561 deletions(-)
diff --git a/configure.ac b/configure.ac
index 7454e201c3f..60d02963da8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1725,7 +1725,7 @@ AS_IF([test $gl_gcc_warnings = no],
nw="$nw -Wcast-align=strict" # Emacs is tricky with pointers.
nw="$nw -Wduplicated-branches" # Too many false alarms
- nw="$nw -Wformat-overflow=2" # False alarms due to GCC bug 80776
+ nw="$nw -Wformat-overflow=2" # False alarms due to GCC bug 110333
nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings
nw="$nw -Woverlength-strings" # Not a problem these days
nw="$nw -Wvla" # Emacs uses <vla.h>.
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 28230cea643..7c9893054d9 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -546,15 +546,11 @@ example, the regular expression that matches the @samp{\}
character is
For historical compatibility, a repetition operator is treated as ordinary
if it appears at the start of a regular expression
-or after @samp{^}, @samp{\(}, @samp{\(?:} or @samp{\|}.
+or after @samp{^}, @samp{\`}, @samp{\(}, @samp{\(?:} or @samp{\|}.
For example, @samp{*foo} is treated as @samp{\*foo}, and
@samp{two\|^\@{2\@}} is treated as @samp{two\|^@{2@}}.
It is poor practice to depend on this behavior; use proper backslash
escaping anyway, regardless of where the repetition operator appears.
-Also, a repetition operator should not immediately follow a backslash escape
-that matches only empty strings, as Emacs has bugs in this area.
-For example, it is unwise to use @samp{\b*}, which can be omitted
-without changing the documented meaning of the regular expression.
As a @samp{\} is not special inside a bracket expression, it can
never remove the special meaning of @samp{-}, @samp{^} or @samp{]}.
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 4ac9cc3ca2d..5f905be09d5 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -6252,6 +6252,16 @@ returned if there's no template argument on the first
line.
@comment ------------------------------------------------------------
+@defun c-lineup-template-args-indented-from-margin
+@findex lineup-template-args-indented-from-margin (c-)
+Indent a template argument line `c-basic-offset' from the left-hand
+margin of the line with the containing <.
+
+@workswith @code{template-args-cont}.
+@end defun
+
+@comment ------------------------------------------------------------
+
@defun c-lineup-ObjC-method-call
@findex lineup-ObjC-method-call @r{(c-)}
For Objective-C code, line up selector args as Emacs Lisp mode does
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index a854c15f2b3..eb5c418728e 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3644,10 +3644,20 @@ Each involved method must be an inline method
(@pxref{Inline methods}).
@code{tramp-default-proxies-alist} and is available for re-use during
that Emacs session. Subsequent @value{tramp} connections to the same
remote host can then use the shortcut form:
-@samp{@trampfn{ssh,you@@remotehost,/path}}. Ad-hoc definitions are
-removed from @code{tramp-default-proxies-alist} via the command
-@kbd{M-x tramp-cleanup-all-connections @key{RET}} (@pxref{Cleanup
-remote connections}).
+@samp{@trampfn{ssh,you@@remotehost,/path}}.
+
+@defopt tramp-show-ad-hoc-proxies
+If this user option is non-@code{nil}, ad-hoc definitions are kept in
+remote file names instead of showing the shortcuts.
+
+@lisp
+(customize-set-variable 'tramp-show-ad-hoc-proxies t)
+@end lisp
+@end defopt
+
+Ad-hoc definitions are removed from @code{tramp-default-proxies-alist}
+via the command @kbd{M-x tramp-cleanup-all-connections @key{RET}}
+(@pxref{Cleanup remote connections}).
@defopt tramp-save-ad-hoc-proxies
For ad-hoc definitions to be saved automatically in
diff --git a/etc/NEWS b/etc/NEWS
index 9d0e63f24d2..08bf7599274 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -492,6 +492,14 @@ symbol, and either that symbol is ':eval' and the second
element of
the list evaluates to 'nil' or the symbol's value as a variable is
'nil' or void.
++++
+** Regexp zero-width assertions followed by operators are better defined.
+Previously, regexps such as "xy\\B*" would have ill-defined behaviour.
+Now any operator following a zero-width assertion applies to that
+assertion only (which is useless). For historical compatibility, an
+operator character following '^' or '\`' becomes literal, but we
+advise against relying on this.
+
* Lisp Changes in Emacs 30.1
@@ -707,11 +715,6 @@ Since circular alias chains now cannot occur,
'function-alias-p',
'indirect-function' and 'indirect-variable' will never signal an error.
Their 'noerror' arguments have no effect and are therefore obsolete.
----
-** New function 'eval-command-interactive-spec' in the subr-x library.
-This function evaluates a command's interactive form and returns the
-resultant list.
-
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index f64674d5a6c..307e3841e9b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -873,7 +873,13 @@ for speeding up processing.")
(cons accum args))
(defun byte-optimize-plus (form)
- (let ((args (remq 0 (byte-opt--arith-reduce #'+ 0 (cdr form)))))
+ (let* ((not-0 (remq 0 (byte-opt--arith-reduce #'+ 0 (cdr form))))
+ (args (if (and (= (length not-0) 1)
+ (> (length form) 2))
+ ;; We removed numbers and only one arg remains: add a 0
+ ;; so that it isn't turned into (* X 1) later on.
+ (append not-0 '(0))
+ not-0)))
(cond
;; (+) -> 0
((null args) 0)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 38f85c242c7..9e906930b92 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -504,11 +504,6 @@ Used by `emacs-authors-mode' and `emacs-news-mode'."
(progn (forward-line -1) (point))
(point-max)))))
-(defun eval-command-interactive-spec (command)
- "Evaluate COMMAND's interactive form and return resultant list.
-If COMMAND has no interactive form, return nil."
- (advice-eval-interactive-spec (cadr (interactive-form command))))
-
(provide 'subr-x)
;;; subr-x.el ends here
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 64aa7a27bde..7489076ea2e 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -504,8 +504,9 @@ ARG is the number of times to execute the item.")
(defun kmacro-call-ring-2nd (arg)
- "Execute second keyboard macro in macro ring."
- (interactive "P")
+ "Execute second keyboard macro in macro ring.
+With numeric argument ARG, execute the macro that many times."
+ (interactive "p")
(unless (kmacro-ring-empty-p)
(funcall (car kmacro-ring) arg)))
@@ -514,7 +515,7 @@ ARG is the number of times to execute the item.")
"Execute second keyboard macro in macro ring.
This is like `kmacro-call-ring-2nd', but allows repeating macro commands
without repeating the prefix."
- (interactive "P")
+ (interactive "p")
(let ((keys (kmacro-get-repeat-prefix)))
(kmacro-call-ring-2nd arg)
(if (and kmacro-ring keys)
@@ -650,10 +651,10 @@ The macro is now available for use via
\\[kmacro-call-macro],
or it can be given a name with \\[kmacro-name-last-macro] and then invoked
under that name.
-With numeric arg, repeat macro now that many times,
+With numeric ARG, repeat the macro that many times,
counting the definition just completed as the first repetition.
An argument of zero means repeat until error."
- (interactive "P")
+ (interactive "p")
;; Isearch may push the kmacro-end-macro key sequence onto the macro.
;; Just ignore it when executing the macro.
(unless executing-kbd-macro
@@ -787,7 +788,7 @@ Zero argument means repeat until there is an error.
To give a macro a name, so you can call it even after defining other
macros, use \\[kmacro-name-last-macro]."
- (interactive "P")
+ (interactive "p")
(if defining-kbd-macro
(kmacro-end-macro nil))
(kmacro-call-macro arg no-repeat))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7849f81aebe..b98dff3b536 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -525,6 +525,11 @@ interpreted as a regular expression which always matches."
:version "24.3"
:type 'boolean)
+(defcustom tramp-show-ad-hoc-proxies nil
+ "Whether to show ad-hoc proxies in file names."
+ :version "29.2"
+ :type 'boolean)
+
;; For some obscure technical reasons, `system-name' on w32 returns
;; either lower case or upper case letters. See
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
@@ -1807,8 +1812,8 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
(when (cadr args)
(setq localname (and (stringp (cadr args)) (cadr args))))
(when hop
- ;; Keep hop in file name for completion.
- (unless minibuffer-completing-file-name
+ ;; Keep hop in file name for completion or when indicated.
+ (unless (or minibuffer-completing-file-name tramp-show-ad-hoc-proxies)
(setq hop nil))
;; Assure that the hops are in `tramp-default-proxies-alist'.
;; In tramp-archive.el, the slot `hop' is used for the archive
@@ -1858,7 +1863,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
(replace-regexp-in-string
(rx (regexp tramp-postfix-host-regexp) eos)
tramp-postfix-hop-format
- (tramp-make-tramp-file-name vec 'noloc)))))
+ (tramp-make-tramp-file-name (tramp-file-name-unify vec))))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
"Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME.
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 34ef0b9c1af..91a7665edbb 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -940,6 +940,16 @@ Works with: template-args-cont."
(zerop (c-forward-token-2 1 nil (c-point 'eol))))
(vector (current-column)))))
+(defun c-lineup-template-args-indented-from-margin (_langelem)
+ "Indent a template argument line `c-basic-offset' from the margin
+of the line with the containing <.
+
+Works with: template-args-cont."
+ (save-excursion
+ (goto-char (c-langelem-2nd-pos c-syntactic-element))
+ (back-to-indentation)
+ (vector (+ (current-column) c-basic-offset))))
+
(defun c-lineup-ObjC-method-call (langelem)
"Line up selector args as Emacs Lisp mode does with function args:
Go to the position right after the message receiver, and if you are at
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 1d98b215525..f9b63cbeed6 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1284,6 +1284,29 @@ MODE is either a mode symbol or a list of mode symbols."
pos)
(most-positive-fixnum))))
+(defmacro c-put-char-properties (from to property value)
+ ;; FIXME!!! Doc comment here!
+ (declare (debug t))
+ (setq property (eval property))
+ `(let ((-to- ,to) (-from- ,from))
+ ,(if c-use-extents
+ ;; XEmacs
+ `(progn
+ (map-extents (lambda (ext ignored)
+ (delete-extent ext))
+ nil -from- -to- nil nil ',property)
+ (set-extent-properties (make-extent -from- -to-)
+ (cons property
+ (cons ,value
+ '(start-open t
+ end-open t)))))
+ ;; Emacs
+ `(progn
+ ,@(when (and (fboundp 'syntax-ppss)
+ (eq `,property 'syntax-table))
+ `((setq c-syntax-table-hwm (min c-syntax-table-hwm -from-))))
+ (put-text-property -from- -to- ',property ,value)))))
+
(defmacro c-clear-char-properties (from to property)
;; Remove all the occurrences of the given property in the given
;; region that has been put with `c-put-char-property'. PROPERTY is
@@ -1379,7 +1402,8 @@ isn't found, return nil; point is then left undefined."
value)
(t (let ((place (c-next-single-property-change
(point) ,property nil -limit-)))
- (when place
+ (when (and place
+ (< place -limit-))
(goto-char (1+ place))
(c-get-char-property place ,property)))))))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 66cfd3dee9e..0eadeafc836 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -2672,6 +2672,7 @@ comment at the start of cc-engine.el for more info."
(progn (goto-char beg)
(c-skip-ws-forward end+1)
(eq (point) end+1))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We maintain a sopisticated cache of positions which are in a literal,
@@ -7039,8 +7040,8 @@ comment at the start of cc-engine.el for more info."
;; POS (default point) is at a < character. If it is both marked
;; with open/close paren syntax-table property, and has a matching >
;; (also marked) which is after LIM, remove the property both from
- ;; the current > and its partner. Return t when this happens, nil
- ;; when it doesn't.
+ ;; the current > and its partner. Return the position after the >
+ ;; when this happens, nil when it doesn't.
(save-excursion
(if pos
(goto-char pos)
@@ -7054,15 +7055,15 @@ comment at the start of cc-engine.el for more info."
c->-as-paren-syntax)) ; should always be true.
(c-unmark-<->-as-paren (1- (point)))
(c-unmark-<->-as-paren pos)
- (c-truncate-lit-pos-cache pos))
- t)))
+ (c-truncate-lit-pos-cache pos)
+ (point)))))
(defun c-clear->-pair-props-if-match-before (lim &optional pos)
;; POS (default point) is at a > character. If it is both marked
;; with open/close paren syntax-table property, and has a matching <
;; (also marked) which is before LIM, remove the property both from
- ;; the current < and its partner. Return t when this happens, nil
- ;; when it doesn't.
+ ;; the current < and its partner. Return the position of the < when
+ ;; this happens, nil when it doesn't.
(save-excursion
(if pos
(goto-char pos)
@@ -7076,8 +7077,8 @@ comment at the start of cc-engine.el for more info."
c-<-as-paren-syntax)) ; should always be true.
(c-unmark-<->-as-paren (point))
(c-truncate-lit-pos-cache (point))
- (c-unmark-<->-as-paren pos))
- t)))
+ (c-unmark-<->-as-paren pos)
+ (point)))))
;; Set by c-common-init in cc-mode.el.
(defvar c-new-BEG)
@@ -7085,7 +7086,48 @@ comment at the start of cc-engine.el for more info."
;; Set by c-before-change-check-raw-strings.
(defvar c-old-END-literality)
-(defun c-before-change-check-<>-operators (beg end)
+(defun c-end-of-literal (pt-s pt-search)
+ ;; If a literal is open in the `c-semi-pp-to-literal' state PT-S, return the
+ ;; end point of this literal (or point-max) assuming PT-S is valid at
+ ;; PT-SEARCH. Otherwise, return nil.
+ (when (car (cddr pt-s)) ; Literal start
+ (let ((lit-type (cadr pt-s))
+ (lit-beg (car (cddr pt-s)))
+ ml-end-re
+ )
+ (save-excursion
+ (cond
+ ((eq lit-type 'string)
+ (if (and c-ml-string-opener-re
+ (c-ml-string-opener-at-or-around-point lit-beg))
+ (progn
+ (setq ml-end-re
+ (funcall c-make-ml-string-closer-re-function
+ (match-string 1)))
+ (goto-char (max (- pt-search (1- (length ml-end-re)))
+ (point-min)))
+ (re-search-forward ml-end-re nil 'stay))
+ ;; For an ordinary string, we can't use `parse-partial-sexp' since
+ ;; not all syntax-table properties have yet been set.
+ (goto-char pt-search)
+ (re-search-forward
+ "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\"\n\\]\\)*[\"\n]" nil 'stay)))
+ ((memq lit-type '(c c++))
+ ;; To work around a bug in parse-partial-sexp, where effect is given
+ ;; to the syntax of a backslash, even the the scan starts with point
+ ;; just after it.
+ (if (and (eq (char-before pt-search) ?\\)
+ (eq (char-after pt-search) ?\n))
+ (progn
+ (c-put-char-property (1- pt-search) 'syntax-table '(1))
+ (parse-partial-sexp pt-search (point-max) nil nil (car pt-s)
+ 'syntax-table)
+ (c-clear-char-property (1- pt-search) 'syntax-table))
+ (parse-partial-sexp pt-search (point-max) nil nil (car pt-s)
+ 'syntax-table))))
+ (point)))))
+
+(defun c-unmark-<>-around-region (beg end &optional old-len)
;; Unmark certain pairs of "< .... >" which are currently marked as
;; template/generic delimiters. (This marking is via syntax-table text
;; properties), and expand the (c-new-BEG c-new-END) region to include all
@@ -7099,66 +7141,201 @@ comment at the start of cc-engine.el for more info."
;; enclose a brace or semicolon, so we use these as bounds on the
;; region we must work on.
;;
+ ;; The buffer is widened, and point is undefined, both at entry and exit.
+ ;;
+ ;; FIXME!!! This routine ignores the possibility of macros entirely.
+ ;; 2010-01-29.
+
+ (when (> end beg)
+ ;; Extend the region (BEG END) to deal with any complicating literals.
+ (let* ((lit-search-beg (if (memq (char-before beg) '(?/ ?*))
+ (1- beg) beg))
+ (lit-search-end (if (memq (char-after end) '(?/ ?*))
+ (1+ end) end))
+ ;; Note we can't use c-full-pp-to-literal here, since we haven't
+ ;; yet applied syntax-table properties to ends of lines, etc.
+ (lit-search-beg-s (c-semi-pp-to-literal lit-search-beg))
+ (beg-literal-beg (car (cddr lit-search-beg-s)))
+ (lit-search-end-s (c-semi-pp-to-literal lit-search-end))
+ (end-literal-beg (car (cddr lit-search-end-s)))
+ (beg-literal-end (c-end-of-literal lit-search-beg-s beg))
+ (end-literal-end (c-end-of-literal lit-search-end-s end))
+ new-beg new-end search-region)
+
+ ;; Determine any new end of literal resulting from the
insertion/deletion.
+ (setq search-region
+ (if (and (eq beg-literal-beg end-literal-beg)
+ (eq beg-literal-end end-literal-end))
+ (if beg-literal-beg
+ nil
+ (cons beg
+ (max end
+ (or beg-literal-end (point-min))
+ (or end-literal-end (point-min)))))
+ (cons (or beg-literal-beg beg)
+ (max end
+ (or beg-literal-end (point-min))
+ (or end-literal-end (point-min))))))
+
+ (when search-region
+ ;; If we've just inserted text, mask its syntaxes temporarily so that
+ ;; they won't interfere with the undoing of the properties on the <s
+ ;; and >s.
+ (c-save-buffer-state (syn-tab-settings syn-tab-value
+ swap-open-string-ends)
+ (unwind-protect
+ (progn
+ (when old-len
+ ;; Special case: If a \ has just been inserted into a
+ ;; string, escaping or unescaping a LF, temporarily swap
+ ;; the LF's syntax-table text property with that of the
+ ;; former end of the open string.
+ (goto-char end)
+ (when (and (eq (cadr lit-search-beg-s) 'string)
+ (not (eq beg-literal-end end-literal-end))
+ (skip-chars-forward "\\\\")
+ (eq (char-after) ?\n)
+ (not (zerop (skip-chars-backward "\\\\"))))
+ (setq swap-open-string-ends t)
+ (if (c-get-char-property (1- beg-literal-end)
+ 'syntax-table)
+ (progn
+ (c-clear-char-property (1- beg-literal-end)
+ 'syntax-table)
+ (c-put-char-property (1- end-literal-end)
+ 'syntax-table '(15)))
+ (c-put-char-property (1- beg-literal-end)
+ 'syntax-table '(15))
+ (c-clear-char-property (1- end-literal-end)
+ 'syntax-table)))
+
+ ;; Save current settings of the 'syntax-table property in
+ ;; (BEG END), then splat these with the punctuation value.
+ (goto-char beg)
+ (while (progn (skip-syntax-forward "" end)
+ (< (point) end))
+ (setq syn-tab-value
+ (c-get-char-property (point) 'syntax-table))
+ (when (not (c-get-char-property (point) 'category))
+ (push (cons (point) syn-tab-value) syn-tab-settings))
+ (forward-char))
+
+ (c-put-char-properties beg end 'syntax-table '(1))
+ ;; If an open string's opener has just been neutralized,
+ ;; do the same to the terminating LF.
+ (when (and end-literal-end
+ (eq (char-before end-literal-end) ?\n)
+ (equal (c-get-char-property
+ (1- end-literal-end) 'syntax-table)
+ '(15)))
+ (push (cons (1- end-literal-end) '(15)) syn-tab-settings)
+ (c-put-char-property (1- end-literal-end) 'syntax-table
+ '(1))))
+
+ (let
+ ((beg-lit-start (progn (goto-char beg) (c-literal-start)))
+ beg-limit end-limit <>-pos)
+ ;; Locate the earliest < after the barrier before the
+ ;; changed region, which isn't already marked as a paren.
+ (goto-char (or beg-lit-start beg))
+ (setq beg-limit (c-determine-limit 5000))
+
+ ;; Remove the syntax-table/category properties from each
pertinent <...>
+ ;; pair. Firstly, the ones with the < before beg and > after
beg....
+ (goto-char (cdr search-region))
+ (while (progn (c-syntactic-skip-backward "^;{}<" beg-limit)
+ (eq (char-before) ?<))
+ (c-backward-token-2)
+ (when (eq (char-after) ?<)
+ (when (setq <>-pos (c-clear-<-pair-props-if-match-after
+ (car search-region)))
+ (setq new-end <>-pos))
+ (setq new-beg (point))))
+
+ ;; ...Then the ones with < before end and > after end.
+ (goto-char (car search-region))
+ (setq end-limit (c-determine-+ve-limit 5000))
+ (while (and (c-syntactic-re-search-forward "[;{}>]" end-limit
'end)
+ (eq (char-before) ?>))
+ (when (eq (char-before) ?>)
+ (if (and (looking-at c->-op-cont-regexp)
+ (not (eq (char-after) ?>)))
+ (goto-char (match-end 0))
+ (when
+ (and (setq <>-pos
+ (c-clear->-pair-props-if-match-before
+ (cdr search-region)
+ (1- (point))))
+ (or (not new-beg)
+ (< <>-pos new-beg)))
+ (setq new-beg <>-pos))
+ (when (or (not new-end) (> (point) new-end))
+ (setq new-end (point))))))))
+
+ (when old-len
+ (c-clear-char-properties beg end 'syntax-table)
+ (dolist (elt syn-tab-settings)
+ (if (cdr elt)
+ (c-put-char-property (car elt) 'syntax-table (cdr elt)))))
+ ;; Swap the '(15) syntax-table property on open string LFs back
+ ;; again.
+ (when swap-open-string-ends
+ (if (c-get-char-property (1- beg-literal-end)
+ 'syntax-table)
+ (progn
+ (c-clear-char-property (1- beg-literal-end)
+ 'syntax-table)
+ (c-put-char-property (1- end-literal-end)
+ 'syntax-table '(15)))
+ (c-put-char-property (1- beg-literal-end)
+ 'syntax-table '(15))
+ (c-clear-char-property (1- end-literal-end)
+ 'syntax-table)))))
+ ;; Extend the fontification region, if needed.
+ (and new-beg
+ (< new-beg c-new-BEG)
+ (setq c-new-BEG new-beg))
+ (and new-end
+ (> new-end c-new-END)
+ (setq c-new-END new-end))))))
+
+(defun c-before-change-check-<>-operators (beg end)
+ ;; When we're deleting text, unmark certain pairs of "< .... >" which are
+ ;; currently marked as template/generic delimiters. (This marking is via
+ ;; syntax-table text properties), and expand the (c-new-BEG c-new-END)
+ ;; region to include all unmarked < and > operators within the certain
+ ;; bounds (see below).
+ ;;
+ ;; These pairs are those which are in the current "statement" (i.e.,
+ ;; the region between the {, }, or ; before BEG and the one after
+ ;; END), and which enclose any part of the interval (BEG END).
+ ;; Also unmark a < or > which is about to become part of a multi-character
+ ;; operator, e.g. <=.
+ ;;
+ ;; Note that in C++ (?and Java), template/generic parens cannot
+ ;; enclose a brace or semicolon, so we use these as bounds on the
+ ;; region we must work on.
+ ;;
;; This function is called from before-change-functions (via
;; c-get-state-before-change-functions). Thus the buffer is widened,
;; and point is undefined, both at entry and exit.
;;
;; FIXME!!! This routine ignores the possibility of macros entirely.
;; 2010-01-29.
- (when (and (or (> end beg)
- (and (> c-<-pseudo-digraph-cont-len 0)
- (goto-char beg)
- (progn
- (skip-chars-backward
- "^<" (max (- (point) c-<-pseudo-digraph-cont-len)
- (point-min)))
- (eq (char-before) ?<))
- (looking-at c-<-pseudo-digraph-cont-regexp)))
- (or
- (progn
- (goto-char beg)
- (search-backward "<" (max (- (point) 1024) (point-min)) t))
- (progn
- (goto-char end)
- (search-forward ">" (min (+ (point) 1024) (point-max)) t))))
- (save-excursion
- (c-save-buffer-state
- ((beg-lit-start (progn (goto-char beg) (c-literal-start)))
- (end-lit-limits (progn (goto-char end) (c-literal-limits)))
- new-beg new-end beg-limit end-limit)
- ;; Locate the earliest < after the barrier before the changed region,
- ;; which isn't already marked as a paren.
- (goto-char (or beg-lit-start beg))
- (setq beg-limit (c-determine-limit 512))
-
- ;; Remove the syntax-table/category properties from each pertinent <...>
- ;; pair. Firstly, the ones with the < before beg and > after beg....
- (while (progn (c-syntactic-skip-backward "^;{}<" beg-limit)
- (eq (char-before) ?<))
- (c-backward-token-2)
- (when (eq (char-after) ?<)
- (c-clear-<-pair-props-if-match-after beg)
- (setq new-beg (point))))
- (c-forward-syntactic-ws)
-
- ;; ...Then the ones with < before end and > after end.
- (goto-char (if end-lit-limits (cdr end-lit-limits) end))
- (setq end-limit (c-determine-+ve-limit 512))
- (while (and (c-syntactic-re-search-forward "[;{}>]" end-limit 'end)
- (eq (char-before) ?>))
- (c-end-of-current-token)
- (when (eq (char-before) ?>)
- (c-clear->-pair-props-if-match-before end (1- (point)))
- (setq new-end (point))))
- (c-backward-syntactic-ws)
-
- ;; Extend the fontification region, if needed.
- (and new-beg
- (< new-beg c-new-BEG)
- (setq c-new-BEG new-beg))
- (and new-end
- (> new-end c-new-END)
- (setq c-new-END new-end))))))
+ (when (> end beg)
+ ;; Cope with removing (beg end) coalescing a < or > with, say, an = sign.
+ (goto-char beg)
+ (let ((ch (char-before)))
+ (if (and (memq ch '(?< ?>))
+ (c-get-char-property (1- (point)) 'syntax-table)
+ (progn
+ (goto-char end)
+ (looking-at (if (eq ch ?<)
+ c-<-op-cont-regexp
+ c->-op-cont-regexp)))
+ (or (eq ch ?<)
+ (not (eq (char-after) ?>))))
+ (c-unmark-<>-around-region (1- beg) beg)))))
(defun c-after-change-check-<>-operators (beg end)
;; This is called from `after-change-functions' when
@@ -7198,29 +7375,38 @@ comment at the start of cc-engine.el for more info."
(c-clear-<>-pair-props)
(forward-char)))))))
+(defun c-<>-get-restricted ()
+ ;; With point at the < at the start of the purported <>-arglist, determine
+ ;; the value of `c-restricted-<>-arglists' to use for the call of
+ ;; `c-forward-<>-arglist' starting there.
+ (save-excursion
+ (c-backward-token-2)
+ (and (not (looking-at c-opt-<>-sexp-key))
+ (progn (c-backward-syntactic-ws) ; to ( or ,
+ (and (memq (char-before) '(?\( ?,)) ; what about <?
+ (not (eq (c-get-char-property (point) 'c-type)
+ 'c-decl-arg-start)))))))
+
(defun c-restore-<>-properties (_beg _end _old-len)
;; This function is called as an after-change function. It restores the
;; category/syntax-table properties on template/generic <..> pairs between
;; c-new-BEG and c-new-END. It may do hidden buffer changes.
- (c-save-buffer-state ((c-parse-and-markup-<>-arglists t)
- c-restricted-<>-arglists lit-limits)
+ (c-save-buffer-state ((c-parse-and-markup-<>-arglists t) lit-limits)
(goto-char c-new-BEG)
(if (setq lit-limits (c-literal-limits))
(goto-char (cdr lit-limits)))
(while (and (< (point) c-new-END)
- (c-syntactic-re-search-forward "<" c-new-END 'bound))
- (backward-char)
- (save-excursion
- (c-backward-token-2)
- (setq c-restricted-<>-arglists
- (and (not (looking-at c-opt-<>-sexp-key))
- (progn (c-backward-syntactic-ws) ; to ( or ,
- (and (memq (char-before) '(?\( ?,)) ; what about <?
- (not (eq (c-get-char-property (point) 'c-type)
- 'c-decl-arg-start)))))))
- (or (c-forward-<>-arglist nil)
- (c-forward-over-token-and-ws)
- (goto-char c-new-END)))))
+ (c-syntactic-re-search-forward "[<>]" c-new-END 'bound))
+ (if (eq (char-before) ?<)
+ (progn
+ (backward-char)
+ (let ((c-restricted-<>-arglists (c-<>-get-restricted)))
+ (or (c-forward-<>-arglist nil)
+ (c-forward-over-token-and-ws)
+ (goto-char c-new-END))))
+ (save-excursion
+ (when (c-backward-<>-arglist nil nil #'c-<>-get-restricted)
+ (setq c-new-BEG (min c-new-BEG (point)))))))))
;; Handling of CC Mode multi-line strings.
@@ -7372,13 +7558,13 @@ multi-line strings (but not C++, for example)."
(defun c-ml-string-opener-intersects-region (&optional start finish)
;; If any part of the region [START FINISH] is inside an ml-string opener,
- ;; return a dotted list of the start, end and double-quote position of that
- ;; opener. That list will not include any "context characters" before or
- ;; after the opener. If an opener is found, the match-data will indicate
- ;; it, with (match-string 1) being the entire delimiter, and (match-string
- ;; 2) the "main" double-quote. Otherwise, the match-data is undefined.
- ;; Both START and FINISH default to point. FINISH may not be at an earlier
- ;; buffer position than START.
+ ;; return a dotted list of the start, end and double-quote position of the
+ ;; first such opener. That list wlll not include any "context characters"
+ ;; before or after the opener. If an opener is found, the match-data will
+ ;; indicate it, with (match-string 1) being the entire delimiter, and
+ ;; (match-string 2) the "main" double-quote. Otherwise, the match-data is
+ ;; undefined. Both START and FINISH default to point. FINISH may not be at
+ ;; an earlier buffer position than START.
(let ((here (point)) found)
(or finish (setq finish (point)))
(or start (setq start (point)))
@@ -7402,7 +7588,10 @@ multi-line strings (but not C++, for example)."
;; If POSITION (default point) is at or inside an ml string opener, return a
;; dotted list of the start and end of that opener, and the position of the
;; double-quote in it. That list will not include any "context characters"
- ;; before or after the opener.
+ ;; before or after the opener. If an opener is found, the match-data will
+ ;; indicate it, with (match-string 1) being the entire delimiter, and
+ ;; (match-string 2) the "main" double-quote. Otherwise, the match-data is
+ ;; undefined.
(let ((here (point))
found)
(or position (setq position (point)))
@@ -7414,7 +7603,7 @@ multi-line strings (but not C++, for example)."
c-ml-string-opener-re
(min (+ position c-ml-string-max-opener-len) (point-max))
'bound))
- (<= (match-end 1) position)))
+ (< (match-end 1) position)))
(prog1
(and found
(<= (match-beginning 1) position)
@@ -8821,7 +9010,7 @@ multi-line strings (but not C++, for example)."
(if res
(or c-record-found-types t)))))
-(defun c-backward-<>-arglist (all-types &optional limit)
+(defun c-backward-<>-arglist (all-types &optional limit restricted-function)
;; The point is assumed to be directly after a ">". Try to treat it
;; as the close paren of an angle bracket arglist and move back to
;; the corresponding "<". If successful, the point is left at
@@ -8830,7 +9019,12 @@ multi-line strings (but not C++, for example)."
;; `c-forward-<>-arglist'.
;;
;; If the optional LIMIT is given, it bounds the backward search.
- ;; It's then assumed to be at a syntactically relevant position.
+ ;; It's then assumed to be at a syntactically relevant position. If
+ ;; RESTRICTED-FUNCTION is non-nil, it should be a function taking no
+ ;; arguments, called with point at a < at the start of a purported
+ ;; <>-arglist, which will return the value of
+ ;; `c-restricted-<>-arglists' to be used in the `c-forward-<>-arglist'
+ ;; call starting at that <.
;;
;; This is a wrapper around `c-forward-<>-arglist'. See that
;; function for more details.
@@ -8866,7 +9060,11 @@ multi-line strings (but not C++, for example)."
t
(backward-char)
- (let ((beg-pos (point)))
+ (let ((beg-pos (point))
+ (c-restricted-<>-arglists
+ (if restricted-function
+ (funcall restricted-function)
+ c-restricted-<>-arglists)))
(if (c-forward-<>-arglist all-types)
(cond ((= (point) start)
;; Matched the arglist. Break the while.
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 9118e3253c2..d220af2ab0e 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -2659,7 +2659,9 @@ need for `c-font-lock-extra-types'.")
;; prevent a repeat invocation. See elisp/lispref page "Search-based
;; fontification".
(let (pos)
- (while (c-syntactic-re-search-forward c-using-key limit 'end)
+ (while
+ (and (< (point) limit)
+ (c-syntactic-re-search-forward c-using-key limit 'end))
(while ; Do one declarator of a comma separated list, each time around.
(progn
(c-forward-syntactic-ws)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index ffb8c5c7b16..d56366e1755 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -455,6 +455,7 @@ so that all identifiers are recognized as words.")
c++ '(c-extend-region-for-CPP
c-depropertize-CPP
c-before-change-check-ml-strings
+ c-unmark-<>-around-region
c-before-change-check-<>-operators
c-before-after-change-check-c++-modules
c-truncate-bs-cache
@@ -468,6 +469,7 @@ so that all identifiers are recognized as words.")
c-parse-quotes-before-change
c-before-change-fix-comment-escapes)
java '(c-parse-quotes-before-change
+ c-unmark-<>-around-region
c-before-change-check-unbalanced-strings
c-before-change-check-<>-operators)
pike '(c-before-change-check-ml-strings
@@ -516,6 +518,7 @@ parameters \(point-min) and \(point-max).")
c-after-change-unmark-ml-strings
c-parse-quotes-after-change
c-after-change-mark-abnormal-strings
+ c-unmark-<>-around-region
c-extend-font-lock-region-for-macros
c-before-after-change-check-c++-modules
c-neutralize-syntax-in-CPP
@@ -524,6 +527,7 @@ parameters \(point-min) and \(point-max).")
java '(c-depropertize-new-text
c-after-change-escape-NL-in-string
c-parse-quotes-after-change
+ c-unmark-<>-around-region
c-after-change-mark-abnormal-strings
c-restore-<>-properties
c-change-expand-fl-region)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 2c5596e65c4..968ccd7ace9 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1371,7 +1371,9 @@ Note that the style variables are always made local to
the buffer."
(and ;(< (point) end)
(not (nth 3 s))
(c-get-char-property (1- (point)) 'c-fl-syn-tab))
- (c-put-char-property pos 'syntax-table '(1)))
+ (c-put-char-property pos 'syntax-table '(1))
+ (c-put-char-properties (1+ pos) (c-point 'eol pos)
+ 'syntax-table '(1)))
(setq pos (point)))
(setq pos (1+ pos)))))))))
@@ -1388,6 +1390,9 @@ Note that the style variables are always made local to
the buffer."
(setq pos
(c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
(< pos c-max-syn-tab-mkr))
+ (when (and (equal (c-get-char-property pos 'syntax-table) '(1))
+ (equal (c-get-char-property pos 'c-fl-syn-tab) '(15)))
+ (c-clear-char-properties (1+ pos) (c-point 'eol pos) 'syntax-table))
(c-put-char-property pos 'syntax-table
(c-get-char-property pos 'c-fl-syn-tab))
(setq pos (1+ pos))))))
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 72d4b93ee59..286d569aaca 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1219,7 +1219,8 @@ can always override the use of `c-default-style' by
making calls to
(incomposition . +)
;; Anchor pos: At the extern/namespace/etc block open brace if
;; it's at boi, otherwise boi at the keyword.
- (template-args-cont . (c-lineup-template-args +))
+ (template-args-cont . (c-lineup-template-args
+ c-lineup-template-args-indented-from-margin))
;; Anchor pos: Boi at the decl start. This might be changed;
;; the logical position is clearly the opening '<'.
(inlambda . 0)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 759b1ab4baf..955b708aee9 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -254,6 +254,9 @@ Comments in the form will be lost."
;; Empty symbol.
("##" (0 (unless (nth 8 (syntax-ppss))
(string-to-syntax "_"))))
+ ;; Prevent the @ from becoming part of a following symbol.
+ (",@" (0 (unless (nth 8 (syntax-ppss))
+ (string-to-syntax "'"))))
;; Unicode character names. (The longest name is 88 characters
;; long.)
("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}"
diff --git a/lisp/startup.el b/lisp/startup.el
index acfa4eb657b..2ba84a471af 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1054,11 +1054,17 @@ init-file, or to a default value if loading is not
possible."
;; `user-init-file'.
(setq user-init-file t)
(when init-file-name
- (load (if (equal (file-name-extension init-file-name)
- "el")
- (file-name-sans-extension init-file-name)
- init-file-name)
- 'noerror 'nomessage))
+ ;; If they specified --debug-init, enter the debugger
+ ;; on any error whatsoever.
+ (let ((debug-ignored-errors
+ (if (and init-file-debug (not noninteractive))
+ nil
+ debug-ignored-errors)))
+ (load (if (equal (file-name-extension init-file-name)
+ "el")
+ (file-name-sans-extension init-file-name)
+ init-file-name)
+ 'noerror 'nomessage)))
(when (and (eq user-init-file t) alternate-filename-function)
(let ((alt-file (funcall alternate-filename-function)))
@@ -1066,7 +1072,11 @@ init-file, or to a default value if loading is not
possible."
(setq init-file-name alt-file))
(and (equal (file-name-extension alt-file) "el")
(setq alt-file (file-name-sans-extension alt-file)))
- (load alt-file 'noerror 'nomessage)))
+ (let ((debug-ignored-errors
+ (if (and init-file-debug (not noninteractive))
+ nil
+ debug-ignored-errors)))
+ (load alt-file 'noerror 'nomessage))))
;; If we did not find the user's init file, set
;; user-init-file conclusively. Don't let it be
@@ -1105,7 +1115,11 @@ init-file, or to a default value if loading is not
possible."
(not inhibit-default-init))
;; Prevent default.el from changing the value of
;; `inhibit-startup-screen'.
- (let ((inhibit-startup-screen nil))
+ (let ((inhibit-startup-screen nil)
+ (debug-ignored-errors
+ (if (and init-file-debug (not noninteractive))
+ nil
+ debug-ignored-errors)))
(load "default" 'noerror 'nomessage))))
(error
(display-warning
diff --git a/src/nsterm.m b/src/nsterm.m
index 8c72bb25df1..78089906752 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1624,7 +1624,7 @@ ns_free_frame_resources (struct frame *f)
[f->output_data.ns->miniimage release];
[[view window] close];
- [view release];
+ [view removeFromSuperview];
xfree (f->output_data.ns);
f->output_data.ns = NULL;
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index 9cec7243515..c154d37f47f 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -3451,7 +3451,6 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute)
tab_bar_height = FRAME_TAB_BAR_HEIGHT (f);
tab_bar_width = (tab_bar_height
? native_width - 2 * internal_border_width : 0);
- inner_top += tab_bar_height;
/* Construct list. */
if (EQ (attribute, Qouter_edges))
@@ -3464,10 +3463,12 @@ frame_geometry (Lisp_Object frame, Lisp_Object
attribute)
else if (EQ (attribute, Qinner_edges))
return list4 (make_fixnum (native_left + internal_border_width),
make_fixnum (native_top
- + tool_bar_height
+ + tab_bar_height
+ + FRAME_TOOL_BAR_TOP_HEIGHT (f)
+ internal_border_width),
make_fixnum (native_right - internal_border_width),
- make_fixnum (native_bottom - internal_border_width));
+ make_fixnum (native_bottom - internal_border_width
+ - FRAME_TOOL_BAR_BOTTOM_HEIGHT (f)));
else
return
list (Fcons (Qouter_position,
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index fea34df991b..9e298b81ebb 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -1716,7 +1716,8 @@ regex_compile (re_char *pattern, ptrdiff_t size,
/* Address of start of the most recently finished expression.
This tells, e.g., postfix * where to find the start of its
- operand. Reset at the beginning of groups and alternatives. */
+ operand. Reset at the beginning of groups and alternatives,
+ and after ^ and \` for dusty-deck compatibility. */
unsigned char *laststart = 0;
/* Address of beginning of regexp, or inside of last group. */
@@ -1847,12 +1848,16 @@ regex_compile (re_char *pattern, ptrdiff_t size,
case '^':
if (! (p == pattern + 1 || at_begline_loc_p (pattern, p)))
goto normal_char;
+ /* Special case for compatibility: postfix ops after ^ become
+ literals. */
+ laststart = 0;
BUF_PUSH (begline);
break;
case '$':
if (! (p == pend || at_endline_loc_p (p, pend)))
goto normal_char;
+ laststart = b;
BUF_PUSH (endline);
break;
@@ -1892,7 +1897,7 @@ regex_compile (re_char *pattern, ptrdiff_t size,
/* Star, etc. applied to an empty pattern is equivalent
to an empty pattern. */
- if (!laststart || laststart == b)
+ if (laststart == b)
break;
/* Now we know whether or not zero matches is allowed
@@ -2544,18 +2549,24 @@ regex_compile (re_char *pattern, ptrdiff_t size,
break;
case 'b':
+ laststart = b;
BUF_PUSH (wordbound);
break;
case 'B':
+ laststart = b;
BUF_PUSH (notwordbound);
break;
case '`':
+ /* Special case for compatibility: postfix ops after \` become
+ literals, as for ^ (see above). */
+ laststart = 0;
BUF_PUSH (begbuf);
break;
case '\'':
+ laststart = b;
BUF_PUSH (endbuf);
break;
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 963ea9abe0c..278496f5259 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -776,6 +776,10 @@ inner loops respectively."
(nconc x nil nil))
(let ((x (cons 1 (cons 2 (cons 3 4)))))
(nconc nil x nil (list 5 6) nil))
+
+ ;; (+ 0 -0.0) etc
+ (let ((x (bytecomp-test-identity -0.0)))
+ (list x (+ x) (+ 0 x) (+ x 0) (+ 1 2 -3 x) (+ 0 x 0)))
)
"List of expressions for cross-testing interpreted and compiled code.")
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index de2fff5ef19..28a7f38c576 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -116,6 +116,7 @@ back to the top level.")
(with-current-buffer (find-file edebug-tests-temp-file)
(read-only-mode)
(setq lexical-binding t)
+ (syntax-ppss)
(eval-buffer)
,@body
(when edebug-tests-failure-in-post-command
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 0b01c13470a..a2e57e468c1 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -521,6 +521,7 @@ is greater than 10.
tramp-default-method-alist
tramp-default-user-alist
tramp-default-host-alist
+ tramp-default-proxies-alist
;; Suppress method name check.
(non-essential t)
;; Suppress check for multihops.
@@ -847,154 +848,203 @@ is greater than 10.
"/path/to/file"))
;; Multihop.
- (should
- (string-equal
- (file-remote-p
- "/method1:user1@host1|method2:user2@host2:/path/to/file")
- "/method2:user2@host2:"))
- (should
- (string-equal
- (file-remote-p
- "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
- "method2"))
- (should
- (string-equal
- (file-remote-p
- "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
- "user2"))
- (should
- (string-equal
- (file-remote-p
- "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
- "host2"))
- (should
- (string-equal
- (file-remote-p
- "/method1:user1@host1|method2:user2@host2:/path/to/file"
- 'localname)
- "/path/to/file"))
- (should
- (string-equal
- (file-remote-p
- "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
- (format "%s:%s@%s|"
- "method1" "user1" "host1")))
+ (dolist (tramp-show-ad-hoc-proxies '(nil t))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@host2"
- "|method3:user3@host3:/path/to/file"))
- "/method3:user3@host3:"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@host2"
- "|method3:user3@host3:/path/to/file")
- 'method)
- "method3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@host2"
- "|method3:user3@host3:/path/to/file")
- 'user)
- "user3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@host2"
- "|method3:user3@host3:/path/to/file")
- 'host)
- "host3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@host2"
- "|method3:user3@host3:/path/to/file")
- 'localname)
- "/path/to/file"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@host2"
- "|method3:user3@host3:/path/to/file")
- 'hop)
- (format "%s:%s@%s|%s:%s@%s|"
- "method1" "user1" "host1" "method2" "user2" "host2")))
-
- ;; Expand `tramp-default-method-alist'.
- (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1"))
- (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2"))
- (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/-:user1@host1"
- "|-:user2@host2"
- "|-:user3@host3:/path/to/file"))
- "/method3:user3@host3:"))
-
- ;; Expand `tramp-default-user-alist'.
- (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
- (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2"))
- (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:host1"
- "|method2:host2"
- "|method3:host3:/path/to/file"))
- "/method3:user3@host3:"))
-
- ;; Expand `tramp-default-host-alist'.
- (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
- (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2"))
- (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@"
- "|method2:user2@"
- "|method3:user3@:/path/to/file"))
- "/method3:user3@host3:"))
-
- ;; Ad-hoc user name and host name expansion.
- (setq tramp-default-method-alist nil
- tramp-default-user-alist nil
- tramp-default-host-alist nil)
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:user1@host1"
- "|method2:user2@"
- "|method3:user3@:/path/to/file"))
- "/method3:user3@host1:"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/method1:%u@%h"
- "|method2:user2@host2"
- "|method3:%u@%h"
- "|method4:user4%domain4@host4#1234:/path/to/file"))
- "/method4:user4%domain4@host4#1234:")))
+ ;; Explicit settings in `tramp-default-proxies-alist'
+ ;; shouldn't show hops.
+ (setq tramp-default-proxies-alist
+ '(("^host2$" "^user2$" "/method1:user1@host1:")))
+ (should
+ (string-equal
+ (file-remote-p "/method2:user2@host2:/path/to/file")
+ "/method2:user2@host2:"))
+ (setq tramp-default-proxies-alist nil)
+
+ ;; Ad-hoc settings.
+ (should
+ (string-equal
+ (file-remote-p
+ "/method1:user1@host1|method2:user2@host2:/path/to/file")
+ (if tramp-show-ad-hoc-proxies
+ "/method1:user1@host1|method2:user2@host2:"
+ "/method2:user2@host2:")))
+ (should
+ (string-equal
+ (file-remote-p
+ "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method)
+ "method2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user)
+ "user2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host)
+ "host2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/method1:user1@host1|method2:user2@host2:/path/to/file"
+ 'localname)
+ "/path/to/file"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop)
+ (format "%s:%s@%s|"
+ "method1" "user1" "host1")))
+
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:")
+ "/method3:user3@host3:")))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:/path/to/file")
+ 'method)
+ "method3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:/path/to/file")
+ 'user)
+ "user3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:/path/to/file")
+ 'host)
+ "host3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:/path/to/file")
+ 'localname)
+ "/path/to/file"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:/path/to/file")
+ 'hop)
+ (format "%s:%s@%s|%s:%s@%s|"
+ "method1" "user1" "host1" "method2" "user2" "host2")))
+
+ ;; Expand `tramp-default-method-alist'.
+ (add-to-list
+ 'tramp-default-method-alist '("host1" "user1" "method1"))
+ (add-to-list
+ 'tramp-default-method-alist '("host2" "user2" "method2"))
+ (add-to-list
+ 'tramp-default-method-alist '("host3" "user3" "method3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/-:user1@host1"
+ "|-:user2@host2"
+ "|-:user3@host3:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:")
+ "/method3:user3@host3:")))
+
+ ;; Expand `tramp-default-user-alist'.
+ (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
+ (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2"))
+ (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:host1"
+ "|method2:host2"
+ "|method3:host3:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:")
+ "/method3:user3@host3:")))
+
+ ;; Expand `tramp-default-host-alist'.
+ (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
+ (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2"))
+ (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@"
+ "|method2:user2@"
+ "|method3:user3@:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host2"
+ "|method3:user3@host3:")
+ "/method3:user3@host3:")))
+
+ ;; Ad-hoc user name and host name expansion.
+ (setq tramp-default-method-alist nil
+ tramp-default-user-alist nil
+ tramp-default-host-alist nil)
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@"
+ "|method3:user3@:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/method1:user1@host1"
+ "|method2:user2@host1"
+ "|method3:user3@host1:")
+ "/method3:user3@host1:")))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/method1:%u@%h"
+ "|method2:user2@host2"
+ "|method3:%u@%h"
+ "|method4:user4%domain4@host4#1234:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/method1:user2@host2"
+ "|method2:user2@host2"
+ "|method3:user4@host4"
+ "|method4:user4%domain4@host4#1234:")
+ "/method4:user4%domain4@host4#1234:")))))
;; Exit.
(tramp-change-syntax syntax))))
@@ -1007,6 +1057,7 @@ is greater than 10.
(tramp-default-host "default-host")
tramp-default-user-alist
tramp-default-host-alist
+ tramp-default-proxies-alist
;; Suppress method name check.
(non-essential t)
;; Suppress check for multihops.
@@ -1178,137 +1229,178 @@ is greater than 10.
"/path/to/file"))
;; Multihop.
- (should
- (string-equal
- (file-remote-p "/user1@host1|user2@host2:/path/to/file")
- "/user2@host2:"))
- (should
- (string-equal
- (file-remote-p
- "/user1@host1|user2@host2:/path/to/file" 'method)
- "default-method"))
- (should
- (string-equal
- (file-remote-p
- "/user1@host1|user2@host2:/path/to/file" 'user)
- "user2"))
- (should
- (string-equal
- (file-remote-p
- "/user1@host1|user2@host2:/path/to/file" 'host)
- "host2"))
- (should
- (string-equal
- (file-remote-p
- "/user1@host1|user2@host2:/path/to/file" 'localname)
- "/path/to/file"))
- (should
- (string-equal
- (file-remote-p
- "/user1@host1|user2@host2:/path/to/file" 'hop)
- (format "%s@%s|" "user1" "host1")))
+ (dolist (tramp-show-ad-hoc-proxies '(nil t))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@host2"
- "|user3@host3:/path/to/file"))
- "/user3@host3:"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@host2"
- "|user3@host3:/path/to/file")
- 'method)
- "default-method"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@host2"
- "|user3@host3:/path/to/file")
- 'user)
- "user3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@host2"
- "|user3@host3:/path/to/file")
- 'host)
- "host3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@host2"
- "|user3@host3:/path/to/file")
- 'localname)
- "/path/to/file"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@host2"
- "|user3@host3:/path/to/file")
- 'hop)
- (format "%s@%s|%s@%s|"
- "user1" "host1" "user2" "host2")))
-
- ;; Expand `tramp-default-user-alist'.
- (add-to-list 'tramp-default-user-alist '(nil "host1" "user1"))
- (add-to-list 'tramp-default-user-alist '(nil "host2" "user2"))
- (add-to-list 'tramp-default-user-alist '(nil "host3" "user3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/host1"
- "|host2"
- "|host3:/path/to/file"))
- "/user3@host3:"))
-
- ;; Expand `tramp-default-host-alist'.
- (add-to-list 'tramp-default-host-alist '(nil "user1" "host1"))
- (add-to-list 'tramp-default-host-alist '(nil "user2" "host2"))
- (add-to-list 'tramp-default-host-alist '(nil "user3" "host3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@"
- "|user2@"
- "|user3@:/path/to/file"))
- "/user3@host3:"))
-
- ;; Ad-hoc user name and host name expansion.
- (setq tramp-default-user-alist nil
- tramp-default-host-alist nil)
- (should
- (string-equal
- (file-remote-p
- (concat
- "/user1@host1"
- "|user2@"
- "|user3@:/path/to/file"))
- "/user3@host1:"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/%u@%h"
- "|user2@host2"
- "|%u@%h"
- "|user4%domain4@host4#1234:/path/to/file"))
- "/user4%domain4@host4#1234:")))
+ ;; Explicit settings in `tramp-default-proxies-alist'
+ ;; shouldn't show hops.
+ (setq tramp-default-proxies-alist
+ '(("^host2$" "^user2$" "/user1@host1:")))
+ (should
+ (string-equal
+ (file-remote-p "/user2@host2:/path/to/file")
+ "/user2@host2:"))
+ (setq tramp-default-proxies-alist nil)
+
+ ;; Ad-hoc settings.
+ (should
+ (string-equal
+ (file-remote-p "/user1@host1|user2@host2:/path/to/file")
+ (if tramp-show-ad-hoc-proxies
+ "/user1@host1|user2@host2:"
+ "/user2@host2:")))
+ (should
+ (string-equal
+ (file-remote-p
+ "/user1@host1|user2@host2:/path/to/file" 'method)
+ "default-method"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/user1@host1|user2@host2:/path/to/file" 'user)
+ "user2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/user1@host1|user2@host2:/path/to/file" 'host)
+ "host2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/user1@host1|user2@host2:/path/to/file" 'localname)
+ "/path/to/file"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/user1@host1|user2@host2:/path/to/file" 'hop)
+ (format "%s@%s|" "user1" "host1")))
+
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:")
+ "/user3@host3:")))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:/path/to/file")
+ 'method)
+ "default-method"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:/path/to/file")
+ 'user)
+ "user3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:/path/to/file")
+ 'host)
+ "host3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:/path/to/file")
+ 'localname)
+ "/path/to/file"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:/path/to/file")
+ 'hop)
+ (format "%s@%s|%s@%s|"
+ "user1" "host1" "user2" "host2")))
+
+ ;; Expand `tramp-default-user-alist'.
+ (add-to-list 'tramp-default-user-alist '(nil "host1" "user1"))
+ (add-to-list 'tramp-default-user-alist '(nil "host2" "user2"))
+ (add-to-list 'tramp-default-user-alist '(nil "host3" "user3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/host1"
+ "|host2"
+ "|host3:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:")
+ "/user3@host3:")))
+
+ ;; Expand `tramp-default-host-alist'.
+ (add-to-list 'tramp-default-host-alist '(nil "user1" "host1"))
+ (add-to-list 'tramp-default-host-alist '(nil "user2" "host2"))
+ (add-to-list 'tramp-default-host-alist '(nil "user3" "host3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@"
+ "|user2@"
+ "|user3@:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/user1@host1"
+ "|user2@host2"
+ "|user3@host3:")
+ "/user3@host3:")))
+
+ ;; Ad-hoc user name and host name expansion.
+ (setq tramp-default-user-alist nil
+ tramp-default-host-alist nil)
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/user1@host1"
+ "|user2@"
+ "|user3@:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/user1@host1"
+ "|user2@host1"
+ "|user3@host1:")
+ "/user3@host1:")))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/%u@%h"
+ "|user2@host2"
+ "|%u@%h"
+ "|user4%domain4@host4#1234:/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/user2@host2"
+ "|user2@host2"
+ "|user4@host4"
+ "|user4%domain4@host4#1234:")
+ "/user4%domain4@host4#1234:")))))
;; Exit.
(tramp-change-syntax syntax))))
@@ -1322,6 +1414,7 @@ is greater than 10.
tramp-default-method-alist
tramp-default-user-alist
tramp-default-host-alist
+ tramp-default-proxies-alist
;; Suppress method name check.
(non-essential t)
;; Suppress check for multihops.
@@ -1794,154 +1887,203 @@ is greater than 10.
"/path/to/file"))
;; Multihop.
- (should
- (string-equal
- (file-remote-p
- "/[method1/user1@host1|method2/user2@host2]/path/to/file")
- "/[method2/user2@host2]"))
- (should
- (string-equal
- (file-remote-p
- "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method)
- "method2"))
- (should
- (string-equal
- (file-remote-p
- "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user)
- "user2"))
- (should
- (string-equal
- (file-remote-p
- "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host)
- "host2"))
- (should
- (string-equal
- (file-remote-p
- "/[method1/user1@host1|method2/user2@host2]/path/to/file"
- 'localname)
- "/path/to/file"))
- (should
- (string-equal
- (file-remote-p
- "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop)
- (format "%s/%s@%s|"
- "method1" "user1" "host1")))
+ (dolist (tramp-show-ad-hoc-proxies '(nil t))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@host2"
- "|method3/user3@host3]/path/to/file"))
- "/[method3/user3@host3]"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@host2"
- "|method3/user3@host3]/path/to/file")
- 'method)
- "method3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@host2"
- "|method3/user3@host3]/path/to/file")
- 'user)
- "user3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@host2"
- "|method3/user3@host3]/path/to/file")
- 'host)
- "host3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@host2"
- "|method3/user3@host3]/path/to/file")
- 'localname)
- "/path/to/file"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@host2"
- "|method3/user3@host3]/path/to/file")
- 'hop)
- (format "%s/%s@%s|%s/%s@%s|"
- "method1" "user1" "host1" "method2" "user2" "host2")))
-
- ;; Expand `tramp-default-method-alist'.
- (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1"))
- (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2"))
- (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[/user1@host1"
- "|/user2@host2"
- "|/user3@host3]/path/to/file"))
- "/[method3/user3@host3]"))
-
- ;; Expand `tramp-default-user-alist'.
- (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
- (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2"))
- (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/host1"
- "|method2/host2"
- "|method3/host3]/path/to/file"))
- "/[method3/user3@host3]"))
-
- ;; Expand `tramp-default-host-alist'.
- (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
- (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2"))
- (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@"
- "|method2/user2@"
- "|method3/user3@]/path/to/file"))
- "/[method3/user3@host3]"))
-
- ;; Ad-hoc user name and host name expansion.
- (setq tramp-default-method-alist nil
- tramp-default-user-alist nil
- tramp-default-host-alist nil)
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/user1@host1"
- "|method2/user2@"
- "|method3/user3@]/path/to/file"))
- "/[method3/user3@host1]"))
- (should
- (string-equal
- (file-remote-p
- (concat
- "/[method1/%u@%h"
- "|method2/user2@host2"
- "|method3/%u@%h"
- "|method4/user4%domain4@host4#1234]/path/to/file"))
- "/[method4/user4%domain4@host4#1234]")))
+ ;; Explicit settings in `tramp-default-proxies-alist'
+ ;; shouldn't show hops.
+ (setq tramp-default-proxies-alist
+ '(("^host2$" "^user2$" "/[method1/user1@host1]")))
+ (should
+ (string-equal
+ (file-remote-p "/[method2/user2@host2]/path/to/file")
+ "/[method2/user2@host2]"))
+ (setq tramp-default-proxies-alist nil)
+
+ ;; Ad-hoc settings.
+ (should
+ (string-equal
+ (file-remote-p
+ "/[method1/user1@host1|method2/user2@host2]/path/to/file")
+ (if tramp-show-ad-hoc-proxies
+ "/[method1/user1@host1|method2/user2@host2]"
+ "/[method2/user2@host2]")))
+ (should
+ (string-equal
+ (file-remote-p
+ "/[method1/user1@host1|method2/user2@host2]/path/to/file"
'method)
+ "method2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user)
+ "user2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host)
+ "host2"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/[method1/user1@host1|method2/user2@host2]/path/to/file"
+ 'localname)
+ "/path/to/file"))
+ (should
+ (string-equal
+ (file-remote-p
+ "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop)
+ (format "%s/%s@%s|"
+ "method1" "user1" "host1")))
+
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]")
+ "/[method3/user3@host3]")))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]/path/to/file")
+ 'method)
+ "method3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]/path/to/file")
+ 'user)
+ "user3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]/path/to/file")
+ 'host)
+ "host3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]/path/to/file")
+ 'localname)
+ "/path/to/file"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]/path/to/file")
+ 'hop)
+ (format "%s/%s@%s|%s/%s@%s|"
+ "method1" "user1" "host1" "method2" "user2" "host2")))
+
+ ;; Expand `tramp-default-method-alist'.
+ (add-to-list
+ 'tramp-default-method-alist '("host1" "user1" "method1"))
+ (add-to-list
+ 'tramp-default-method-alist '("host2" "user2" "method2"))
+ (add-to-list
+ 'tramp-default-method-alist '("host3" "user3" "method3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[/user1@host1"
+ "|/user2@host2"
+ "|/user3@host3]/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]")
+ "/[method3/user3@host3]")))
+
+ ;; Expand `tramp-default-user-alist'.
+ (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
+ (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2"))
+ (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/host1"
+ "|method2/host2"
+ "|method3/host3]/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]")
+ "/[method3/user3@host3]")))
+
+ ;; Expand `tramp-default-host-alist'.
+ (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
+ (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2"))
+ (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3"))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@"
+ "|method2/user2@"
+ "|method3/user3@]/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host2"
+ "|method3/user3@host3]")
+ "/[method3/user3@host3]")))
+
+ ;; Ad-hoc user name and host name expansion.
+ (setq tramp-default-method-alist nil
+ tramp-default-user-alist nil
+ tramp-default-host-alist nil)
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@"
+ "|method3/user3@]/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/[method1/user1@host1"
+ "|method2/user2@host1"
+ "|method3/user3@host1]")
+ "/[method3/user3@host1]")))
+ (should
+ (string-equal
+ (file-remote-p
+ (concat
+ "/[method1/%u@%h"
+ "|method2/user2@host2"
+ "|method3/%u@%h"
+ "|method4/user4%domain4@host4#1234]/path/to/file"))
+ (if tramp-show-ad-hoc-proxies
+ (concat
+ "/[method1/user2@host2"
+ "|method2/user2@host2"
+ "|method3/user4@host4"
+ "|method4/user4%domain4@host4#1234]")
+ "/[method4/user4%domain4@host4#1234]")))))
;; Exit.
(tramp-change-syntax syntax))))
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index 52d43775b8e..08a93dbf30e 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -883,4 +883,70 @@ This evaluates the TESTS test cases from glibc."
(should (looking-at "x*\\(=\\|:\\)*"))
(should (looking-at "x*=*?"))))
+(ert-deftest regexp-tests-zero-width-assertion-repetition ()
+ ;; Check compatibility behaviour with repetition operators after
+ ;; certain zero-width assertions (bug#64128).
+
+ ;; This function is just to hide ugly regexps from relint so that it
+ ;; doesn't complain about them.
+ (cl-flet ((smatch (re str) (string-match re str)))
+ ;; Postfix operators after ^ and \` become literals, for historical
+ ;; compatibility. Only the first character of a lazy operator (like *?)
+ ;; becomes a literal.
+ (should (equal (smatch "^*a" "x\n*a") 2))
+ (should (equal (smatch "^*?a" "x\n*a") 2))
+ (should (equal (smatch "^*?a" "x\na") 2))
+ (should (equal (smatch "^*?a" "x\n**a") nil))
+
+ (should (equal (smatch "\\`*a" "*a") 0))
+ (should (equal (smatch "\\`*?a" "*a") 0))
+ (should (equal (smatch "\\`*?a" "a") 0))
+ (should (equal (smatch "\\`*?a" "**a") nil))
+
+ ;; Other zero-width assertions are treated as normal elements, so postfix
+ ;; operators apply to them alone (which is pointless but valid).
+ (should (equal (smatch "\\b*!" "*!") 1))
+ (should (equal (smatch "!\\b+;" "!;") nil))
+ (should (equal (smatch "!\\b+a" "!a") 0))
+
+ (should (equal (smatch "\\B*!" "*!") 1))
+ (should (equal (smatch "!\\B+;" "!;") 0))
+ (should (equal (smatch "!\\B+a" "!a") nil))
+
+ (should (equal (smatch "\\<*b" "*b") 1))
+ (should (equal (smatch "a\\<*b" "ab") 0))
+ (should (equal (smatch ";\\<*b" ";b") 0))
+ (should (equal (smatch "a\\<+b" "ab") nil))
+ (should (equal (smatch ";\\<+b" ";b") 0))
+
+ (should (equal (smatch "\\>*;" "*;") 1))
+ (should (equal (smatch "a\\>*b" "ab") 0))
+ (should (equal (smatch "a\\>*;" "a;") 0))
+ (should (equal (smatch "a\\>+b" "ab") nil))
+ (should (equal (smatch "a\\>+;" "a;") 0))
+
+ (should (equal (smatch "a\\'" "ab") nil))
+ (should (equal (smatch "b\\'" "ab") 1))
+ (should (equal (smatch "a\\'*b" "ab") 0))
+ (should (equal (smatch "a\\'+" "ab") nil))
+ (should (equal (smatch "b\\'+" "ab") 1))
+ (should (equal (smatch "\\'+" "+") 1))
+
+ (should (equal (smatch "\\_<*b" "*b") 1))
+ (should (equal (smatch "a\\_<*b" "ab") 0))
+ (should (equal (smatch " \\_<*b" " b") 0))
+ (should (equal (smatch "a\\_<+b" "ab") nil))
+ (should (equal (smatch " \\_<+b" " b") 0))
+
+ (should (equal (smatch "\\_>*;" "*;") 1))
+ (should (equal (smatch "a\\_>*b" "ab") 0))
+ (should (equal (smatch "a\\_>* " "a ") 0))
+ (should (equal (smatch "a\\_>+b" "ab") nil))
+ (should (equal (smatch "a\\_>+ " "a ") 0))
+
+ (should (equal (smatch "\\=*b" "*b") 1))
+ (should (equal (smatch "a\\=*b" "a*b") nil))
+ (should (equal (smatch "a\\=*b" "ab") 0))
+ ))
+
;;; regex-emacs-tests.el ends here