diff options
| author | Paul Eggert <eggert@cs.ucla.edu> | 2017-09-25 11:19:07 -0700 |
|---|---|---|
| committer | Paul Eggert <eggert@cs.ucla.edu> | 2017-09-25 11:19:07 -0700 |
| commit | abcb2e62dae6aa26308f7ac9efc89247f89cbe65 (patch) | |
| tree | fd2c052c3ec67555b0a92dc86da7ecba9b1ab3f6 /lisp | |
| parent | 0bd61c212fe53fb843a10da9a2da88e110d3785a (diff) | |
| parent | 49cd561dc62ea6b3fbedab7aef0f020733f4cf09 (diff) | |
| download | emacs-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.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ert-x.el | 57 | ||||
| -rw-r--r-- | lisp/emacs-lisp/subr-x.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/timer-list.el | 6 | ||||
| -rw-r--r-- | lisp/files.el | 42 | ||||
| -rw-r--r-- | lisp/frame.el | 20 | ||||
| -rw-r--r-- | lisp/frameset.el | 13 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 1 | ||||
| -rw-r--r-- | lisp/mouse.el | 28 | ||||
| -rw-r--r-- | lisp/mwheel.el | 1 | ||||
| -rw-r--r-- | lisp/net/mailcap.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 33 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 28 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 10 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 33 | ||||
| -rw-r--r-- | lisp/org/ChangeLog.1 | 4 | ||||
| -rw-r--r-- | lisp/progmodes/bat-mode.el | 6 | ||||
| -rw-r--r-- | lisp/simple.el | 39 | ||||
| -rw-r--r-- | lisp/subr.el | 7 | ||||
| -rw-r--r-- | lisp/term/ns-win.el | 19 | ||||
| -rw-r--r-- | lisp/textmodes/ispell.el | 6 | ||||
| -rw-r--r-- | lisp/vc/log-view.el | 14 | ||||
| -rw-r--r-- | lisp/xdg.el | 4 |
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))))) |
