summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorPaul Eggert <eggert@cs.ucla.edu>2017-09-25 11:19:07 -0700
committerPaul Eggert <eggert@cs.ucla.edu>2017-09-25 11:19:07 -0700
commitabcb2e62dae6aa26308f7ac9efc89247f89cbe65 (patch)
treefd2c052c3ec67555b0a92dc86da7ecba9b1ab3f6 /lisp
parent0bd61c212fe53fb843a10da9a2da88e110d3785a (diff)
parent49cd561dc62ea6b3fbedab7aef0f020733f4cf09 (diff)
downloademacs-abcb2e62dae6aa26308f7ac9efc89247f89cbe65.tar.gz
Merge from origin/emacs-26
49cd561dc6 * test/lisp/tramp-tests.el (tramp-test21-file-links): Spec... b719f6b20b Loosen strict parsing requirement for desktop files c7a0c13777 * lisp/xdg.el (xdg-thumb-uri): Fix doc string. dc6b3560e5 Fix documentation of `make-frame' and related variables an... 3d3778d82a Accept new `always' value for option `buffer-offer-save' 638f64c40a Improve new NS scrolling variable names d93301242f Document 'replace-buffer-contents' in the manual. 00e4e3e9d2 Fix undecorated frame resizing issues on NS (bug#28512) 820739bbb5 ; * doc/emacs/display.texi (Display Custom): Fix wording. f2b2201594 ; Spelling and URL fixes 0e143b1fc5 Documentation improvements for 'display-line-numbers' f656ccdb43 ; Fix typo d64da52d57 Fix last change in bat-mode.el 908af46abd Fix restoring in GUI sessions desktop saved in TTY sessions 51cbd85454 Improve syntax highlighting in bat-mode 0273916618 Document the 'list-FOO' convention d24ec58540 Expose viewing conditions in CAM02-UCS metric a81d5a3d3f Revert "Set frame size to actual requested size (bug#18215)" 0bf066d4b2 Add tests for Edebug 68baca3ee1 Catch more messages in ert-with-message-capture 28e0c410c9 ; * lisp/mouse.el (secondary-selection-exist-p): Doc fix. 31e1d9ef2f Support setting region from secondary selection and vice v... 047f02f00f Fix new copy-directory bug with empty dirs fbd15836af * doc/lispref/strings.texi (Formatting Strings): Improve i... f16a8d5dbd Fix 2 testsuite tests for MS-Windows 965cffd89c Rename timer-list to list-timers a5fec62b51 Provide native touchpad scrolling on macOS 7b3d1c6beb Fix MinGW64 build broken by recent MinGW64 import libraries c83d0c5fdf Fix crashes in 'move-point-visually' in minibuffer windows 7f3d5f929d * src/emacs.c (usage_message): Don't mention 'find-file'. 6845282200 Fix a minor inaccuracy in the Emacs manual 74d7bb9498 Fix errors in flyspell-post-command-hook 40fdbb01d0 Work on Tramp's file-truename 1a01423b3c Fix bug with make-directory on MS-Windows root 066efb8666 Fix log-view-diff-common when point is after last entry 3f006b56cd Adapt fileio-tests--symlink-failure to Cygwin ee512e9a82 Ignore buffers whose name begins with a space in save-some... 9e1b5bd92c Improve tramp-interrupt-process robustness 8d4223e61b Minor Tramp doc update 331d0e520f Fix gensym 466df76f7d Cleanup in files-tests.el 6359fe630a Remove old cl-assert calls in 'newline' 059184e645 Avoid crash with C-g C-g in GC 541006c536 Fix format-time-string %Z bug with negative tz 679e05eeb9 message-citation-line-format %Z is now tz name 4e8888d438 Use doc-view or pdf-tools on any window-system 5f28f0db73 Fix bug with min and max and NaNs 37b5e661d2 Fix recently-introduced copy-directory bug 6bbbc38b34 Merge from Gnulib 57249fb297 Fix compatibility problem in Tramp 411bec82c4 Avoid GCC 7 compilation warning in eval.c 34a6774daa ; Partially revert c3445aed5194
Diffstat (limited to 'lisp')
-rw-r--r--lisp/calendar/cal-tex.el2
-rw-r--r--lisp/emacs-lisp/ert-x.el57
-rw-r--r--lisp/emacs-lisp/subr-x.el2
-rw-r--r--lisp/emacs-lisp/timer-list.el6
-rw-r--r--lisp/files.el42
-rw-r--r--lisp/frame.el20
-rw-r--r--lisp/frameset.el13
-rw-r--r--lisp/gnus/message.el1
-rw-r--r--lisp/mouse.el28
-rw-r--r--lisp/mwheel.el1
-rw-r--r--lisp/net/mailcap.el6
-rw-r--r--lisp/net/tramp-adb.el2
-rw-r--r--lisp/net/tramp-compat.el33
-rw-r--r--lisp/net/tramp-sh.el28
-rw-r--r--lisp/net/tramp-smb.el10
-rw-r--r--lisp/net/tramp.el33
-rw-r--r--lisp/org/ChangeLog.14
-rw-r--r--lisp/progmodes/bat-mode.el6
-rw-r--r--lisp/simple.el39
-rw-r--r--lisp/subr.el7
-rw-r--r--lisp/term/ns-win.el19
-rw-r--r--lisp/textmodes/ispell.el6
-rw-r--r--lisp/vc/log-view.el14
-rw-r--r--lisp/xdg.el4
24 files changed, 245 insertions, 138 deletions
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 72db03e5e60..1d295606f23 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -266,7 +266,7 @@ specified in ARGS. When ARGS is omitted, by default the option
\"12pt,a4paper\" is passed. When ARGS has any other value, then
no option is passed to the class.
-Insert the \"\\usepacakge{geometry}\" directive when ARGS
+Insert the \"\\usepackage{geometry}\" directive when ARGS
contains the \"landscape\" string."
(set-buffer (generate-new-buffer cal-tex-buffer))
(save-match-data
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 6d9a7d9211a..71d46c11077 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -286,27 +286,60 @@ BUFFER defaults to current buffer. Does not modify BUFFER."
(defmacro ert-with-message-capture (var &rest body)
- "Execute BODY while collecting anything written with `message' in VAR.
+ "Execute BODY while collecting messages in VAR.
-Capture all messages produced by `message' when it is called from
-Lisp, and concatenate them separated by newlines into one string.
+Capture messages issued by Lisp code and concatenate them
+separated by newlines into one string. This includes messages
+written by `message' as well as objects printed by `print',
+`prin1' and `princ' to the echo area. Messages issued from C
+code using the above mentioned functions will not be captured.
This is useful for separating the issuance of messages by the
code under test from the behavior of the *Messages* buffer."
(declare (debug (symbolp body))
(indent 1))
- (let ((g-advice (gensym)))
+ (let ((g-message-advice (gensym))
+ (g-print-advice (gensym))
+ (g-collector (gensym)))
`(let* ((,var "")
- (,g-advice (lambda (func &rest args)
- (if (or (null args) (equal (car args) ""))
- (apply func args)
- (let ((msg (apply #'format-message args)))
- (setq ,var (concat ,var msg "\n"))
- (funcall func "%s" msg))))))
- (advice-add 'message :around ,g-advice)
+ (,g-collector (lambda (msg) (setq ,var (concat ,var msg))))
+ (,g-message-advice (ert--make-message-advice ,g-collector))
+ (,g-print-advice (ert--make-print-advice ,g-collector)))
+ (advice-add 'message :around ,g-message-advice)
+ (advice-add 'prin1 :around ,g-print-advice)
+ (advice-add 'princ :around ,g-print-advice)
+ (advice-add 'print :around ,g-print-advice)
(unwind-protect
(progn ,@body)
- (advice-remove 'message ,g-advice)))))
+ (advice-remove 'print ,g-print-advice)
+ (advice-remove 'princ ,g-print-advice)
+ (advice-remove 'prin1 ,g-print-advice)
+ (advice-remove 'message ,g-message-advice)))))
+
+(defun ert--make-message-advice (collector)
+ "Create around advice for `message' for `ert-collect-messages'.
+COLLECTOR will be called with the message before it is passed
+to the real `message'."
+ (lambda (func &rest args)
+ (if (or (null args) (equal (car args) ""))
+ (apply func args)
+ (let ((msg (apply #'format-message args)))
+ (funcall collector (concat msg "\n"))
+ (funcall func "%s" msg)))))
+
+(defun ert--make-print-advice (collector)
+ "Create around advice for print functions for `ert-collect-messages'.
+The created advice function will just call the original function
+unless the output is going to the echo area (when PRINTCHARFUN is
+t or PRINTCHARFUN is nil and `standard-output' is t). If the
+output is destined for the echo area, the advice function will
+convert it to a string and pass it to COLLECTOR first."
+ (lambda (func object &optional printcharfun)
+ (if (not (eq t (or printcharfun standard-output)))
+ (funcall func object printcharfun)
+ (funcall collector (with-output-to-string
+ (funcall func object)))
+ (funcall func object printcharfun))))
(provide 'ert-x)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 077ad22c75d..edba6550fa2 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -128,7 +128,7 @@ binding value is nil. If all are non-nil, the value of THEN is
returned, or the last form in ELSE is returned.
Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
-SYMBOL to the value of VALUEFORM). An element can additionally
+SYMBOL to the value of VALUEFORM. An element can additionally
be of the form (VALUEFORM), which is evaluated and checked for
nil; i.e. SYMBOL can be omitted if only the test result is of
interest."
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 44a315f9806..69c67419835 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -25,7 +25,7 @@
;;; Code:
;;;###autoload
-(defun timer-list (&optional _ignore-auto _nonconfirm)
+(defun list-timers (&optional _ignore-auto _nonconfirm)
"List all timers in a buffer."
(interactive)
(pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
@@ -67,7 +67,7 @@
(goto-char (point-min)))
;; This command can be destructive if they don't know what they are
;; doing. Kids, don't try this at home!
-;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
+;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
(defvar timer-list-mode-map
(let ((map (make-sparse-keymap)))
@@ -84,7 +84,7 @@
(setq bidi-paragraph-direction 'left-to-right)
(setq truncate-lines t)
(buffer-disable-undo)
- (setq-local revert-buffer-function 'timer-list)
+ (setq-local revert-buffer-function #'list-timers)
(setq buffer-read-only t)
(setq header-line-format
(format "%4s %10s %8s %s"
diff --git a/lisp/files.el b/lisp/files.el
index fe7cb1a8a94..336bbc8648d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -150,8 +150,13 @@ Called with an absolute file name as argument, it returns t to enable backup.")
(defcustom buffer-offer-save nil
"Non-nil in a buffer means always offer to save buffer on exit.
Do so even if the buffer is not visiting a file.
-Automatically local in all buffers."
- :type 'boolean
+Automatically local in all buffers.
+
+Set to the symbol `always' to offer to save buffer whenever
+`save-some-buffers' is called."
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "On Emacs exit" t)
+ (const :tag "Whenever save-some-buffers is called" always))
:group 'backup)
(make-variable-buffer-local 'buffer-offer-save)
(put 'buffer-offer-save 'permanent-local t)
@@ -5190,12 +5195,9 @@ change the additional actions you can take on files."
(not (buffer-base-buffer buffer))
(or
(buffer-file-name buffer)
- (and pred
- (progn
- (set-buffer buffer)
- (and buffer-offer-save (> (buffer-size) 0))))
- (buffer-local-value
- 'write-contents-functions buffer))
+ (with-current-buffer buffer
+ (or (eq buffer-offer-save 'always)
+ (and pred buffer-offer-save (> (buffer-size) 0)))))
(or (not (functionp pred))
(with-current-buffer buffer (funcall pred)))
(if arg
@@ -5336,7 +5338,7 @@ instance of such commands."
"Make directory DIR if it is not already a directory. Return nil."
(condition-case err
(make-directory-internal dir)
- (file-already-exists
+ (error
(unless (file-directory-p dir)
(signal (car err) (cdr err))))))
@@ -5372,7 +5374,7 @@ raised."
(while (progn
(setq parent (directory-file-name
(file-name-directory dir)))
- (condition-case err
+ (condition-case ()
(files--ensure-directory dir)
(file-missing
;; Do not loop if root does not exist (Bug#2309).
@@ -5544,16 +5546,14 @@ into NEWNAME instead."
;; If NEWNAME is not a directory name, create it;
;; that is where we will copy the files of DIRECTORY.
(make-directory newname parents))
- ;; If NEWNAME is a directory name and COPY-CONTENTS
- ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
- ((not copy-contents)
- (setq newname (concat newname
- (file-name-nondirectory directory)))
- (and (file-exists-p newname)
- (not (file-directory-p newname))
- (error "Cannot overwrite non-directory %s with a directory"
- newname))
- (make-directory newname t)))
+ ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
+ ;; create NEWNAME if it is not already a directory;
+ ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
+ ((if copy-contents
+ (or parents (not (file-directory-p newname)))
+ (setq newname (concat newname
+ (file-name-nondirectory directory))))
+ (make-directory (directory-file-name newname) parents)))
;; Copy recursively.
(dolist (file
@@ -5565,7 +5565,7 @@ into NEWNAME instead."
(filetype (car (file-attributes file))))
(cond
((eq filetype t) ; Directory but not a symlink.
- (copy-directory file newname keep-time parents))
+ (copy-directory file target keep-time parents t))
((stringp filetype) ; Symbolic link
(make-symbolic-link filetype target t))
((copy-file file target t keep-time)))))
diff --git a/lisp/frame.el b/lisp/frame.el
index 5f0e97d5b07..76c1842455c 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -604,11 +604,12 @@ new frame."
(select-frame (make-frame))))
(defvar before-make-frame-hook nil
- "Functions to run before a frame is created.")
+ "Functions to run before `make-frame' creates a new frame.")
(defvar after-make-frame-functions nil
- "Functions to run after a frame is created.
-The functions are run with one arg, the newly created frame.")
+ "Functions to run after `make-frame' created a new frame.
+The functions are run with one argument, the newly created
+frame.")
(defvar after-setting-font-hook nil
"Functions to run after a frame's font has been changed.")
@@ -617,7 +618,7 @@ The functions are run with one arg, the newly created frame.")
(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
(defvar frame-inherited-parameters '()
- "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
+ "Parameters `make-frame' copies from the selected to the new frame.")
(defvar x-display-name)
@@ -632,9 +633,6 @@ form (NAME . VALUE), for example:
(width . NUMBER) The frame should be NUMBER characters in width.
(height . NUMBER) The frame should be NUMBER text lines high.
-You cannot specify either `width' or `height', you must specify
-neither or both.
-
(minibuffer . t) The frame should have a minibuffer.
(minibuffer . nil) The frame should have no minibuffer.
(minibuffer . only) The frame should contain only a minibuffer.
@@ -650,10 +648,10 @@ neither or both.
In addition, any parameter specified in `default-frame-alist',
but not present in PARAMETERS, is applied.
-Before creating the frame (via `frame-creation-function-alist'),
-this function runs the hook `before-make-frame-hook'. After
-creating the frame, it runs the hook `after-make-frame-functions'
-with one arg, the newly created frame.
+Before creating the frame (via `frame-creation-function'), this
+function runs the hook `before-make-frame-hook'. After creating
+the frame, it runs the hook `after-make-frame-functions' with one
+argument, the newly created frame.
If a display parameter is supplied and a window-system is not,
guess the window-system from the display.
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 661f0aee273..593451a4d75 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -447,7 +447,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
(buffer-predicate . :never)
(buried-buffer-list . :never)
(delete-before . :never)
- (font . frameset-filter-shelve-param)
+ (font . frameset-filter-font-param)
(foreground-color . frameset-filter-sanitize-color)
(fullscreen . frameset-filter-shelve-param)
(GUI:font . frameset-filter-unshelve-param)
@@ -631,6 +631,17 @@ see `frameset-filter-alist'."
(setcdr found val)
nil))))
+(defun frameset-filter-font-param (current filtered parameters saving
+ &optional prefix)
+ "When switching from a tty frame to a GUI frame, remove the FONT param.
+
+When switching from a GUI frame to a tty frame, behave
+as `frameset-filter-shelve-param' does."
+ (or saving
+ (if (frameset-switch-to-gui-p parameters)
+ (frameset-filter-shelve-param current filtered parameters saving
+ prefix))))
+
(defun frameset-filter-iconified (_current _filtered parameters saving)
"Remove CURRENT when saving an iconified frame.
This is used for positional parameters `left' and `top', which are
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 690dd28c8a4..a9e66cede16 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -991,7 +991,6 @@ are replaced:
%F The first name if present, e.g.: \"John\", else fall
back to the mail address.
%L The last name if present, e.g.: \"Doe\".
- %Z, %z The time zone in the numeric form, e.g.:\"+0000\".
All other format specifiers are passed to `format-time-string'
which is called using the date from the article your replying to, but
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 3f448f018a4..169d2632f4f 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1916,6 +1916,34 @@ CLICK position, kill the secondary selection."
(> (length str) 0)
(gui-set-selection 'SECONDARY str))))
+(defun secondary-selection-exist-p ()
+ "Return non-nil if the secondary selection exists in the current buffer."
+ (memq mouse-secondary-overlay (overlays-in (point-min) (point-max))))
+
+(defun secondary-selection-to-region ()
+ "Set beginning and end of the region to those of the secondary selection.
+This puts mark and point at the beginning and the end of the
+secondary selection, respectively. This works when the secondary
+selection exists and the region does not exist in current buffer;
+the secondary selection will be deleted afterward.
+If the region is active, or the secondary selection doesn't exist,
+this function does nothing."
+ (when (and (not (region-active-p))
+ (secondary-selection-exist-p))
+ (let ((beg (overlay-start mouse-secondary-overlay))
+ (end (overlay-end mouse-secondary-overlay)))
+ (push-mark beg t t)
+ (goto-char end))
+ ;; Delete the secondary selection on current buffer.
+ (delete-overlay mouse-secondary-overlay)))
+
+(defun secondary-selection-from-region ()
+ "Set beginning and end of the secondary selection to those of the region.
+When there is no region, this function does nothing."
+ (when (region-active-p) ; Create the secondary selection from the region.
+ (delete-overlay mouse-secondary-overlay) ; Delete the secondary selection even on a different buffer.
+ (move-overlay mouse-secondary-overlay (region-beginning) (region-end))))
+
(defcustom mouse-buffer-menu-maxlen 20
"Number of buffers in one pane (submenu) of the buffer menu.
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 2956ba55162..0c0dcb3beb1 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -232,6 +232,7 @@ non-Windows systems."
;; When the double-mouse-N comes in, a mouse-N has been executed already,
;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
(setq amt (* amt (event-click-count event))))
+ (when (numberp amt) (setq amt (* amt (event-line-count event))))
(unwind-protect
(let ((button (mwheel-event-button event)))
(cond ((eq button mouse-wheel-down-event)
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index ed35c220ec5..86587466ef5 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -165,9 +165,13 @@ is consulted."
(type . "application/zip")
("copiousoutput"))
("pdf"
+ (viewer . pdf-view-mode)
+ (type . "application/pdf")
+ (test . window-system))
+ ("pdf"
(viewer . doc-view-mode)
(type . "application/pdf")
- (test . (eq window-system 'x)))
+ (test . window-system))
("pdf"
(viewer . "gv -safer %s")
(type . "application/pdf")
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c22869d2cc2..760d020f672 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Remote newname.
(when (and (file-directory-p newname)
- (directory-name-p newname))
+ (tramp-compat-directory-name-p newname))
(setq newname
(expand-file-name
(file-name-nondirectory filename) newname)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 5d9a1fd1967..214ad040a17 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,8 +23,9 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 26. This
-;; package provides compatibility functions for Emacs 24 and Emacs 25.
+;; Tramp's main Emacs version for development is Emacs 27. This
+;; package provides compatibility functions for Emacs 24, Emacs 25 and
+;; Emacs 26.
;;; Code:
@@ -104,6 +105,10 @@ Add the extension of F, if existing."
'tramp-error vec-or-proc
(if (fboundp 'user-error) 'user-error 'error) format args))
+;; `default-toplevel-value' has been declared in Emacs 24.4.
+(unless (fboundp 'default-toplevel-value)
+ (defalias 'default-toplevel-value 'symbol-value))
+
;; `file-attribute-*' are introduced in Emacs 25.1.
(if (fboundp 'file-attribute-type)
@@ -163,14 +168,23 @@ This is a floating point number if the size is too large for an integer."
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes)))
-;; `default-toplevel-value' has been declared in Emacs 24.4.
-(unless (fboundp 'default-toplevel-value)
- (defalias 'default-toplevel-value 'symbol-value))
-
;; `format-message' is new in Emacs 25.1.
(unless (fboundp 'format-message)
(defalias 'format-message 'format))
+;; `directory-name-p' is new in Emacs 25.1.
+(if (fboundp 'directory-name-p)
+ (defalias 'tramp-compat-directory-name-p 'directory-name-p)
+ (defsubst tramp-compat-directory-name-p (name)
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\))))))
+
;; `file-missing' is introduced in Emacs 26.1.
(defconst tramp-file-missing
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
@@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is unquoted."
((eq tramp-syntax 'sep) 'separate)
(t tramp-syntax)))
-;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
-(eval-after-load 'tramp
- '(unless
- (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
- (tramp-compat-funcall
- (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
-
(provide 'tramp-compat)
;;; TODO:
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7df5aa3b7b0..a744a53ca42 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -613,7 +613,7 @@ use Cwd \"realpath\";
sub myrealpath {
my ($file) = @_;
- return realpath($file) if -e $file;
+ return realpath($file) if (-e $file || -l $file);
}
sub recursive {
@@ -1139,12 +1139,7 @@ component is used as the target of the symlink."
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (setq result (buffer-substring (point-min) (point-at-eol))))
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename)))
+ (setq result (buffer-substring (point-min) (point-at-eol)))))
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
@@ -1198,16 +1193,6 @@ component is used as the target of the symlink."
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
- ;; If the symlink was absolute, we'll get a
- ;; string like "/user@host:/some/target";
- ;; extract the "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host"
- symlink-target))
- (setq symlink-target localname))
(setq steps
(append
(split-string symlink-target "/" 'omit) steps)))
@@ -1226,6 +1211,13 @@ component is used as the target of the symlink."
"/"))
(when (string= "" result)
(setq result "/")))))
+
+ ;; Detect cycle.
+ (when (and (file-symlink-p filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" filename))
;; If the resulting localname looks remote, we must quote it
;; for security reasons.
(when (or quoted (file-remote-p result))
@@ -1985,7 +1977,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
;; scp or rsync DTRT.
(progn
(when (and (file-directory-p newname)
- (not (directory-name-p newname)))
+ (not (tramp-compat-directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 49695666707..35aa8110946 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -415,7 +415,7 @@ pass to the OPERATION."
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" dirname newname)
(when (and (file-directory-p newname)
- (not (directory-name-p newname)))
+ (not (tramp-compat-directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(cond
;; We must use a local temporary directory.
@@ -535,7 +535,7 @@ pass to the OPERATION."
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
+ (when t1 (delete-directory tmpdir 'recursive))))
;; Handle KEEP-DATE argument.
(when keep-date
@@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Remote newname.
(when (and (file-directory-p newname)
- (directory-name-p newname))
+ (tramp-compat-directory-name-p newname))
(setq newname
(expand-file-name (file-name-nondirectory filename) newname)))
@@ -1583,6 +1583,10 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
"Read entries which match DIRECTORY.
Either the shares are listed, or the `dir' command is executed.
Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
+ ;; If CIFS capabilities are enabled, symlinks are not listed
+ ;; by `dir'. This is a consequence of
+ ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
+ ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
(with-tramp-file-property v localname "file-entries"
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 45776078be3..3573eeb7d49 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3169,7 +3169,7 @@ User is always nil."
(defun tramp-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- (let ((result filename)
+ (let ((result (expand-file-name filename))
(numchase 0)
;; Don't make the following value larger than
;; necessary. People expect an error message in a
@@ -3180,7 +3180,7 @@ User is always nil."
symlink-target)
(format
"%s%s"
- (with-parsed-tramp-file-name (expand-file-name result) v1
+ (with-parsed-tramp-file-name result v1
(with-tramp-file-property v1 v1-localname "file-truename"
(while (and (setq symlink-target (file-symlink-p result))
(< numchase numchase-limit))
@@ -3850,7 +3850,7 @@ Erase echoed commands if exists."
(min (+ (point-min) tramp-echo-mark-marker-length)
(point-max))))))
;; No echo to be handled, now we can look for the regexp.
- ;; Sometimes, lines are much to long, and we run into a "Stack
+ ;; Sometimes, lines are much too long, and we run into a "Stack
;; overflow in regexp matcher". For example, //DIRED// lines of
;; directory listings with some thousand files. Therefore, we
;; look from the end.
@@ -4547,16 +4547,23 @@ Only works for Bourne-like shells."
(t process)))
pid)
;; If it's a Tramp process, send the INT signal remotely.
- (when (and (processp proc) (process-live-p proc)
- (setq pid (process-get proc 'remote-pid)))
- (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
- ;; This is for tramp-sh.el. Other backends do not support this (yet).
- (tramp-compat-funcall
- 'tramp-send-command
- (tramp-get-connection-property proc "vector" nil)
- (format "kill -2 %d" pid))
- ;; Report success.
- proc)))
+ (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
+ (if (not (process-live-p proc))
+ (tramp-error proc 'error "Process %s is not active" proc)
+ (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
+ ;; This is for tramp-sh.el. Other backends do not support this (yet).
+ (tramp-compat-funcall
+ 'tramp-send-command
+ (tramp-get-connection-property proc "vector" nil)
+ (format "kill -2 %d" pid))
+ ;; Wait, until the process has disappeared.
+ (with-timeout
+ (1 (tramp-error proc 'error "Process %s did not interrupt" proc))
+ (while (process-live-p proc)
+ ;; We cannot run `tramp-accept-process-output', it blocks timers.
+ (accept-process-output proc 0.1)))
+ ;; Report success.
+ proc))))
;; `interrupt-process-functions' exists since Emacs 26.1.
(when (boundp 'interrupt-process-functions)
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 366a3ee9fcd..ee50f6fb040 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -5015,10 +5015,10 @@
* ox-latex.el (org-latex-listings): Update docstring.
* org-pcomplete.el (pcomplete/org-mode/file-option/options):
- Apply changes to export back-end definiton.
+ Apply changes to export back-end definition.
* org.el (org-get-export-keywords): Apply changes to export
- back-end definiton.
+ back-end definition.
* ox-html.el (org-html--format-toc-headline): Make use of
anonymous back-ends.
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index f4852fe5b6b..102c3186200 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -84,11 +84,11 @@
. 'bat-label-face)
("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
(2 font-lock-variable-name-face))
- ("%\\(\\(\\sw\\|\\s_\\)+\\)%"
+ ("%\\([^%~ \n]+\\)%?"
(1 font-lock-variable-name-face))
- ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable!
+ ("!\\([^!%~ \n]+\\)!?" ; delayed-expansion !variable!
(1 font-lock-variable-name-face))
- ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
+ ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\|_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
(1 font-lock-variable-name-face nil t) ; PATH expansion
(2 font-lock-variable-name-face)) ; iteration variable or positional parameter
("[ =][-/]+\\(\\w+\\)"
diff --git a/lisp/simple.el b/lisp/simple.el
index 1ffe1810672..4e42fd52415 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -434,10 +434,6 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
- ;; We are not going to insert any newlines if arg is
- ;; non-positive.
- (or (and (numberp arg) (<= arg 0))
- (cl-assert (eq ?\n (char-before))))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
@@ -456,25 +452,22 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (unwind-protect
- (if (not interactive)
- ;; FIXME: For non-interactive uses, many calls actually
- ;; just want (insert "\n"), so maybe we should do just
- ;; that, so as to avoid the risk of filling or running
- ;; abbrevs unexpectedly.
- (let ((post-self-insert-hook (list postproc)))
- (self-insert-command arg))
- (unwind-protect
- (progn
- (add-hook 'post-self-insert-hook postproc nil t)
- (self-insert-command arg))
- ;; We first used let-binding to protect the hook, but that
- ;; was naive since add-hook affects the symbol-default
- ;; value of the variable, whereas the let-binding might
- ;; only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc t)))
- (cl-assert (not (member postproc post-self-insert-hook)))
- (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
+ (if (not interactive)
+ ;; FIXME: For non-interactive uses, many calls actually
+ ;; just want (insert "\n"), so maybe we should do just
+ ;; that, so as to avoid the risk of filling or running
+ ;; abbrevs unexpectedly.
+ (let ((post-self-insert-hook (list postproc)))
+ (self-insert-command arg))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc nil t)
+ (self-insert-command arg))
+ ;; We first used let-binding to protect the hook, but that
+ ;; was naive since add-hook affects the symbol-default
+ ;; value of the variable, whereas the let-binding might
+ ;; only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc t))))
nil)
(defun set-hard-newline-properties (from to)
diff --git a/lisp/subr.el b/lisp/subr.el
index 79ae1f4830d..cf15ec287ff 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -289,7 +289,7 @@ The name is made by appending `gensym-counter' to PREFIX.
PREFIX is a string, and defaults to \"g\"."
(let ((num (prog1 gensym-counter
(setq gensym-counter (1+ gensym-counter)))))
- (make-symbol (format "%s%d" prefix num))))
+ (make-symbol (format "%s%d" (or prefix "g") num))))
(defun ignore (&rest _ignore)
"Do nothing and return nil.
@@ -1270,6 +1270,11 @@ See `event-start' for a description of the value returned."
"Return the multi-click count of EVENT, a click or drag event.
The return value is a positive integer."
(if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
+
+(defsubst event-line-count (event)
+ "Return the line count of EVENT, a mousewheel event.
+The return value is a positive integer."
+ (if (and (consp event) (integerp (nth 3 event))) (nth 3 event) 1))
;;;; Extracting fields of the positions in an event.
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 68b659bf751..bc211ea9589 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -736,6 +736,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(global-unset-key [horizontal-scroll-bar drag-mouse-1])
+;;;; macOS-like defaults for trackpad and mouse wheel scrolling on
+;;;; macOS 10.7+.
+
+;; FIXME: This doesn't look right. Is there a better way to do this
+;; that keeps customize happy?
+(let ((appkit-version (progn
+ (string-match "^appkit-\\([^\s-]*\\)" ns-version-string)
+ (string-to-number (match-string 1 ns-version-string)))))
+ ;; Appkit 1138 ~= macOS 10.7.
+ (when (and (featurep 'cocoa) (>= appkit-version 1138))
+ (setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control))))
+ (put 'mouse-wheel-scroll-amount 'customized-value
+ (list (custom-quote (symbol-value 'mouse-wheel-scroll-amount))))
+
+ (setq mouse-wheel-progressive-speed nil)
+ (put 'mouse-wheel-progressive-speed 'customized-value
+ (list (custom-quote (symbol-value 'mouse-wheel-progressive-speed))))))
+
+
;;;; Color support.
;; Functions for color panel + drag
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0c0a51e7df0..6a169622f52 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1492,8 +1492,10 @@ This is passed to the Ispell process using the `-p' switch.")
(assoc ispell-current-dictionary ispell-local-dictionary-alist)
(assoc ispell-current-dictionary ispell-dictionary-alist)
(error "No data for dictionary \"%s\" in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'"
- ispell-current-dictionary))))
- (decode-coding-string (nth n slot) (ispell-get-coding-system) t)))
+ ispell-current-dictionary)))
+ (str (nth n slot)))
+ (if (stringp str)
+ (decode-coding-string str (ispell-get-coding-system) t))))
(defun ispell-get-casechars ()
(ispell-get-decoded-string 1))
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 52f56ed990f..d6963d0a1b9 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -608,10 +608,16 @@ considered file(s)."
(log-view-diff-common beg end t)))
(defun log-view-diff-common (beg end &optional whole-changeset)
- (let ((to (log-view-current-tag beg))
- (fr (log-view-current-tag end)))
- (when (string-equal fr to)
- ;; TO and FR are the same, look at the previous revision.
+ (let* ((to (log-view-current-tag beg))
+ (fr-entry (log-view-current-entry end))
+ (fr (cadr fr-entry)))
+ ;; When TO and FR are the same, or when point is on a line after
+ ;; the last entry, look at the previous revision.
+ (when (or (string-equal fr to)
+ (>= (point)
+ (save-excursion
+ (goto-char (car fr-entry))
+ (forward-line))))
(setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr)))
(vc-diff-internal
t (list log-view-vc-backend
diff --git a/lisp/xdg.el b/lisp/xdg.el
index e94fa8ec924..76106f42586 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -84,7 +84,7 @@
(defun xdg-thumb-uri (filename)
"Return the canonical URI for FILENAME.
-If FILENAME has absolute path /foo/bar.jpg, its canonical URI is
+If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is
file:///foo/bar.jpg"
(concat "file://" (expand-file-name filename)))
@@ -197,8 +197,6 @@ Optional argument GROUP defaults to the string \"Desktop Entry\"."
(unless (looking-at xdg-desktop-group-regexp)
(error "Expected group name! Instead saw: %s"
(buffer-substring (point) (point-at-eol))))
- (unless (equal (match-string 1) "Desktop Entry")
- (error "Wrong first group: %s" (match-string 1)))
(when group
(while (and (re-search-forward xdg-desktop-group-regexp nil t)
(not (equal (match-string 1) group)))))