Commit 4ffe265b authored by K. Handa's avatar K. Handa
Browse files

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

parents 096d1347 75de3640
......@@ -1327,7 +1327,8 @@ If it is @code{t}, the conversion uses Universal Time. If it is
a string, the conversion uses the time zone rule equivalent to setting
@env{TZ} to that string. If it is an integer @var{offset}, the
conversion uses a fixed time zone with the given offset and a numeric
abbreviation. If it is a list (@var{offset} @var{abbr}), where
abbreviation on POSIX-compatible platforms and an unspecified abbreviation
on MS-Windows. If it is a list (@var{offset} @var{abbr}), where
@var{offset} is an integer number of seconds east of Universal Time
and @var{abbr} is a string, the conversion uses a fixed time zone with
the given offset and abbreviation.
......
......@@ -1529,16 +1529,6 @@ can they extend beyond the lifetime of the current Emacs session. Set
Set @code{password-cache} to @code{nil} to disable password caching.
@strong{Implementation Note}: password caching depends on
@file{password-cache.el} package. @value{tramp} activates password
caching only if @value{tramp} can discover, while Emacs is loading,
the package through @code{load-path}.
@ifset installchapter
@file{password.el} is available from No Gnus or from the @value{tramp}
@file{contrib} directory, see @ref{Installation parameters}.
@end ifset
@node Connection caching
@section Reusing connection related information
......
......@@ -537,32 +537,79 @@ Don't try to split prefixes that are already longer than that.")
(dolist (def defs)
(setq tree (radix-tree-insert tree def t)))
tree))
(prefixes (list (cons "" tree))))
(while
(let ((newprefixes nil)
(changes nil))
(dolist (pair prefixes)
(let ((prefix (car pair)))
(if (or (> (length prefix) autoload-def-prefixes-max-length)
(radix-tree-lookup (cdr pair) ""))
;; No point splitting it any further.
(push pair newprefixes)
(setq changes t)
(radix-tree-iter-subtrees
(cdr pair) (lambda (sprefix subtree)
(push (cons (concat prefix sprefix) subtree)
newprefixes))))))
(and changes
(or (and (null (cdr prefixes)) (equal "" (caar prefixes)))
(<= (length newprefixes)
autoload-def-prefixes-max-entries))
(setq prefixes newprefixes)
(< (length prefixes) autoload-def-prefixes-max-entries))))
(prefixes nil))
;; Get the root prefixes, that we should include in any case.
(radix-tree-iter-subtrees
tree (lambda (prefix subtree)
(push (cons prefix subtree) prefixes)))
;; In some cases, the root prefixes are too short, e.g. if you define
;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
(dolist (pair (prog1 prefixes (setq prefixes nil)))
(let ((s (car pair)))
(if (or (> (length s) 2) ;Long enough!
(string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
(radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
(push pair prefixes) ;Keep it as is.
(radix-tree-iter-subtrees
(cdr pair) (lambda (prefix subtree)
(push (cons (concat s prefix) subtree) prefixes))))))
;; FIXME: The expansions done below are mostly pointless, such as
;; for `yenc', where we replace "yenc-" with an exhaustive list (5
;; elements).
;; (while
;; (let ((newprefixes nil)
;; (changes nil))
;; (dolist (pair prefixes)
;; (let ((prefix (car pair)))
;; (if (or (> (length prefix) autoload-def-prefixes-max-length)
;; (radix-tree-lookup (cdr pair) ""))
;; ;; No point splitting it any further.
;; (push pair newprefixes)
;; (setq changes t)
;; (radix-tree-iter-subtrees
;; (cdr pair) (lambda (sprefix subtree)
;; (push (cons (concat prefix sprefix) subtree)
;; newprefixes))))))
;; (and changes
;; (<= (length newprefixes)
;; autoload-def-prefixes-max-entries)
;; (let ((new nil)
;; (old nil))
;; (dolist (pair prefixes)
;; (unless (memq pair newprefixes) ;Not old
;; (push pair old)))
;; (dolist (pair newprefixes)
;; (unless (memq pair prefixes) ;Not new
;; (push pair new)))
;; (cl-assert new)
;; (message "Expanding %S to %S"
;; (mapcar #'car old) (mapcar #'car new))
;; t)
;; (setq prefixes newprefixes)
;; (< (length prefixes) autoload-def-prefixes-max-entries))))
;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes
`(if (fboundp 'register-definition-prefixes)
(register-definition-prefixes ,file ',(mapcar #'car prefixes))))))
(let ((strings
(mapcar
(lambda (x)
(let ((prefix (car x)))
(if (or (> (length prefix) 2) ;Long enough!
(string-match ".[[:punct:]]\\'" prefix))
prefix
;; Some packages really don't follow the rules.
;; Drop the most egregious cases such as the
;; one-letter prefixes.
(let ((dropped ()))
(radix-tree-iter-mappings
(cdr x) (lambda (s _)
(push (concat prefix s) dropped)))
(message "Not registering prefix \"%s\" from %s. Affects: %S"
prefix file dropped)
nil))))
prefixes)))
`(if (fboundp 'register-definition-prefixes)
(register-definition-prefixes ,file ',(delq nil strings)))))))
(defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf
......@@ -714,8 +761,10 @@ FILE's modification time."
"define-obsolete-variable-alias"
"define-category" "define-key"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-response-handler"
"defun-rcirc-command"))))
(push (match-string 2) defs))
(forward-sexp 1)
......
......@@ -380,6 +380,11 @@ and the hook `eshell-exit-hook'."
(make-local-variable 'eshell-modules-list)
(setq eshell-modules-list modules-list))
;; This is to avoid making the paragraph base direction
;; right-to-left if the first word just happens to start with a
;; strong R2L character.
(setq bidi-paragraph-direction 'left-to-right)
;; load extension modules into memory. This will cause any global
;; variables they define to be visible, since some of the core
;; modules sometimes take advantage of their functionality if used.
......
......@@ -1259,6 +1259,11 @@ You can update the global isearch variables by setting new values to
(isearch-adjusted isearch-adjusted)
(isearch-yank-flag isearch-yank-flag)
(isearch-error isearch-error)
(multi-isearch-file-list-new multi-isearch-file-list)
(multi-isearch-buffer-list-new multi-isearch-buffer-list)
(multi-isearch-next-buffer-function multi-isearch-next-buffer-current-function)
(multi-isearch-current-buffer-new multi-isearch-current-buffer)
;;; Don't bind this. We want isearch-search, below, to set it.
;;; And the old value won't matter after that.
;;; (isearch-other-end isearch-other-end)
......@@ -1313,7 +1318,10 @@ You can update the global isearch variables by setting new values to
isearch-message isearch-new-message
isearch-forward isearch-new-forward
isearch-regexp-function isearch-new-regexp-function
isearch-case-fold-search isearch-new-case-fold)
isearch-case-fold-search isearch-new-case-fold
multi-isearch-current-buffer multi-isearch-current-buffer-new
multi-isearch-file-list multi-isearch-file-list-new
multi-isearch-buffer-list multi-isearch-buffer-list-new)
;; Restore the minibuffer message before moving point.
(funcall (or isearch-message-function #'isearch-message) nil t)
......
This diff is collapsed.
......@@ -78,10 +78,6 @@
(expand-file-name "textmodes" dir)
(expand-file-name "vc" dir)))))
;; Prevent build-time PATH getting stored in the binary.
;; Mainly cosmetic, but helpful for Guix. (Bug#20330)
(setq exec-path nil)
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
(setq purify-flag (make-hash-table :test 'equal :size 80000)))
......@@ -431,6 +427,12 @@ lost after dumping")))
(message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others"
strings vectors conses bytecodes others)))
;; Prevent build-time PATH getting stored in the binary.
;; Mainly cosmetic, but helpful for Guix. (Bug#20330)
;; Do this here, rather than earlier, so that the above code
;; can invoke Git commands and the like.
(setq exec-path nil)
;; Avoid error if user loads some more libraries now and make sure the
;; hash-consing hash table is GC'd.
(setq purify-flag nil)
......
......@@ -1430,8 +1430,17 @@ manpage command."
(quit-restore-window
(get-buffer-window (current-buffer) t) 'kill)
(kill-buffer (current-buffer)))
(message "Can't find the %s manpage"
(Man-page-from-arguments args)))
;; Entries hyphenated due to the window's width
;; won't be found in the man database, so remove
;; the hyphenation -- assuming Groff hyphenates
;; either with hyphen-minus (ASCII 45, #x2d),
;; hyphen (#x2010) or soft hyphen (#xad) -- and
;; look again.
(if (string-match "[-‐­]" args)
(let ((str (replace-match "" nil nil args)))
(Man-getpage-in-background str))
(message "Can't find the %s manpage"
(Man-page-from-arguments args))))
(if Man-fontify-manpage-flag
(message "%s man page formatted"
......
......@@ -1045,7 +1045,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
"Returns nil on success error-output on failure."
(when (and (> (length (tramp-file-name-host vec)) 0)
;; The -s switch is only available for ADB device commands.
(not (member (car args) (list "connect" "disconnect"))))
(not (member (car args) '("connect" "disconnect"))))
(setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
(with-temp-buffer
(prog1
......
......@@ -345,7 +345,7 @@ names. Passwords will never be included there.")
Please note that you have set `tramp-verbose' to a value of at
least 6. Therefore, the contents of files might be included in
the debug buffer(s).")
(add-text-properties start (point) (list 'face 'italic))))
(add-text-properties start (point) '(face italic))))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
......
......@@ -680,7 +680,7 @@ file names."
'tramp-gvfs-send-command v gvfs-operation
(append
(and (eq op 'copy) (or keep-date preserve-uid-gid)
(list "--preserve"))
'("--preserve"))
(list
(tramp-gvfs-url-file-name filename)
(tramp-gvfs-url-file-name newname))))
......
......@@ -2517,19 +2517,18 @@ The method used must be an out-of-band method."
;; Use an asynchronous process. By this, password can
;; be handled. We don't set a timeout, because the
;; copying of large files can last longer than 60
;; secs.
(let ((p (apply 'start-process-shell-command
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program
(append
copy-args
(list "&&" "echo" "tramp_exit_status" "0"
"||" "echo" "tramp_exit_status" "1")))))
(tramp-message
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
;; copying of large files can last longer than 60 secs.
(let* ((command
(mapconcat
'identity (append (list copy-program) copy-args)
" "))
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(start-process-shell-command
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
command))))
(tramp-message orig-vec 6 "%s" command)
(tramp-set-connection-property p "vector" orig-vec)
(set-process-query-on-exit-flag p nil)
......@@ -2537,23 +2536,7 @@ The method used must be an out-of-band method."
;; sending the password.
(let ((tramp-local-end-of-line tramp-rsh-end-of-line))
(tramp-process-actions
p v nil tramp-actions-copy-out-of-band))
;; Check the return code.
(goto-char (point-max))
(unless
(re-search-backward "tramp_exit_status [0-9]+" nil t)
(tramp-error
orig-vec 'file-error
"Couldn't find exit status of `%s'"
(mapconcat 'identity (process-command p) " ")))
(skip-chars-forward "^ ")
(unless (zerop (read (current-buffer)))
(forward-line -1)
(tramp-error
orig-vec 'file-error
"Error copying: `%s'"
(buffer-substring (point-min) (point-at-eol))))))
p v nil tramp-actions-copy-out-of-band))))
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
......@@ -5597,18 +5580,14 @@ function cell is returned to be applied on a buffer."
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary)
(default-directory
(tramp-compat-temporary-file-directory)))
(coding-system-for-read 'binary))
(apply
'tramp-call-process-region ,vec (point-min) (point-max)
(car (split-string ,compress)) t t nil
(cdr (split-string ,compress)))))
`(lambda (beg end)
(let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary)
(default-directory
(tramp-compat-temporary-file-directory)))
(coding-system-for-read 'binary))
(apply
'tramp-call-process-region ,vec beg end
(car (split-string ,compress)) t t nil
......
......@@ -3445,7 +3445,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(tramp-message vec 3 "Process has finished.")
(throw 'tramp-action 'ok))
(tramp-message vec 3 "Process has died.")
(throw 'tramp-action 'process-died))))
(throw 'tramp-action 'out-of-band-failed))))
(t nil)))
;;; Functions for processing the actions:
......@@ -3506,6 +3506,10 @@ connection buffer."
(tramp-get-connection-buffer vec) vec 'file-error
(cond
((eq exit 'permission-denied) "Permission denied")
((eq exit 'out-of-band-failed)
(format-message
"Copy failed, see buffer `%s' for details"
(tramp-get-connection-buffer vec)))
((eq exit 'process-died)
(substitute-command-keys
(concat
......@@ -4003,7 +4007,8 @@ ALIST is of the form ((FROM . TO) ...)."
It always returns a return code. The Lisp error raised when
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((v (or vec
(let ((default-directory (tramp-compat-temporary-file-directory))
(v (or vec
(vector tramp-current-method tramp-current-user
tramp-current-host nil nil)))
(destination (if (eq destination t) (current-buffer) destination))
......@@ -4033,7 +4038,8 @@ are written with verbosity of 6."
It always returns a return code. The Lisp error raised when
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((v (or vec
(let ((default-directory (tramp-compat-temporary-file-directory))
(v (or vec
(vector tramp-current-method tramp-current-user
tramp-current-host nil nil)))
(buffer (if (eq buffer t) (current-buffer) buffer))
......
......@@ -1794,7 +1794,7 @@ but they don't build a type of themselves. Unlike the keywords on
not the type face."
t nil
c '("const" "restrict" "volatile")
c++ '("const" "constexpr" "noexcept" "volatile" "throw" "final" "override")
c++ '("const" "noexcept" "volatile" "throw" "final" "override")
objc '("const" "volatile"))
(c-lang-defconst c-opt-type-modifier-key
......@@ -1996,8 +1996,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',
will be handled."
t nil
(c c++) '("auto" "extern" "inline" "register" "static")
c++ (append '("explicit" "friend" "mutable" "template" "thread_local"
"using" "virtual")
c++ (append '("constexpr" "explicit" "friend" "mutable" "template"
"thread_local" "using" "virtual")
(c-lang-const c-modifier-kwds))
objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static")
;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead.
......
......@@ -116,18 +116,6 @@ or if we could not determine the revision.")
(looking-at "[0-9a-fA-F]\\{40\\}"))
(match-string 0)))))
(defun emacs-repository--version-git-1 (file dir)
"Internal subroutine of `emacs-repository-get-version'."
(when (file-readable-p file)
(with-temp-buffer
(insert-file-contents file)
(cond ((looking-at "[0-9a-fA-F]\\{40\\}")
(match-string 0))
((looking-at "ref: \\(.*\\)")
(emacs-repository--version-git-1
(expand-file-name (match-string 1) dir)
dir))))))
(defun emacs-repository-get-version (&optional dir external)
"Try to return as a string the repository revision of the Emacs sources.
The format of the returned string is dependent on the VCS in use.
......@@ -137,42 +125,8 @@ this reports on the current state of the sources, which may not
correspond to the running Emacs.
Optional argument DIR is a directory to use instead of `source-directory'.
Optional argument EXTERNAL non-nil means to just ask the VCS itself,
if the sources appear to be under version control. Otherwise only ask
the VCS if we cannot find any information ourselves."
(or dir (setq dir source-directory))
(let* ((base-dir (expand-file-name ".git" dir))
(in-main-worktree (file-directory-p base-dir))
(in-linked-worktree nil)
sub-dir)
;; If the sources are in a linked worktree, .git is a file that points to
;; the location of the main worktree and the repo's administrative files.
(when (and (not in-main-worktree)
(file-regular-p base-dir)
(file-readable-p base-dir))
(with-temp-buffer
(insert-file-contents base-dir)
(when (looking-at "gitdir: \\(.*\.git\\)\\(.*\\)$")
(setq base-dir (match-string 1)
sub-dir (concat base-dir (match-string 2))
in-linked-worktree t))))
;; We've found a worktree, either main or linked.
(when (or in-main-worktree in-linked-worktree)
(if external
(emacs-repository-version-git dir)
(or (if in-linked-worktree
(emacs-repository--version-git-1
(expand-file-name "HEAD" sub-dir) base-dir)
(let ((files '("HEAD" "refs/heads/master"))
file rev)
(while (and (not rev)
(setq file (car files)))
(setq file (expand-file-name file base-dir)
files (cdr files)
rev (emacs-repository--version-git-1 file base-dir)))
rev))
;; AFAICS this doesn't work during dumping (bug#20799).
(emacs-repository-version-git dir))))))
Optional argument EXTERNAL is ignored."
(emacs-repository-version-git (or dir source-directory)))
;; We put version info into the executable in the form that `ident' uses.
(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
......
......@@ -2505,6 +2505,35 @@ sys_putenv (char *str)
return unsetenv (str);
}
if (strncmp (str, "TZ=<", 4) == 0)
{
/* MS-Windows does not support POSIX.1-2001 angle-bracket TZ
abbreviation syntax. Convert to POSIX.1-1988 syntax if possible,
and to the undocumented placeholder "ZZZ" otherwise. */
bool supported_abbr = true;
for (char *p = str + 4; *p; p++)
{
if (('0' <= *p && *p <= '9') || *p == '-' || *p == '+')
supported_abbr = false;
else if (*p == '>')
{
ptrdiff_t abbrlen;
if (supported_abbr)
{
abbrlen = p - (str + 4);
memmove (str + 3, str + 4, abbrlen);
}
else
{
abbrlen = 3;
memset (str + 3, 'Z', abbrlen);
}
memmove (str + 3 + abbrlen, p + 1, strlen (p));
break;
}
}
}
return _putenv (str);
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment