From 0f286ca85a259575b67dba520ff72e59cc011426 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 21 Oct 2017 18:51:25 +0200 Subject: Fix Bug#28889 * lisp/net/tramp.el: Change autoload cookie to tramp-autoload cookie. (tramp-completion-file-name-regexp-default) (tramp-completion-file-name-handler-alist) (tramp-completion-file-name-handler): Remove autoload cookie. (tramp-initial-completion-file-name-regexp): Remove. (tramp-autoload-file-name-regexp): New defconst. (tramp-register-autoload-file-name-handlers): Use it. (with-parsed-tramp-file-name): Adapt docstring. Compute `tramp-file-name' slots. (Bug#28889) --- lisp/net/tramp.el | 51 ++++++++++++++++++++++++++------------------------- 1 file changed, 26 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c8b6e68f719..3d6934783f5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -660,7 +660,7 @@ Useful for \"rsync\" like methods.") (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) -;;;###autoload +;;;###tramp-autoload (defcustom tramp-syntax 'default "Tramp filename syntax to be used. @@ -978,7 +978,6 @@ This regexp should match Tramp file names but no other file names. When calling `tramp-register-file-name-handlers', the initial value is overwritten by the car of `tramp-file-name-structure'.") -;;;###autoload (defconst tramp-completion-file-name-regexp-default (concat "\\`/\\(" @@ -1042,10 +1041,19 @@ updated after changing this variable. Also see `tramp-file-name-structure'.") ;;;###autoload -(defconst tramp-initial-completion-file-name-regexp - tramp-completion-file-name-regexp-default - "Value for `tramp-completion-file-name-regexp' for autoload. -It must match the initial `tramp-syntax' settings.") +(defconst tramp-autoload-file-name-regexp + (concat + "\\`/" + (if (memq system-type '(cygwin windows-nt)) + ;; The method is either "-", or at least two characters. + "\\(-\\|[^/|:]\\{2,\\}\\)" + ;; At least one character for method. + "[^/|:]+") + ":\\'") + "Regular expression matching file names handled by Tramp autoload. +It must match the initial `tramp-syntax' settings. It should not +match file names at root of the underlying local file system, +like \"/sys\" or \"/C:\".") ;; Chunked sending kludge. We set this to 500 for black-listed constellations ;; known to have a bug in `process-send-string'; some ssh connections appear @@ -1186,7 +1194,6 @@ means to use always cached values for the directory contents." (defvar tramp-current-connection nil "Last connection timestamp.") -;;;###autoload (defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) @@ -1740,20 +1747,22 @@ Second arg VAR is a symbol. It is used as a variable name to hold the filename structure. It is also used as a prefix for the variables holding the components. For example, if VAR is the symbol `foo', then `foo' will be bound to the whole structure, `foo-method' will be bound to -the method component, and so on for `foo-user', `foo-host', `foo-localname', -`foo-hop'. +the method component, and so on for `foo-user', `foo-domain', `foo-host', +`foo-port', `foo-localname', `foo-hop'. Remaining args are Lisp expressions to be evaluated (inside an implicit `progn'). If VAR is nil, then we bind `v' to the structure and `method', `user', -`host', `localname', `hop' to the components." +`domain', `host', `port', `localname', `hop' to the components." (let ((bindings (mapcar (lambda (elem) `(,(if var (intern (format "%s-%s" var elem)) elem) (,(intern (format "tramp-file-name-%s" elem)) ,(or var 'v)))) - '(method user domain host port localname hop)))) + (eval-and-compile + (cdr + (mapcar 'car (cl-struct-slot-info 'tramp-file-name))))))) `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename)) ,@bindings) ;; We don't know which of those vars will be used, so we bind them all, @@ -2281,7 +2290,6 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; we don't do anything. (tramp-run-real-handler operation args)))) -;;;###autoload (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler. Falls back to normal file name handler if no Tramp file name handler exists." @@ -2304,17 +2312,9 @@ Falls back to normal file name handler if no Tramp file name handler exists." (progn (defun tramp-register-autoload-file-name-handlers () "Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist - (cons tramp-initial-file-name-regexp + (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) - (put 'tramp-autoload-file-name-handler 'safe-magic t) - - (add-to-list 'file-name-handler-alist - (cons tramp-initial-completion-file-name-regexp - 'tramp-completion-file-name-handler)) - (put 'tramp-completion-file-name-handler 'safe-magic t) - ;; Mark `operations' the handler is responsible for. - (put 'tramp-completion-file-name-handler 'operations - (mapcar 'car tramp-completion-file-name-handler-alist)))) + (put 'tramp-autoload-file-name-handler 'safe-magic t))) ;;;###autoload (tramp-register-autoload-file-name-handlers) @@ -2455,7 +2455,8 @@ not in completion mode." ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of -;; tramp-file-name structures. For all of them we return possible completions. +;; `tramp-file-name' structures. For all of them we return possible +;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." @@ -2536,9 +2537,9 @@ not in completion mode." (tramp-connectable-p (expand-file-name filename directory))) (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) -;; I misuse a little bit the tramp-file-name structure in order to +;; I misuse a little bit the `tramp-file-name' structure in order to ;; handle completion possibilities for partial methods / user names / -;; host names. Return value is a list of tramp-file-name structures +;; host names. Return value is a list of `tramp-file-name' structures ;; according to possible completions. If "localname" is non-nil it ;; means there shouldn't be a completion anymore. -- cgit v1.2.3 From 9e4265ef91bd659a5fac49fbe7dc34b91f89d4ed Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 15 Oct 2017 16:41:17 -0400 Subject: Ignore string properties when saving eshell history (Bug#28700) * lisp/eshell/em-hist.el (eshell-write-history): Remove properties before inserting history strings. (eshell-read-history): Remove obsolete comment. * test/lisp/eshell/em-hist-tests.el (eshell-write-readonly-history): New test. --- lisp/eshell/em-hist.el | 5 +++-- test/lisp/eshell/em-hist-tests.el | 39 +++++++++++++++++++++++++++++++++++++++ test/lisp/eshell/eshell-tests.el | 2 +- 3 files changed, 43 insertions(+), 3 deletions(-) create mode 100644 test/lisp/eshell/em-hist-tests.el (limited to 'lisp') diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 1ab3c60b2c7..8084c126530 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -444,7 +444,6 @@ line, with the most recent command last. See also (ignore-dups eshell-hist-ignoredups)) (with-temp-buffer (insert-file-contents file) - ;; Save restriction in case file is already visited... ;; Watch for those date stamps in history files! (goto-char (point-max)) (while (and (< count size) @@ -488,7 +487,9 @@ See also `eshell-read-history'." (while (> index 0) (setq index (1- index)) (let ((start (point))) - (insert (ring-ref ring index) ?\n) + ;; Remove properties before inserting, to avoid trouble + ;; with read-only strings (Bug#28700). + (insert (substring-no-properties (ring-ref ring index)) ?\n) (subst-char-in-region start (1- (point)) ?\n ?\177))) (eshell-with-private-file-modes (write-region (point-min) (point-max) file append diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el new file mode 100644 index 00000000000..7e0d6142812 --- /dev/null +++ b/test/lisp/eshell/em-hist-tests.el @@ -0,0 +1,39 @@ +;;; tests/em-hist-tests.el --- em-hist test suite + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'em-hist) + +(ert-deftest eshell-write-readonly-history () + "Test that having read-only strings in history is okay." + (let ((histfile (make-temp-file "eshell-history")) + (eshell-history-ring (make-ring 2))) + (ring-insert eshell-history-ring + (propertize "echo foo" 'read-only t)) + (ring-insert eshell-history-ring + (propertize "echo bar" 'read-only t)) + (unwind-protect + (eshell-write-history histfile) + (delete-file histfile)))) + +(provide 'em-hist-test) + +;;; em-hist-tests.el ends here diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 4e0d6dc7621..58b8aa58bf1 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -247,6 +247,6 @@ chars" (goto-char eshell-last-input-start) (string= (eshell-get-old-input) "echo alpha"))) -(provide 'esh-test) +(provide 'eshell-tests) ;;; tests/eshell-tests.el ends here -- cgit v1.2.3 From b060e091c35e8482e0e091a214cf5afe5039bd0e Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 19 Oct 2017 20:07:05 -0400 Subject: Handle https url for debbugs mbox (Bug#28831) In 2017-09-13 "Prefer HTTPS to FTP and HTTP in documentation", gnus-bug-group-download-format-alist was updated to use https for the debbugs.gnu.org mbox links, but gnus-read-ephemeral-bug-group assumed http links. * lisp/gnus/gnus-group.el (gnus-read-ephemeral-bug-group): Use url-parse functions to get the host name, instead of ad-hoc regexps. --- lisp/gnus/gnus-group.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 985efe6272f..4a41c495900 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2467,9 +2467,7 @@ the bug number, and browsing the URL must return mbox output." ;; Add the debbugs address so that we can respond to reports easily. (let ((address (format "%s@%s" (car ids) - (replace-regexp-in-string - "/.*$" "" - (replace-regexp-in-string "^http://" "" mbox-url))))) + (url-host (url-generic-parse-url mbox-url))))) (goto-char (point-min)) (while (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) -- cgit v1.2.3 From d719ea6ad5419bba2b376384c370dc2744dc718f Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 21 Oct 2017 11:52:24 -0400 Subject: Another fix for unsafe directory error message (Bug#865) * lisp/server.el (server-ensure-safe-dir): Put file owner's uid, not current user's for the wrong owner case. Show expanded file name in error message. --- lisp/server.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/server.el b/lisp/server.el index 33800a98682..4c591a5ee7c 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -546,14 +546,15 @@ See variable `server-auth-dir' for details." ;; group recorded as the owner. (/= uid 544) (/= (user-uid) 500))) (format "it is not owned by you (owner = %s (%d))" - (user-full-name (user-uid)) (user-uid))) + (user-full-name uid) uid)) (w32 nil) ; on NTFS? ((/= 0 (logand ?\077 (file-modes dir))) (format "it is accessible by others (%03o)" (file-modes dir))) (t nil)))) (when unsafe - (error "`%s' is not a safe directory because %s" dir unsafe))))) + (error "`%s' is not a safe directory because %s" + (expand-file-name dir) unsafe))))) (defun server-generate-key () "Generate and return a random authentication key. -- cgit v1.2.3 From 2bfa42855bf0278497f2e4540eac2086dab254c3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 22 Oct 2017 00:29:04 -0700 Subject: Fix xdg timestamp error on 32-bit Emacs * lisp/xdg.el (xdg-thumb-mtime): Return an Emacs timestamp, not an integer. This avoids signaling an error on 32-bit Emacs, where timestamps typically do not fit into fixnums (Bug#28921). --- lisp/xdg.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/xdg.el b/lisp/xdg.el index 76106f42586..e73e6199d6f 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -93,8 +93,8 @@ file:///foo/bar.jpg" (concat (md5 (xdg-thumb-uri filename)) ".png")) (defun xdg-thumb-mtime (filename) - "Return modification time of FILENAME as integral seconds from the epoch." - (floor (float-time (nth 5 (file-attributes filename))))) + "Return modification time of FILENAME as an Emacs timestamp." + (file-attribute-modification-time (file-attributes filename))) ;; XDG User Directories -- cgit v1.2.3 From 3aee7be62eaf8caef6f2fab31bee79674b3abbb7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 22 Oct 2017 01:04:36 -0700 Subject: Avoid unnecessary rounding errors in timestamps MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Avoid the rounding errors of float-time when it’s easy. E.g., replace (< (float-time a) (float-time b)) with (time-less-p a b). * lisp/desktop.el (desktop-save): * lisp/ecomplete.el (ecomplete-add-item): * lisp/epg.el (epg-wait-for-completion): * lisp/files.el (dir-locals-find-file, dir-locals-read-from-dir): * lisp/image-dired.el (image-dired-get-thumbnail-image) (image-dired-create-thumb-1): * lisp/info.el (info-insert-file-contents): * lisp/ls-lisp.el (ls-lisp-format-time): * lisp/net/ange-ftp.el (ange-ftp-file-newer-than-file-p) (ange-ftp-verify-visited-file-modtime): * lisp/net/rcirc.el (rcirc-ctcp-sender-PING): * lisp/textmodes/remember.el (remember-store-in-mailbox): * lisp/url/url-cookie.el (url-cookie-expired-p): Bypass float-time to avoid rounding errors. * lisp/files.el (dir-locals-find-file): --- lisp/desktop.el | 3 ++- lisp/ecomplete.el | 2 +- lisp/epg.el | 5 ++--- lisp/files.el | 31 ++++++++++++++----------------- lisp/image-dired.el | 15 +++++++-------- lisp/info.el | 2 +- lisp/ls-lisp.el | 5 +++-- lisp/net/ange-ftp.el | 4 ++-- lisp/net/rcirc.el | 2 +- lisp/textmodes/remember.el | 2 +- lisp/url/url-cookie.el | 2 +- 11 files changed, 35 insertions(+), 38 deletions(-) (limited to 'lisp') diff --git a/lisp/desktop.el b/lisp/desktop.el index 73228ce040b..52cdbaf849d 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1046,7 +1046,8 @@ without further confirmation." (or (not new-modtime) ; nothing to overwrite (equal desktop-file-modtime new-modtime) (yes-or-no-p (if desktop-file-modtime - (if (> (float-time new-modtime) (float-time desktop-file-modtime)) + (if (time-less-p desktop-file-modtime + new-modtime) "Desktop file is more recent than the one loaded. Save anyway? " "Desktop file isn't the one loaded. Overwrite it? ") "Current desktop was not loaded from a file. Overwrite this desktop file? ")) diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index ed23d9f5cc2..014b4b21122 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -55,7 +55,7 @@ (defun ecomplete-add-item (type key text) (let ((elems (assq type ecomplete-database)) - (now (string-to-number (format "%.0f" (float-time)))) + (now (string-to-number (format-time-string "%s"))) entry) (unless elems (push (setq elems (list type)) ecomplete-database)) diff --git a/lisp/epg.el b/lisp/epg.el index 407b0f5d5d3..fee6ad75119 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -757,9 +757,8 @@ callback data (if any)." ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated. (if (with-current-buffer (process-buffer (epg-context-process context)) (and epg-agent-file - (> (float-time (or (nth 5 (file-attributes epg-agent-file)) - '(0 0 0 0))) - (float-time epg-agent-mtime)))) + (time-less-p epg-agent-mtime + (or (nth 5 (file-attributes epg-agent-file)) 0)))) (redraw-frame)) (epg-context-set-result-for context 'error diff --git a/lisp/files.el b/lisp/files.el index 211457ac7d7..9d46d5f85aa 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3947,11 +3947,12 @@ This function returns either: ;; The entry MTIME should match the most recent ;; MTIME among matching files. (and cached-files - (= (float-time (nth 2 dir-elt)) - (apply #'max (mapcar (lambda (f) - (float-time - (nth 5 (file-attributes f)))) - cached-files)))))) + (equal (nth 2 dir-elt) + (let ((latest 0)) + (dolist (f cached-files latest) + (let ((f-time (nth 5 (file-attributes f)))) + (if (time-less-p latest f-time) + (setq latest f-time))))))))) ;; This cache entry is OK. dir-elt ;; This cache entry is invalid; clear it. @@ -3973,10 +3974,15 @@ Return the new class name, which is a symbol named DIR." (let* ((class-name (intern dir)) (files (dir-locals--all-files dir)) (read-circle nil) - (success nil) + ;; If there was a problem, use the values we could get but + ;; don't let the cache prevent future reads. + (latest 0) (success 0) (variables)) (with-demoted-errors "Error reading dir-locals: %S" (dolist (file files) + (let ((file-time (nth 5 (file-attributes file)))) + (if (time-less-p latest file-time) + (setq latest file-time))) (with-temp-buffer (insert-file-contents file) (condition-case-unless-debug nil @@ -3985,18 +3991,9 @@ Return the new class name, which is a symbol named DIR." variables (read (current-buffer)))) (end-of-file nil)))) - (setq success t)) + (setq success latest)) (dir-locals-set-class-variables class-name variables) - (dir-locals-set-directory-class - dir class-name - (seconds-to-time - (if success - (apply #'max (mapcar (lambda (file) - (float-time (nth 5 (file-attributes file)))) - files)) - ;; If there was a problem, use the values we could get but - ;; don't let the cache prevent future reads. - 0))) + (dir-locals-set-directory-class dir class-name success) class-name)) (define-obsolete-function-alias 'dir-locals-read-from-file diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 30ecc2befc7..175d9df5e8c 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -582,10 +582,11 @@ Create the thumbnails directory if it does not exist." "Return the image descriptor for a thumbnail of image file FILE." (unless (string-match (image-file-name-regexp) file) (error "%s is not a valid image file" file)) - (let ((thumb-file (image-dired-thumb-name file))) - (unless (and (file-exists-p thumb-file) - (<= (float-time (nth 5 (file-attributes file))) - (float-time (nth 5 (file-attributes thumb-file))))) + (let* ((thumb-file (image-dired-thumb-name file)) + (thumb-attr (file-attributes thumb-file))) + (when (or (not thumb-attr) + (time-less-p (nth 5 thumb-attr) + (nth 5 (file-attributes file)))) (image-dired-create-thumb file thumb-file)) (create-image thumb-file) ;; (list 'image :type 'jpeg @@ -748,10 +749,8 @@ Increase at own risk.") 'image-dired-cmd-create-thumbnail-program) (let* ((width (int-to-string (image-dired-thumb-size 'width))) (height (int-to-string (image-dired-thumb-size 'height))) - (modif-time - (format "%.0f" - (ffloor (float-time - (nth 5 (file-attributes original-file)))))) + (modif-time (format-time-string + "%s" (nth 5 (file-attributes original-file)))) (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png" thumbnail-file)) (spec diff --git a/lisp/info.el b/lisp/info.el index 6f87adb04e8..e2f9953f7c7 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -649,7 +649,7 @@ Do the right thing if the file has been compressed or zipped." (attribs-new (and (stringp fullname) (file-attributes fullname))) (modtime-new (and attribs-new (nth 5 attribs-new)))) (when (and modtime-old modtime-new - (> (float-time modtime-new) (float-time modtime-old))) + (time-less-p modtime-old modtime-new)) (setq Info-index-nodes (remove (assoc (or Info-current-file filename) Info-index-nodes) Info-index-nodes)) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 280e7f4bc3e..66dddbbc17b 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -861,7 +861,7 @@ Use the same method as ls to decide whether to show time-of-day or year, depending on distance between file date and the current time. All ls time options, namely c, t and u, are handled." (let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime - (diff (- (float-time time) (float-time))) + (diff (time-subtract time nil)) ;; Consider a time to be recent if it is within the past six ;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 == ;; 31556952 seconds on the average, and half of that is 15778476. @@ -878,7 +878,8 @@ All ls time options, namely c, t and u, are handled." (if (member locale '("C" "POSIX")) (setq locale nil)) (format-time-string - (if (and (<= past-cutoff diff) (<= diff 0)) + (if (and (not (time-less-p diff past-cutoff)) + (not (time-less-p 0 diff))) (if (and locale (not ls-lisp-use-localized-time-format)) "%m-%d %H:%M" (nth 0 ls-lisp-format-time-list)) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 73f62c85519..cf65e10e510 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3479,7 +3479,7 @@ system TYPE.") (f2-mt (nth 5 (file-attributes f2)))) (cond ((null f1-mt) nil) ((null f2-mt) t) - (t (> (float-time f1-mt) (float-time f2-mt))))) + (t (time-less-p f2-mt f1-mt)))) (ange-ftp-real-file-newer-than-file-p f1 f2)))) (defun ange-ftp-file-writable-p (file) @@ -3561,7 +3561,7 @@ Value is (0 0) if the modification time cannot be determined." (let ((file-mdtm (ange-ftp-file-modtime name)) (buf-mdtm (with-current-buffer buf (visited-file-modtime)))) (or (zerop (car file-mdtm)) - (<= (float-time file-mdtm) (float-time buf-mdtm)))) + (not (time-less-p buf-mdtm file-mdtm)))) (ange-ftp-real-verify-visited-file-modtime buf)))) (defun ange-ftp-file-size (file &optional ascii-mode) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 5c785daa8a2..3b6b6c8c807 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2333,7 +2333,7 @@ With a prefix arg, prompt for new topic." (defun rcirc-ctcp-sender-PING (process target _request) "Send a CTCP PING message to TARGET." - (let ((timestamp (format "%.0f" (float-time)))) + (let ((timestamp (format-time-string "%s"))) (rcirc-send-ctcp process target "PING" timestamp))) (defun rcirc-cmd-me (args &optional process target) diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index b20ee8fee84..730eaecc71c 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -349,7 +349,7 @@ In which case `remember-mailbox' should be the name of the mailbox. Each piece of pseudo-mail created will have an `X-Todo-Priority' field, for the purpose of appropriate splitting." (let ((who (read-string "Who is this item related to? ")) - (moment (format "%.0f" (float-time))) + (moment (format-time-string "%s")) (desc (remember-buffer-desc)) (text (buffer-string))) (with-temp-buffer diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 453d4fe5b6f..28dfcedeaca 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -161,7 +161,7 @@ telling Microsoft that." (let ((exp (url-cookie-expires cookie))) (and (> (length exp) 0) (condition-case () - (> (float-time) (float-time (date-to-time exp))) + (time-less-p nil (date-to-time exp)) (error nil))))) (defun url-cookie-retrieve (host &optional localpart secure) -- cgit v1.2.3 From b7c4aa951c8b12629742df9d20d6374c3d2a8ba8 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 22 Oct 2017 14:18:20 +0000 Subject: Refactor c-forward-token-2 with new function c-forward-over-token-and-ws. Use the new function directly in several places where c-forward-token-2 wouldn't move over the last token in the buffer. This caused an infinite loop in c-restore-<>-properties. * lisp/progmodes/cc-engine.el (c-forward-over-token-and-ws): New function, extracted from c-forward-token-2. (c-forward-token-2): Refactor, calling the new function. (c-restore-<>-properties): Fix infinite loop. (c-forward-<>-arglist-recur, c-in-knr-argdecl) (c-looking-at-or-maybe-in-bracelist): Call the new function directly in place of c-forward-token-2. * lisp/progmodes/cc-cmds.el (c-defun-name) Call the new function directly in place of c-forward-token-2. * lisp/progmodes/cc-fonts.el (c-font-lock-enclosing-decls): Call the new function directly in place of c-forward-token-2. --- lisp/progmodes/cc-cmds.el | 2 +- lisp/progmodes/cc-engine.el | 114 ++++++++++++++++++++++++-------------------- lisp/progmodes/cc-fonts.el | 2 +- 3 files changed, 64 insertions(+), 54 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 5c8bbebf31b..ca64b544200 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1852,7 +1852,7 @@ with a brace block." ;; struct, union, enum, or similar: ((looking-at c-type-prefix-key) (let ((key-pos (point))) - (c-forward-token-2 1) ; over "struct ". + (c-forward-over-token-and-ws) ; over "struct ". (cond ((looking-at c-symbol-key) ; "struct foo { ..." (buffer-substring-no-properties key-pos (match-end 0))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 37928357526..c506294c5a0 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -4297,6 +4297,47 @@ comment at the start of cc-engine.el for more info." "\\w\\|\\s_\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\"")) +(defun c-forward-over-token-and-ws (&optional balanced) + "Move forward over a token and any following whitespace +Return t if we moved, nil otherwise (i.e. we were at EOB, or a +non-token or BALANCED is non-nil and we can't move). If we +are at syntactic whitespace, move over this in place of a token. + +If BALANCED is non-nil move over any balanced parens we are at, and never move +out of an enclosing paren. + +This function differs from `c-forward-token-2' in that it will move forward +over the final token in a buffer, up to EOB." + (let ((jump-syntax (if balanced + c-jump-syntax-balanced + c-jump-syntax-unbalanced)) + (here (point))) + (when + (condition-case nil + (cond + ((/= (point) + (progn (c-forward-syntactic-ws) (point))) + ;; If we're at whitespace, count this as the token. + t) + ((eobp) nil) + ((looking-at jump-syntax) + (goto-char (scan-sexps (point) 1)) + t) + ((looking-at c-nonsymbol-token-regexp) + (goto-char (match-end 0)) + t) + ((save-restriction + (widen) + (looking-at c-nonsymbol-token-regexp)) + nil) + (t + (forward-char) + t)) + (error (goto-char here) + nil)) + (c-forward-syntactic-ws) + t))) + (defun c-forward-token-2 (&optional count balanced limit) "Move forward by tokens. A token is defined as all symbols and identifiers which aren't @@ -4326,15 +4367,11 @@ comment at the start of cc-engine.el for more info." (if (< count 0) (- (c-backward-token-2 (- count) balanced limit)) - (let ((jump-syntax (if balanced - c-jump-syntax-balanced - c-jump-syntax-unbalanced)) - (last (point)) - (prev (point))) - - (if (zerop count) - ;; If count is zero we should jump if in the middle of a token. - (c-end-of-current-token)) + (let ((here (point)) + (last (point))) + (when (zerop count) + ;; If count is zero we should jump if in the middle of a token. + (c-end-of-current-token)) (save-restriction (if limit (narrow-to-region (point-min) limit)) @@ -4348,43 +4385,15 @@ comment at the start of cc-engine.el for more info." ;; Moved out of bounds. Make sure the returned count isn't zero. (progn (if (zerop count) (setq count 1)) - (goto-char last)) - - ;; Use `condition-case' to avoid having the limit tests - ;; inside the loop. - (condition-case nil - (while (and - (> count 0) - (progn - (setq last (point)) - (cond ((looking-at jump-syntax) - (goto-char (scan-sexps (point) 1)) - t) - ((looking-at c-nonsymbol-token-regexp) - (goto-char (match-end 0)) - t) - ;; `c-nonsymbol-token-regexp' above should always - ;; match if there are correct tokens. Try to - ;; widen to see if the limit was set in the - ;; middle of one, else fall back to treating - ;; the offending thing as a one character token. - ((and limit - (save-restriction - (widen) - (looking-at c-nonsymbol-token-regexp))) - nil) - (t - (forward-char) - t)))) - (c-forward-syntactic-ws) - (setq prev last - count (1- count))) - (error (goto-char last))) - - (when (eobp) - (goto-char prev) - (setq count (1+ count))))) - + (goto-char here)) + (while (and + (> count 0) + (c-forward-over-token-and-ws balanced) + (not (eobp))) + (setq last (point) + count (1- count))) + (if (eobp) + (goto-char last)))) count))) (defun c-backward-token-2 (&optional count balanced limit) @@ -6424,7 +6433,8 @@ comment at the start of cc-engine.el for more info." (not (eq (c-get-char-property (point) 'c-type) 'c-decl-arg-start))))))) (or (c-forward-<>-arglist nil) - (c-forward-token-2))))) + (c-forward-over-token-and-ws) + (goto-char c-new-END))))) ;; Functions to handle C++ raw strings. @@ -7142,7 +7152,7 @@ comment at the start of cc-engine.el for more info." (let ((c-promote-possible-types t) (c-record-found-types t)) (c-forward-type)) - (c-forward-token-2)))) + (c-forward-over-token-and-ws)))) (c-forward-syntactic-ws) @@ -9722,8 +9732,8 @@ comment at the start of cc-engine.el for more info." ;; identifiers? (progn (goto-char before-lparen) - (c-forward-token-2) ; to first token inside parens (and + (c-forward-over-token-and-ws) ; to first token inside parens (setq id-start (c-on-identifier)) ; Must be at least one. (catch 'id-list (while @@ -9735,7 +9745,7 @@ comment at the start of cc-engine.el for more info." ids) (c-forward-syntactic-ws) (eq (char-after) ?\,)) - (c-forward-token-2) + (c-forward-over-token-and-ws) (unless (setq id-start (c-on-identifier)) (throw 'id-list nil))) (eq (char-after) ?\))))) @@ -10525,10 +10535,10 @@ comment at the start of cc-engine.el for more info." ((and after-type-id-pos (save-excursion (when (eq (char-after) ?\;) - (c-forward-token-2 1 t)) + (c-forward-over-token-and-ws t)) (setq bufpos (point)) (when (looking-at c-opt-<>-sexp-key) - (c-forward-token-2) + (c-forward-over-token-and-ws) (when (and (eq (char-after) ?<) (c-get-char-property (point) 'syntax-table)) (c-go-list-forward nil after-type-id-pos) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 02b685d240d..acdb1ad1334 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1730,7 +1730,7 @@ casts and declarations are fontified. Used on level 2 and higher." (c-syntactic-skip-backward "^;{}" decl-search-lim) (c-forward-syntactic-ws) (setq in-typedef (looking-at c-typedef-key)) - (if in-typedef (c-forward-token-2)) + (if in-typedef (c-forward-over-token-and-ws)) (when (and c-opt-block-decls-with-vars-key (looking-at c-opt-block-decls-with-vars-key)) (goto-char ps-elt) -- cgit v1.2.3 From a012ec766c9d9bac0a56e814589a4b3b93311c28 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Sun, 22 Oct 2017 01:46:05 -0600 Subject: Don't fill keywords after Emacs Lisp docstring This approach does mean that keywords that have spaces before them inside of docstrings aren't filled, but I think this is should be fine until Bug#28937 is fixed. * lisp/emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Add a colon to paragraph-start unconditionally, but require that it follows at least one space. (Bug#24622) * test/lisp/emacs-lisp/lisp-tests.el: New tests for Bug#24622 and Bug#7751. --- lisp/emacs-lisp/lisp-mode.el | 11 +++-------- test/lisp/emacs-lisp/lisp-tests.el | 31 +++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fd12635d85c..93435e1b4bb 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1267,7 +1267,8 @@ and initial semicolons." ;; case). The `;' and `:' stop the paragraph being filled at following ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are ;; escaped to keep font-locking, filling, & paren matching in the source - ;; file happy. + ;; file happy. The `:' must be preceded by whitespace so that keywords + ;; inside of the docstring don't start new paragraphs (Bug#7751). ;; ;; `paragraph-separate': A clever regexp distinguishes the first line of ;; a docstring and identifies it as a paragraph separator, so that it @@ -1280,13 +1281,7 @@ and initial semicolons." ;; `emacs-lisp-docstring-fill-column' if that value is an integer. (let ((paragraph-start (concat paragraph-start - (format "\\|\\s-*\\([(;%s\"]\\|`(\\|#'(\\)" - ;; If we're inside a string (like the doc - ;; string), don't consider a colon to be - ;; a paragraph-start character. - (if (nth 3 (syntax-ppss)) - "" - ":")))) + "\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)")) (paragraph-separate (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) (fill-column (if (and (integerp emacs-lisp-docstring-fill-column) diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index ae1302bdce4..654d949d388 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -589,5 +589,36 @@ region." (should (= (point) before)) (should (= (mark) after)))) +(ert-deftest lisp-fill-paragraph-colon () + "Keywords below Emacs Lisp docstrings should not be filled (Bug#24622). +Keywords inside docstrings should be filled (Bug#7751)." + (elisp-tests-with-temp-buffer + " +\(defcustom custom value + \"First\n +Second\n +=!inside=Third line\" + =!keywords=:type 'sexp + :version \"26.1\" + :group 'lisp-tests)" + (goto-char inside) + (fill-paragraph) + (goto-char keywords) + (beginning-of-line) + (should (looking-at " :type 'sexp\n :version \"26.1\"\n :"))) + (elisp-tests-with-temp-buffer + " +\(defun foo () + \"Summary. +=!inside=Testing keywords: :one :two :three\" + (body))" ; FIXME: Remove parens around body to test Bug#28937 once it's fixed + (goto-char inside) + (let ((emacs-lisp-docstring-fill-column 30)) + (fill-paragraph)) + (forward-line) + (should (looking-at ":three")) + (end-of-line) + (should-not (eq (preceding-char) ?\))))) + (provide 'lisp-tests) ;;; lisp-tests.el ends here -- cgit v1.2.3 From 46cdc01daae6972aaa53e6db16a52fdc2a4b7cac Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 23 Oct 2017 09:53:41 +0200 Subject: Fix some ‘window-normalize-’ prefixed functions (Bug#28947) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/window.el (window-normalize-buffer): Fix case where BUFFER-OR-NAME is a string specifying a dead buffer. Fix doc-string (Bug#28947). (window-normalize-frame, window-normalize-window): Fix doc-strings (Bug#28947). --- lisp/window.el | 46 +++++++++++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 15 deletions(-) (limited to 'lisp') diff --git a/lisp/window.el b/lisp/window.el index 5ba9a305f96..c0a9ecd093c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -320,22 +320,34 @@ WINDOW can be any window." (defun window-normalize-buffer (buffer-or-name) "Return buffer specified by BUFFER-OR-NAME. -BUFFER-OR-NAME must be either a buffer or a string naming a live -buffer and defaults to the current buffer." - (cond - ((not buffer-or-name) - (current-buffer)) - ((bufferp buffer-or-name) - (if (buffer-live-p buffer-or-name) - buffer-or-name - (error "Buffer %s is not a live buffer" buffer-or-name))) - ((get-buffer buffer-or-name)) - (t - (error "No such buffer %s" buffer-or-name)))) +BUFFER-OR-NAME must be a live buffer, a string naming a live +buffer or nil which means to return the current buffer. + +This function is commonly used to process the (usually optional) +\"BUFFER-OR-NAME\" argument of window related functions where nil +stands for the current buffer." + (let ((buffer + (cond + ((not buffer-or-name) + (current-buffer)) + ((bufferp buffer-or-name) + buffer-or-name) + ((stringp buffer-or-name) + (get-buffer buffer-or-name)) + (t + (error "No such buffer %s" buffer-or-name))))) + (if (buffer-live-p buffer) + buffer + (error "No such live buffer %s" buffer-or-name)))) (defun window-normalize-frame (frame) "Return frame specified by FRAME. -FRAME must be a live frame and defaults to the selected frame." +FRAME must be a live frame or nil which means to return the +selected frame. + +This function is commonly used to process the (usually optional) +\"FRAME\" argument of window and frame related functions where +nil stands for the selected frame." (if frame (if (frame-live-p frame) frame @@ -343,11 +355,15 @@ FRAME must be a live frame and defaults to the selected frame." (selected-frame))) (defun window-normalize-window (window &optional live-only) - "Return the window specified by WINDOW. + "Return window specified by WINDOW. If WINDOW is nil, return the selected window. Otherwise, if WINDOW is a live or an internal window, return WINDOW; if LIVE-ONLY is non-nil, return WINDOW for a live window only. -Otherwise, signal an error." +Otherwise, signal an error. + +This function is commonly used to process the (usually optional) +\"WINDOW\" argument of window related functions where nil stands +for the selected window." (cond ((null window) (selected-window)) -- cgit v1.2.3 From c6deabaf4d77fb3ed137c0dbabf98a420cc5c7f9 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 23 Oct 2017 14:05:49 +0200 Subject: Improve Tramp backward compatibility * lisp/net/tramp-compat.el (tramp-compat-tramp-file-name-slots): New defmacro. * lisp/net/tramp.el (with-parsed-tramp-file-name): Use it. --- lisp/net/tramp-compat.el | 6 ++++++ lisp/net/tramp.el | 4 +--- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 214ad040a17..9326f7b1864 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -235,6 +235,12 @@ If NAME is a remote file name, the local part of NAME is unquoted." ((eq tramp-syntax 'sep) 'separate) (t tramp-syntax))) +;; `cl-struct-slot-info' has been introduced with Emacs 25. +(defmacro tramp-compat-tramp-file-name-slots () + (if (fboundp 'cl-struct-slot-info) + `(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name))) + `(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots))))) + (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3d6934783f5..5a59dd622dd 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1760,9 +1760,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', `(,(if var (intern (format "%s-%s" var elem)) elem) (,(intern (format "tramp-file-name-%s" elem)) ,(or var 'v)))) - (eval-and-compile - (cdr - (mapcar 'car (cl-struct-slot-info 'tramp-file-name))))))) + `,(tramp-compat-tramp-file-name-slots)))) `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename)) ,@bindings) ;; We don't know which of those vars will be used, so we bind them all, -- cgit v1.2.3 From 529a9c09d3f6b5d5a61b81b306bdb8ffa0da50f0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 23 Oct 2017 17:58:52 +0200 Subject: Further work on Bug#28889 * lisp/net/tramp.el (tramp-set-syntax): New defun. (tramp-syntax): Use it. Change :package-version. (Bug#28889) --- lisp/net/tramp.el | 74 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 34 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5a59dd622dd..736c28c4aa8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -674,48 +674,54 @@ Do not change the value by `setq', it must be changed only by `custom-set-variables'. See also `tramp-change-syntax'." :group 'tramp :version "26.1" - :package-version '(Tramp . "2.3.2") + :package-version '(Tramp . "2.3.3") :type '(choice (const :tag "Default" default) (const :tag "Ange-FTP" simplified) (const :tag "XEmacs" separate)) :require 'tramp :initialize 'custom-initialize-set - :set (lambda (symbol value) - ;; Check allowed values. - (unless (memq value (tramp-syntax-values)) - (tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax)) - ;; Cleanup existing buffers. - (unless (eq (symbol-value symbol) value) - (tramp-cleanup-all-buffers)) - ;; Set the value: - (set-default symbol value) - ;; Reset the depending variables. - (with-no-warnings - (setq tramp-prefix-format (tramp-build-prefix-format) - tramp-prefix-regexp (tramp-build-prefix-regexp) - tramp-method-regexp (tramp-build-method-regexp) - tramp-postfix-method-format (tramp-build-postfix-method-format) - tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) - tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) - tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) - tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) - tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) - tramp-postfix-host-format (tramp-build-postfix-host-format) - tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) - tramp-remote-file-name-spec-regexp - (tramp-build-remote-file-name-spec-regexp) - tramp-file-name-structure (tramp-build-file-name-structure) - tramp-file-name-regexp (tramp-build-file-name-regexp) - tramp-completion-file-name-regexp - (tramp-build-completion-file-name-regexp))) - ;; Rearrange file name handlers. - (tramp-register-file-name-handlers))) + :set 'tramp-set-syntax) + +(defun tramp-set-syntax (symbol value) + "Set SYMBOL to value VALUE. +Used in user option `tramp-syntax'. There are further variables +to be set, depending on VALUE." + ;; Check allowed values. + (unless (memq value (tramp-syntax-values)) + (tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax)) + ;; Cleanup existing buffers. + (unless (eq (symbol-value symbol) value) + (tramp-cleanup-all-buffers)) + ;; Set the value: + (set-default symbol value) + ;; Reset the depending variables. + (with-no-warnings + (setq tramp-prefix-format (tramp-build-prefix-format) + tramp-prefix-regexp (tramp-build-prefix-regexp) + tramp-method-regexp (tramp-build-method-regexp) + tramp-postfix-method-format (tramp-build-postfix-method-format) + tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) + tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) + tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) + tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) + tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) + tramp-postfix-host-format (tramp-build-postfix-host-format) + tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) + tramp-remote-file-name-spec-regexp + (tramp-build-remote-file-name-spec-regexp) + tramp-file-name-structure (tramp-build-file-name-structure) + tramp-file-name-regexp (tramp-build-file-name-regexp) + tramp-completion-file-name-regexp + (tramp-build-completion-file-name-regexp))) + ;; Rearrange file name handlers. + (tramp-register-file-name-handlers)) ;; Initialize the Tramp syntax variables. We want to override initial -;; values of `tramp-file-name-regexp' and -;; `tramp-completion-file-name-regexp'. +;; value of `tramp-file-name-regexp'. Other Tramp syntax variables +;; must be initialized as well to proper values. We do not call +;; `custom-set-variable', this would load Tramp via custom.el. (eval-after-load 'tramp - '(custom-set-variables `(tramp-syntax ',(tramp-compat-tramp-syntax)))) + '(tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax))) (defun tramp-syntax-values () "Return possible values of `tramp-syntax', a list" -- cgit v1.2.3 From 928a106939080df7df6ea158318f5afa5579ddcf Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Mon, 16 Oct 2017 11:40:38 -0700 Subject: Fix Edebug specs for map-let and with-maps-do * lisp/emacs-lisp/map.el (map-let): Fix Edebug spec (bug#24777). * test/lisp/emacs-lisp/map-tests.el (with-maps-do): Fix Edebug spec. --- lisp/emacs-lisp/map.el | 3 ++- test/lisp/emacs-lisp/map-tests.el | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 0f9a74422b4..2a3e1d0a4b0 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -73,7 +73,8 @@ KEYS can also be a list of (KEY VARNAME) pairs, in which case KEY is an unquoted form. MAP can be a list, hash-table or array." - (declare (indent 2) (debug t)) + (declare (indent 2) + (debug ((&rest &or symbolp ([form symbolp])) form body))) `(pcase-let ((,(map--make-pcase-patterns keys) ,map)) ,@body)) diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 0a888d88b72..a434c9bd066 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -36,7 +36,7 @@ Each map is built from the following alist data: Evaluate BODY for each created map. \(fn (var map) body)" - (declare (indent 1) (debug t)) + (declare (indent 1) (debug (symbolp body))) (let ((alist (make-symbol "alist")) (vec (make-symbol "vec")) (ht (make-symbol "ht"))) -- cgit v1.2.3 From 0c536a20fb4833bafea1c2a14b9ff2bac2a3ebd8 Mon Sep 17 00:00:00 2001 From: David Glasser Date: Tue, 10 Oct 2017 15:46:53 -0700 Subject: Display commit in package description, if available (Bug#28637) MELPA includes a :commit field in its packages (https://github.com/melpa/package-build/pull/6). You can use this to tell if MELPA has processed a recently-merged change. This commit adds that metadata to the package description buffer. * lisp/emacs-lisp/package.el: Display commit in package description. Copyright-paperwork-exempt: yes --- lisp/emacs-lisp/package.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 8b101c1323c..dd05c70dc8e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2260,6 +2260,7 @@ Otherwise no newline is inserted." (archive (if desc (package-desc-archive desc))) (extras (and desc (package-desc-extras desc))) (homepage (cdr (assoc :url extras))) + (commit (cdr (assoc :commit extras))) (keywords (if desc (package-desc--keywords desc))) (built-in (eq pkg-dir 'builtin)) (installable (and archive (not built-in))) @@ -2332,6 +2333,8 @@ Otherwise no newline is inserted." (and version (package--print-help-section "Version" (package-version-join version))) + (when commit + (package--print-help-section "Commit" commit)) (when desc (package--print-help-section "Summary" (package-desc-summary desc))) -- cgit v1.2.3 From e8a06a5f9a98094d340dda1c9c8b195f3e66e2c8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 24 Oct 2017 19:19:37 -0400 Subject: Fix compile warning for non-w32 builds Since 2017-07-25 "ls-lisp: Add an unload function and enable lexical binding", the non-w32 builds would treat the undeclared w32-collate-ignore-punctuation variable as lexical. * lisp/ls-lisp.el (top-level): Declare it as a dynamic variable. --- lisp/ls-lisp.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 66dddbbc17b..caddc7f760b 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -567,6 +567,8 @@ Responds to the window width as ls should but may not!" (setq list (cdr list))) result)) +(defvar w32-collate-ignore-punctuation) ; Declare for non-w32 builds. + (defsubst ls-lisp-string-lessp (s1 s2) "Return t if string S1 should sort before string S2. Case is significant if `ls-lisp-ignore-case' is nil. -- cgit v1.2.3 From 761c630766abf5b59c9b8c8f6edde07b276ea4b4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 25 Oct 2017 13:36:49 +0200 Subject: Fix Bug#28982 * admin/MAINTAINERS: Add test/lisp/url/url-tramp-tests.el. * lisp/url/url-tramp.el (url-tramp-convert-url-to-tramp) (url-tramp-convert-tramp-to-url): Adapt to recent Tramp changes. * test/lisp/url/url-tramp-tests.el: New file. (Bug#28982) --- admin/MAINTAINERS | 1 + lisp/url/url-tramp.el | 58 ++++++++++++++++------------ test/lisp/url/url-tramp-tests.el | 83 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 117 insertions(+), 25 deletions(-) create mode 100644 test/lisp/url/url-tramp-tests.el (limited to 'lisp') diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index c13cb552a78..753a676e81a 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -62,6 +62,7 @@ Michael Albinus lisp/url/url-tramp.el doc/misc/tramp*.texi test/lisp/net/tramp-tests.el + test/lisp/url/url-tramp-tests.el D-Bus src/dbusbind.c diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el index c28cf6c23a1..0b07bd0d1aa 100644 --- a/lisp/url/url-tramp.el +++ b/lisp/url/url-tramp.el @@ -37,33 +37,41 @@ They must also be covered by `url-handler-regexp'." :type '(repeat string)) (defun url-tramp-convert-url-to-tramp (url) - "Convert URL to a Tramp file name." - (let ((obj (url-generic-parse-url (and (stringp url) url)))) - (if (member (url-type obj) url-tramp-protocols) - (progn - (if (url-password obj) - (password-cache-add - (tramp-make-tramp-file-name - (url-type obj) (url-user obj) (url-host obj) "") - (url-password obj)) - (tramp-make-tramp-file-name - (url-type obj) (url-user obj) (url-host obj) (url-filename obj)))) - url))) + "Convert URL to a Tramp file name. +If URL contains a password, it will be added to the `password-data' cache. +In case URL is not convertable, nil is returned." + (let* ((obj (url-generic-parse-url (and (stringp url) url))) + (port + (and (natnump (url-portspec obj)) + (number-to-string (url-portspec obj))))) + (when (member (url-type obj) url-tramp-protocols) + (when (url-password obj) + (password-cache-add + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) nil + (url-host obj) port "") + (url-password obj))) + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) nil + (url-host obj) port (url-filename obj))))) (defun url-tramp-convert-tramp-to-url (file) - "Convert FILE, a Tramp file name, to a URL." - (let ((obj (ignore-errors (tramp-dissect-file-name file)))) - (if (member (tramp-file-name-method obj) url-tramp-protocols) - (url-recreate-url - (url-parse-make-urlobj - (tramp-file-name-method obj) - (tramp-file-name-user obj) - nil ; password. - (tramp-file-name-host obj) - nil ; port. - (tramp-file-name-localname obj) - nil nil t)) ; target attributes fullness. - file))) + "Convert FILE, a Tramp file name, to a URL. +In case FILE is not convertable, nil is returned." + (let* ((obj (ignore-errors (tramp-dissect-file-name file))) + (port + (and (stringp (tramp-file-name-port obj)) + (string-to-number (tramp-file-name-port obj))))) + (when (member (tramp-file-name-method obj) url-tramp-protocols) + (url-recreate-url + (url-parse-make-urlobj + (tramp-file-name-method obj) + (tramp-file-name-user obj) + nil ; password. + (tramp-file-name-host obj) + port + (tramp-file-name-localname obj) + nil nil t))))) ; target attributes fullness. ;;;###autoload (defun url-tramp-file-handler (operation &rest args) diff --git a/test/lisp/url/url-tramp-tests.el b/test/lisp/url/url-tramp-tests.el new file mode 100644 index 00000000000..9892cd78475 --- /dev/null +++ b/test/lisp/url/url-tramp-tests.el @@ -0,0 +1,83 @@ +;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion. + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Michael Albinus + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'url-tramp) +(require 'ert) + +(ert-deftest url-tramp-test-convert-url-to-tramp () + "Test that URLs are converted into proper Tramp file names." + (should + (string-equal + (url-tramp-convert-url-to-tramp "ftp://ftp.is.co.za/rfc/rfc1808.txt") + "/ftp:ftp.is.co.za:/rfc/rfc1808.txt")) + + (should + (string-equal + (url-tramp-convert-url-to-tramp "ssh://user@localhost") + "/ssh:user@localhost:")) + + (should + (string-equal + (url-tramp-convert-url-to-tramp "telnet://remotehost:42") + "/telnet:remotehost#42:")) + + ;; The password will be added to the cache. The password cache key + ;; is the remote file name identification of the Tramp file. + (should + (string-equal + (url-tramp-convert-url-to-tramp "scp://user:geheim@somewhere/localfile") + "/scp:user@somewhere:/localfile")) + (let ((key + (file-remote-p + (url-tramp-convert-url-to-tramp "scp://user@somewhere/localfile")))) + (should (password-in-cache-p key)) + (should (string-equal (password-read-from-cache key) "geheim")) + (password-cache-remove key) + (should-not (password-in-cache-p key))) + + ;; "http" does not belong to `url-tramp-protocols'. + (should-not (url-tramp-convert-url-to-tramp "http://www.gnu.org"))) + +(ert-deftest url-tramp-test-convert-tramp-to-url () + "Test that Tramp file names are converted into proper URLs." + (should + (string-equal + (url-tramp-convert-tramp-to-url "/ftp:ftp.is.co.za:/rfc/rfc1808.txt") + "ftp://ftp.is.co.za/rfc/rfc1808.txt")) + + (should + (string-equal + (url-tramp-convert-tramp-to-url "/ssh:user@localhost:") + "ssh://user@localhost")) + + (should + (string-equal + (url-tramp-convert-tramp-to-url "/telnet:user@remotehost#42:") + "telnet://user@remotehost:42")) + + ;; "sftp" does not belong to `url-tramp-protocols'. + (should-not (url-tramp-convert-tramp-to-url "/sftp:user@localhost:"))) + +(provide 'url-tramp-tests) + +;;; url-tramp-tests.el ends here -- cgit v1.2.3 From 57ca409111997176a8428a06cc65f037d4217f3a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 25 Oct 2017 12:31:40 -0400 Subject: Fix autoload of flymake from elisp-mode during bootstrap (bug#28994) * lisp/loadup.el: add `progmodes` to load-path so we can find flymake.el. * lisp/kmacro.el: Require `replace` since we use query-replace-map. * lisp/replace.el: Require `text-mode` since we use text-mode-map. --- lisp/kmacro.el | 1 + lisp/loadup.el | 1 + lisp/replace.el | 1 + 3 files changed, 3 insertions(+) (limited to 'lisp') diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 4abc571db44..5729f2fc8d3 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -111,6 +111,7 @@ ;;; Code: ;; Customization: +(require 'replace) (defgroup kmacro nil "Simplified keyboard macro user interface." diff --git a/lisp/loadup.el b/lisp/loadup.el index d048f0736be..40e5651aa1d 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -76,6 +76,7 @@ (setq max-lisp-eval-depth 2200) (setq load-path (list (expand-file-name "." dir) (expand-file-name "emacs-lisp" dir) + (expand-file-name "progmodes" dir) (expand-file-name "language" dir) (expand-file-name "international" dir) (expand-file-name "textmodes" dir) diff --git a/lisp/replace.el b/lisp/replace.el index a5548f461d8..cdaeb9240ad 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -28,6 +28,7 @@ ;;; Code: +(require 'text-mode) (eval-when-compile (require 'cl-lib)) (defcustom case-replace t -- cgit v1.2.3 From 46540a1c7adb1b89b6c2f6c9150fe8680c3a5fba Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 25 Oct 2017 18:14:00 +0000 Subject: Fix a "wrong side of point" error in CC Mode. Fixes bug #28850. The cause was a scanning over a bracket pair taking us beyond the supplied LIMIT parameter in c-forward-declarator. * lisp/progmodes/cc-engine.el (c-forward-declarator): Add three checks (< (point) limit) whilst dealing with tokens after the declared identifier. * lisp/progmodes/cc-fonts.el (c-font-lock-declarators): Don't supply a LIMIT argument to `c-forward-declarator' (twice), since we want to fontify up till the end of a declarator, not an arbitrary jit-lock chunk end. --- lisp/progmodes/cc-engine.el | 6 ++++-- lisp/progmodes/cc-fonts.el | 4 ++-- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c506294c5a0..457f95f2ca3 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -8112,12 +8112,14 @@ comment at the start of cc-engine.el for more info." ;; initializing brace lists. (let (found) (while - (and (progn + (and (< (point) limit) + (progn ;; In the next loop, we keep searching forward whilst ;; we find ":"s which aren't single colons inside C++ ;; "for" statements. (while (and + (< (point) limit) (setq found (c-syntactic-re-search-forward "[;:,]\\|\\s)\\|\\(=\\|\\s(\\)" @@ -8139,7 +8141,7 @@ comment at the start of cc-engine.el for more info." (c-go-up-list-forward)) (setq brackets-after-id t)) (when found (backward-char)) - t)) + (<= (point) limit))) (list id-start id-end brackets-after-id (match-beginning 1) decorated) (goto-char here) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index acdb1ad1334..a2ac2a32535 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1062,7 +1062,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; The following `while' fontifies a single declarator id each time round. ;; It loops only when LIST is non-nil. (while - (and pos (setq decl-res (c-forward-declarator limit))) + (and pos (setq decl-res (c-forward-declarator))) (setq next-pos (point) id-start (car decl-res) id-face (if (and (eq (char-after) ?\() @@ -1091,7 +1091,7 @@ casts and declarations are fontified. Used on level 2 and higher." (throw 'is-function nil)) ((not (eq got-type 'maybe)) (throw 'is-function t))) - (c-forward-declarator limit t) + (c-forward-declarator nil t) (eq (char-after) ?,)) (forward-char) (c-forward-syntactic-ws)) -- cgit v1.2.3 From e562356c3f31bf96250bd3e8a7c50e8322b15d68 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 26 Oct 2017 02:43:33 +0300 Subject: Fix two js indentation problems Fix intentation problems reported in https://github.com/mooz/js2-mode/issues/463. * lisp/progmodes/js.el (js--continued-expression-p): Check syntax state after /. (js--multi-line-declaration-indentation): Check syntax state before "const". --- lisp/progmodes/js.el | 21 +++++++++++++++------ test/manual/indent/js.js | 9 +++++++++ 2 files changed, 24 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 2bbacf7bae4..1f86909362e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1834,10 +1834,15 @@ This performs fontification according to `js--class-styles'." (save-excursion (back-to-indentation) (if (js--looking-at-operator-p) - (or (not (memq (char-after) '(?- ?+))) - (progn - (forward-comment (- (point))) - (not (memq (char-before) '(?, ?\[ ?\())))) + (if (eq (char-after) ?/) + (prog1 + (not (nth 3 (syntax-ppss (1+ (point))))) + (forward-char -1)) + (or + (not (memq (char-after) '(?- ?+))) + (progn + (forward-comment (- (point))) + (not (memq (char-before) '(?, ?\[ ?\()))))) (and (js--find-newline-backward) (progn (skip-chars-backward " \t") @@ -1972,8 +1977,12 @@ statement spanning multiple lines; otherwise, return nil." (save-excursion (back-to-indentation) (when (not (looking-at js--declaration-keyword-re)) - (when (looking-at js--indent-operator-re) - (goto-char (match-end 0))) + (let ((pt (point))) + (when (looking-at js--indent-operator-re) + (goto-char (match-end 0))) + ;; The "operator" is probably a regexp literal opener. + (when (nth 3 (syntax-ppss)) + (goto-char pt))) (while (and (not at-opening-bracket) (not (bobp)) (let ((pos (point))) diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js index 1ad76a83e18..b0d8bcabd20 100644 --- a/test/manual/indent/js.js +++ b/test/manual/indent/js.js @@ -7,6 +7,9 @@ let c = 1, var e = 100500, + 1; +// Don't misinterpret "const" +/const/ + function test () { return /[/]/.test ('/') // (bug#19397) @@ -135,6 +138,12 @@ if (1) { : 4 } +// Regexp is not a continuation +bar( + "string arg1", + /abc/ +) + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 -- cgit v1.2.3 From 646e56e150ca08978d6ce736b12867b4958a0cd8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 26 Oct 2017 16:24:28 +0200 Subject: Fix Bug#28959 * lisp/net/tramp.el (tramp-handle-find-backup-file-name): Use `tramp-tramp-file-p' rather than `tramp-file-name-p'. Add hop to backup file name. (Bug#28959) * test/lisp/net/tramp-tests.el (tramp-test34-find-backup-file-name): New test. (tramp-test35-make-nearby-temp-file) (tramp-test36-special-characters) (tramp-test36-special-characters-with-stat) (tramp-test36-special-characters-with-perl) (tramp-test36-special-characters-with-ls, tramp-test37-utf8) (tramp-test37-utf8-with-stat, tramp-test37-utf8-with-perl) (tramp-test37-utf8-with-ls, tramp-test38-file-system-info) (tramp-test39-asynchronous-requests) (tramp-test40-recursive-load, tramp-test41-remote-load-path) (tramp-test42-delay-load, tramp-test43-unload): Rename. --- lisp/net/tramp.el | 4 +- test/lisp/net/tramp-tests.el | 132 ++++++++++++++++++++++++++++++++++++------- 2 files changed, 115 insertions(+), 21 deletions(-) (limited to 'lisp') diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 736c28c4aa8..e300b3a58ed 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3226,9 +3226,9 @@ User is always nil." (car x) (if (and (stringp (cdr x)) (file-name-absolute-p (cdr x)) - (not (tramp-file-name-p (cdr x)))) + (not (tramp-tramp-file-p (cdr x)))) (tramp-make-tramp-file-name - method user domain host port (cdr x)) + method user domain host port (cdr x) hop) (cdr x)))) tramp-backup-directory-alist) backup-directory-alist))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7e644e6a2bb..af707f85007 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3638,8 +3638,103 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-directory tmp-name2 'recursive)))))) +(ert-deftest tramp-test34-find-backup-file-name () + "Check `find-backup-file-name'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + ;; These settings are not used by Tramp, so we ignore them. + version-control delete-old-versions + (kept-old-versions (default-toplevel-value 'kept-old-versions)) + (kept-new-versions (default-toplevel-value 'kept-new-versions))) + + (unwind-protect + ;; Use default `backup-directory-alist' mechanism. + (let (backup-directory-alist tramp-backup-directory-alist) + (should + (equal + (find-backup-file-name tmp-name1) + (list + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (expand-file-name + (format "%s~" (file-name-nondirectory tmp-name1)) + tramp-test-temporary-file-directory))))))) + + (unwind-protect + ;; Map `backup-directory-alist'. + (let ((backup-directory-alist `(("." . ,tmp-name2))) + tramp-backup-directory-alist) + (should + (equal + (find-backup-file-name tmp-name1) + (list + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (expand-file-name + (format + "%s~" + ;; This is taken from `make-backup-file-name-1'. + (subst-char-in-string + ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + tmp-name2))))) + ;; The backup directory is created. + (should (file-directory-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name2 'recursive))) + + (unwind-protect + ;; Map `tramp-backup-directory-alist'. + (let ((tramp-backup-directory-alist `(("." . ,tmp-name2))) + backup-directory-alist) + (should + (equal + (find-backup-file-name tmp-name1) + (list + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (expand-file-name + (format + "%s~" + ;; This is taken from `make-backup-file-name-1'. + (subst-char-in-string + ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + tmp-name2))))) + ;; The backup directory is created. + (should (file-directory-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name2 'recursive))) + + (unwind-protect + ;; Map `tramp-backup-directory-alist' with local file name. + (let ((tramp-backup-directory-alist + `(("." . ,(file-remote-p tmp-name2 'localname)))) + backup-directory-alist) + (should + (equal + (find-backup-file-name tmp-name1) + (list + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (expand-file-name + (format + "%s~" + ;; This is taken from `make-backup-file-name-1'. + (subst-char-in-string + ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + tmp-name2))))) + ;; The backup directory is created. + (should (file-directory-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name2 'recursive)))))) + ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test34-make-nearby-temp-file () +(ert-deftest tramp-test35-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) ;; Since Emacs 26.1. @@ -3904,7 +3999,7 @@ This requires restrictions of file name syntax." (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test35-special-characters*'." + "Perform the test in `tramp-test36-special-characters*'." ;; Newlines, slashes and backslashes in file names are not ;; supported. So we don't test. And we don't test the tab ;; character on Windows or Cygwin, because the backslash is @@ -3947,7 +4042,7 @@ This requires restrictions of file name syntax." "{foo}bar{baz}")) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test35-special-characters () +(ert-deftest tramp-test36-special-characters () "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) @@ -3955,7 +4050,7 @@ This requires restrictions of file name syntax." (tramp--test-special-characters)) -(ert-deftest tramp-test35-special-characters-with-stat () +(ert-deftest tramp-test36-special-characters-with-stat () "Check special characters in file names. Use the `stat' command." :tags '(:expensive-test) @@ -3973,7 +4068,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test35-special-characters-with-perl () +(ert-deftest tramp-test36-special-characters-with-perl () "Check special characters in file names. Use the `perl' command." :tags '(:expensive-test) @@ -3994,7 +4089,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test35-special-characters-with-ls () +(ert-deftest tramp-test36-special-characters-with-ls () "Check special characters in file names. Use the `ls' command." :tags '(:expensive-test) @@ -4017,7 +4112,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test36-utf8*'." + "Perform the test in `tramp-test37-utf8*'." (let* ((utf8 (if (and (eq system-type 'darwin) (memq 'utf-8-hfs (coding-system-list))) 'utf-8-hfs 'utf-8)) @@ -4032,7 +4127,7 @@ Use the `ls' command." "银河系漫游指南系列" "Автостопом по гала́ктике"))) -(ert-deftest tramp-test36-utf8 () +(ert-deftest tramp-test37-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-docker-p))) @@ -4042,7 +4137,7 @@ Use the `ls' command." (tramp--test-utf8)) -(ert-deftest tramp-test36-utf8-with-stat () +(ert-deftest tramp-test37-utf8-with-stat () "Check UTF8 encoding in file names and file contents. Use the `stat' command." :tags '(:expensive-test) @@ -4062,7 +4157,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test36-utf8-with-perl () +(ert-deftest tramp-test37-utf8-with-perl () "Check UTF8 encoding in file names and file contents. Use the `perl' command." :tags '(:expensive-test) @@ -4085,7 +4180,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test36-utf8-with-ls () +(ert-deftest tramp-test37-utf8-with-ls () "Check UTF8 encoding in file names and file contents. Use the `ls' command." :tags '(:expensive-test) @@ -4108,7 +4203,7 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test37-file-system-info () +(ert-deftest tramp-test38-file-system-info () "Check that `file-system-info' returns proper values." (skip-unless (tramp--test-enabled)) ;; Since Emacs 27.1. @@ -4130,7 +4225,7 @@ Use the `ls' command." (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test38-asynchronous-requests () +(ert-deftest tramp-test39-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -4287,7 +4382,7 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive))))))) -(ert-deftest tramp-test39-recursive-load () +(ert-deftest tramp-test40-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -4310,7 +4405,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test40-remote-load-path () +(ert-deftest tramp-test41-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -4333,7 +4428,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test41-delay-load () +(ert-deftest tramp-test42-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -4355,7 +4450,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test42-unload () +(ert-deftest tramp-test43-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -4408,7 +4503,6 @@ Since it unloads Tramp, it shall be the last test to run." ;; * file-acl ;; * file-name-case-insensitive-p ;; * file-selinux-context -;; * find-backup-file-name ;; * set-file-acl ;; * set-file-selinux-context @@ -4417,7 +4511,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). ;; * Fix `tramp-test28-interrupt-process', timeout doesn't work reliably. -;; * Fix Bug#16928 in `tramp-test38-asynchronous-requests'. +;; * Fix Bug#16928 in `tramp-test39-asynchronous-requests'. (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]." -- cgit v1.2.3 From ad68bbd0da4ed90117f09dc2344c0c3d9d728851 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 26 Oct 2017 18:29:39 +0000 Subject: Fix another "wrong side of point" error in CC Mode. This fixes (a follow-up to) bug #28850. A internal generated form for scanning text to fontify had a LIMIT parameter. It also locally bound LIMIT to a value possibly beyond the original LIMIT, allowing point to move beyond the original LIMIT, and to create the wrong side error. Fix it by checking point is not beyond LIMIT in the outer context before using it. * lisp/progmodes/cc-fonts.el (c-make-font-lock-search-form): Add a new parameter CHECK-POINT which, when non-nil, directs the function to generate a check on point. (c-make-font-lock-context-search-function): Invoke the above function with new argument value t. --- lisp/progmodes/cc-fonts.el | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index a2ac2a32535..d352e5b08c9 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -292,12 +292,17 @@ nil))))) res)))) - (defun c-make-font-lock-search-form (regexp highlights) + (defun c-make-font-lock-search-form (regexp highlights &optional check-point) ;; Return a lisp form which will fontify every occurrence of REGEXP ;; (a regular expression, NOT a function) between POINT and `limit' ;; with HIGHLIGHTS, a list of highlighters as specified on page - ;; "Search-based Fontification" in the elisp manual. - `(while (re-search-forward ,regexp limit t) + ;; "Search-based Fontification" in the elisp manual. If CHECK-POINT + ;; is non-nil, we will check (< (point) limit) in the main loop. + `(while + ,(if check-point + `(and (< (point) limit) + (re-search-forward ,regexp limit t)) + `(re-search-forward ,regexp limit t)) (unless (progn (goto-char (match-beginning 0)) (c-skip-comments-and-strings limit)) @@ -476,7 +481,9 @@ ,(c-make-font-lock-search-form regexp highlights))))) state-stanzas) - ,(c-make-font-lock-search-form (car normal) (cdr normal)) + ;; In the next form, check that point hasn't been moved beyond + ;; `limit' in any of the above stanzas. + ,(c-make-font-lock-search-form (car normal) (cdr normal) t) nil)))) ; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. -- cgit v1.2.3 From 7b29db222f744d97c480ba9573cdc6900a727db6 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Fri, 27 Oct 2017 01:13:25 +0000 Subject: Enable gnus-read-ephemeral-* to run multiple times (bug#29008) NOTE: *DO NOT* merge this change to the trunk. * lisp/gnus/gnus-group.el (gnus-read-ephemeral-gmane-group) (gnus-read-ephemeral-bug-group): Make it work for any number of times for the case `url-automatic-caching' is set (bug#29008). --- lisp/gnus/gnus-group.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 4a41c495900..56d42b41a82 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2373,7 +2373,10 @@ specified by `gnus-gmane-group-download-format'." (with-temp-file tmpfile (url-insert-file-contents (format gnus-gmane-group-download-format - group start (+ start range))) + group start (+ start range)) + t) + ;; `url-insert-file-contents' sets this because of the 2nd arg. + (setq buffer-file-name nil) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range) @@ -2463,7 +2466,7 @@ the bug number, and browsing the URL must return mbox output." (if (and (not gnus-plugged) (file-exists-p file)) (insert-file-contents file) - (url-insert-file-contents (format mbox-url id))))) + (url-insert-file-contents (format mbox-url id) t)))) ;; Add the debbugs address so that we can respond to reports easily. (let ((address (format "%s@%s" (car ids) @@ -2488,7 +2491,9 @@ the bug number, and browsing the URL must return mbox output." (insert ", " address)) (insert "To: " address "\n"))) (goto-char (point-max)) - (widen))))) + (widen))) + ;; `url-insert-file-contents' sets this because of the 2nd arg. + (setq buffer-file-name nil))) (gnus-group-read-ephemeral-group (format "nndoc+ephemeral:bug#%s" (mapconcat 'number-to-string ids ",")) -- cgit v1.2.3 From 53aaad1dfc1f9e0ffe7ee457967426584cd7f541 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Fri, 27 Oct 2017 01:14:17 +0000 Subject: Make an example code introduced in the Gnus info work (bug#29008) You can find it in the bottom of (info "(gnus)Foreign Groups"). NOTE: this change is worth being merged to the trunk. * lisp/gnus/gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Allow a string for bug# (bug#29008). --- lisp/gnus/gnus-group.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 56d42b41a82..996e8266105 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2517,6 +2517,8 @@ the bug number, and browsing the URL must return mbox output." (interactive (list (string-to-number (read-string "Enter bug number: " (thing-at-point 'word) nil)))) + (when (stringp ids) + (setq ids (string-to-number ids))) (unless (listp ids) (setq ids (list ids))) (gnus-read-ephemeral-bug-group -- cgit v1.2.3 From 7f089aa5f6d208209b2cfef8e0d3d9530e191248 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Fri, 27 Oct 2017 20:21:26 +0900 Subject: Require seq in rmc.el * lisp/emacs-lisp/rmc.el: Require seq (Bug#28975). * test/lisp/emacs-lisp/rmc-tests.el (test-read-multiple-choice): Add test. --- lisp/emacs-lisp/rmc.el | 2 ++ test/lisp/emacs-lisp/rmc-tests.el | 41 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100644 test/lisp/emacs-lisp/rmc-tests.el (limited to 'lisp') diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index 0be6971992c..ca11c596638 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -23,6 +23,8 @@ ;;; Code: +(require 'seq) + ;;;###autoload (defun read-multiple-choice (prompt choices) "Ask user a multiple choice question. diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el new file mode 100644 index 00000000000..7ab79fda774 --- /dev/null +++ b/test/lisp/emacs-lisp/rmc-tests.el @@ -0,0 +1,41 @@ +;;; rmc-tests.el --- Test suite for rmc.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calancha +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'rmc) +(eval-when-compile (require 'cl-lib)) + + +(ert-deftest test-read-multiple-choice () + (dolist (char '(?y ?n)) + (cl-letf* (((symbol-function #'read-char) (lambda () char)) + (str (if (eq char ?y) "yes" "no"))) + (should (equal (list char str) + (read-multiple-choice "Do it? " '((?y "yes") (?n "no")))))))) + + +(provide 'rmc-tests) +;;; rmc-tests.el ends here -- cgit v1.2.3