commit 48e6e9a939cd0442497ee2e7b317d94ff9103cfb (HEAD, refs/remotes/origin/master) Author: Glenn Morris Date: Tue May 9 23:20:52 2017 -0700 Fix finding test .el files * test/Makefile.in (ELFILES): Exclude the data/ directory. * test/src/lread-tests.el (lread-test-bug26837): Revert previous. diff --git a/test/Makefile.in b/test/Makefile.in index 03ae32e3a6..4029bb2431 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -132,6 +132,7 @@ maybe_exclude_module_tests := -name emacs-module-tests.el -prune -o endif ELFILES := $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \ + -path "${srcdir}/data" -prune -o \ -name "*resources" -prune -o \ ${maybe_exclude_module_tests} \ -name "*.el" -print) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 80bc0c4a85..0427fe64e4 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -147,13 +147,12 @@ literals (Bug#20852)." (let ((load-path (cons (file-name-as-directory (expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY"))) - load-path)) - (fn (lambda (lib) - (load lib nil t) - (let ((str (caar load-history))) - (should (or (string-suffix-p (concat "/" lib ".el") str) - (string-suffix-p (concat "/" lib ".elc") str))))))) - (dolist (lib '("somelib" "somelib2" "somelib")) - (funcall fn lib)))) + load-path))) + (load "somelib" nil t) + (should (string-suffix-p "/somelib.el" (caar load-history))) + (load "somelib2" nil t) + (should (string-suffix-p "/somelib2.el" (caar load-history))) + (load "somelib" nil t) + (should (string-suffix-p "/somelib.el" (caar load-history))))) ;;; lread-tests.el ends here commit 4f391b9d6d8e117336ac758a168ae7c13198fda2 Author: Tino Calancha Date: Wed May 10 11:53:20 2017 +0900 Tweak a recent test This test fails in my local machine because the data files are compiled, and the test doesn't expect that. * test/src/lread-tests.el (lread-test-bug26837): Match a suffix ending with '.elc' when the data files are compiled. diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 0427fe64e4..80bc0c4a85 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -147,12 +147,13 @@ literals (Bug#20852)." (let ((load-path (cons (file-name-as-directory (expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY"))) - load-path))) - (load "somelib" nil t) - (should (string-suffix-p "/somelib.el" (caar load-history))) - (load "somelib2" nil t) - (should (string-suffix-p "/somelib2.el" (caar load-history))) - (load "somelib" nil t) - (should (string-suffix-p "/somelib.el" (caar load-history))))) + load-path)) + (fn (lambda (lib) + (load lib nil t) + (let ((str (caar load-history))) + (should (or (string-suffix-p (concat "/" lib ".el") str) + (string-suffix-p (concat "/" lib ".elc") str))))))) + (dolist (lib '("somelib" "somelib2" "somelib")) + (funcall fn lib)))) ;;; lread-tests.el ends here commit 8452db040905a7de460f8ff2c8b1dda28eed737c Author: Glenn Morris Date: Tue May 9 21:31:46 2017 -0400 Put license information in each generated uni-*.el * admin/unidata/unidata-gen.el (unidata-gen-file): Get Copyright line from copyright.html. Put information in file header, not separate README. (unidata-gen-charprop): Mention the source location. * lisp/international/README: Remove file. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 64e2babd4b..e1e896ce29 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -1401,19 +1401,26 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." data-dir (or (pop command-line-args-left) default-directory) unidata-text-file (or (pop command-line-args-left) (expand-file-name "unidata.txt")))) - (let ((coding-system-for-write 'utf-8-unix) - (coding-system-for-read 'utf-8) - (unidata-dir data-dir)) + (let* ((coding-system-for-write 'utf-8-unix) + (coding-system-for-read 'utf-8) + (unidata-dir data-dir) + (copyright (with-temp-buffer + (insert-file-contents + (expand-file-name "copyright.html" unidata-dir)) + (re-search-forward "^Copyright .*Unicode, Inc.") + (match-string 0)))) (or unidata-list (unidata-setup-list unidata-text-file)) (let* ((basename (file-name-nondirectory file)) (elt (assoc basename unidata-file-alist))) (or elt (user-error "Unknown output file: %s" basename)) (or noninteractive (message "Generating %s..." file)) (with-temp-file file - (insert ";; Copyright (C) 1991-2014 Unicode, Inc. -;; This file was generated from the Unicode data files at -;; http://www.unicode.org/Public/UNIDATA/. -;; See lisp/international/README for the copyright and permission notice.\n") + (insert ";; " copyright " +;; Generated from Unicode data files by unidata-gen.el. +;; The sources for this file are found in the admin/unidata/ directory in +;; the Emacs sources. The Unicode data files are used under the +;; Unicode Terms of Use, as contained in the file copyright.html in that +;; same directory.\n") (dolist (proplist (cdr elt)) (let ((prop (unidata-prop-prop proplist)) (index (unidata-prop-index proplist)) @@ -1443,7 +1450,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (defun unidata-gen-charprop (&optional charprop-file) (or charprop-file (setq charprop-file (pop command-line-args-left))) (with-temp-file charprop-file - (insert ";; Automatically generated by unidata-gen.el.\n") + (insert ";; Automatically generated by unidata-gen.el.\n" + ";; See the admin/unidata/ directory in the Emacs sources.\n") (dolist (elt unidata-file-alist) (dolist (proplist (cdr elt)) (insert (format "(define-char-code-property '%S %S\n %S)\n" diff --git a/lisp/international/README b/lisp/international/README deleted file mode 100644 index 88b6041a93..0000000000 --- a/lisp/international/README +++ /dev/null @@ -1,15 +0,0 @@ -The following files in this directory are derived from the Unicode -Data File at http://www.unicode.org/Public/UNIDATA/UnicodeData.txt: - - charprop.el uni-bidi.el uni-brackets.el uni-category.el - uni-combining.el uni-comment.el uni-decimal.el uni-decomposition.el - uni-digit.el uni-lowercase.el uni-mirrored.el uni-name.el - uni-numeric.el uni-old-name.el uni-special-lowercase.el - uni-special-titlecase.el uni-special-uppercase.el uni-titlecase.el - uni-uppercase.el - -These files were generated from the version admin/unidata/UnicodeData.txt -in the Emacs sources, using the file unidata-gen.el in the same directory. - -The file UnicodeData.txt is used under the Unicode Terms of Use, -contained in the file admin/unidata/copyright.html. commit e7b6751c0a74f24c14cd207d57a4e1a95f409256 Author: Noam Postavsky Date: Sun Apr 23 10:43:05 2017 -0400 Fix lisp-indent-region and indent-sexp (Bug#26619) The new lisp-indent-region introduced in 2017-04-22 "Add new `lisp-indent-region' that doesn't reparse the code." is broken because it doesn't save the calculated indent amounts for already seen sexp depths. Fix this by unifying the indent-sexp and lisp-indent-region code. Furthermore, only preserve position 2 of the running parse when the depth doesn't change. * lisp/emacs-lisp/lisp-mode.el (lisp-ppss): Use an OLDSTATE that corresponds with the start point when calling parse-partial-sexp. (lisp-indent-state): New struct. (lisp-indent-calc-next): New function, extracted from indent-sexp. (indent-sexp, lisp-indent-region): Use it. (lisp-indent-line): Take indentation, instead of parse state. * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-mode-tests--correctly-indented-sexp): New constant. (lisp-indent-region, lisp-indent-region-defun-with-docstring): (lisp-indent-region-open-paren, lisp-indent-region-in-sexp): New tests. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 7448864ff9..6287f27b13 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -754,49 +754,108 @@ function is `common-lisp-indent-function'." (defun lisp-ppss (&optional pos) "Return Parse-Partial-Sexp State at POS, defaulting to point. -Like to `syntax-ppss' but includes the character address of the -last complete sexp in the innermost containing list at position +Like `syntax-ppss' but includes the character address of the last +complete sexp in the innermost containing list at position 2 (counting from 0). This is important for lisp indentation." (unless pos (setq pos (point))) (let ((pss (syntax-ppss pos))) (if (nth 9 pss) - (parse-partial-sexp (car (last (nth 9 pss))) pos) + (let ((sexp-start (car (last (nth 9 pss))))) + (parse-partial-sexp sexp-start pos nil nil (syntax-ppss sexp-start))) pss))) +(cl-defstruct (lisp-indent-state + (:constructor nil) + (:constructor lisp-indent-initial-state + (&aux (ppss (lisp-ppss)) + (ppss-point (point)) + (depth (car ppss)) + (stack (make-list (1+ depth) nil))))) + stack ;; Cached indentation, per depth. + ppss + depth + ppss-point) + +(defun lisp-indent-calc-next (state) + "Move to next line and return calculated indent for it. +STATE is updated by side effect, the first state should be +created by `lisp-indent-initial-state'. This function may move +by more than one line to cross a string literal." + (pcase-let (((cl-struct lisp-indent-state + (stack indent-stack) ppss depth ppss-point) + state)) + ;; Parse this line so we can learn the state to indent the + ;; next line. + (while (let ((last-sexp (nth 2 ppss))) + (setq ppss (parse-partial-sexp + ppss-point (progn (end-of-line) (point)) + nil nil ppss)) + ;; Preserve last sexp of state (position 2) for + ;; `calculate-lisp-indent', if we're at the same depth. + (if (and (not (nth 2 ppss)) (= depth (car ppss))) + (setf (nth 2 ppss) last-sexp) + (setq last-sexp (nth 2 ppss))) + ;; Skip over newlines within strings. + (nth 3 ppss)) + (let ((string-start (nth 8 ppss))) + (setq ppss (parse-partial-sexp (point) (point-max) + nil nil ppss 'syntax-table)) + (setf (nth 2 ppss) string-start)) ; Finished a complete string. + (setq ppss-point (point))) + (setq ppss-point (point)) + (let* ((next-depth (car ppss)) + (depth-delta (- next-depth depth))) + (cond ((< depth-delta 0) + (setq indent-stack (nthcdr (- depth-delta) indent-stack))) + ((> depth-delta 0) + (setq indent-stack (nconc (make-list depth-delta nil) + indent-stack)))) + (setq depth next-depth)) + (prog1 + (let (indent) + (cond ((= (forward-line 1) 1) nil) + ((car indent-stack)) + ((integerp (setq indent (calculate-lisp-indent ppss))) + (setf (car indent-stack) indent)) + ((consp indent) ; (COLUMN CONTAINING-SEXP-START) + (car indent)) + ;; This only happens if we're in a string. + (t (error "This shouldn't happen")))) + (setf (lisp-indent-state-stack state) indent-stack) + (setf (lisp-indent-state-depth state) depth) + (setf (lisp-indent-state-ppss-point state) ppss-point) + (setf (lisp-indent-state-ppss state) ppss)))) + (defun lisp-indent-region (start end) "Indent region as Lisp code, efficiently." (save-excursion (setq end (copy-marker end)) (goto-char start) + (beginning-of-line) ;; The default `indent-region-line-by-line' doesn't hold a running ;; parse state, which forces each indent call to reparse from the ;; beginning. That has O(n^2) complexity. - (let* ((parse-state (lisp-ppss start)) - (last-syntax-point start) + (let* ((parse-state (lisp-indent-initial-state)) (pr (unless (minibufferp) (make-progress-reporter "Indenting region..." (point) end)))) - (while (< (point) end) - (unless (and (bolp) (eolp)) - (lisp-indent-line parse-state)) - (forward-line 1) - (let ((last-sexp (nth 2 parse-state))) - (setq parse-state (parse-partial-sexp last-syntax-point (point) - nil nil parse-state)) - ;; It's important to preserve last sexp location for - ;; `calculate-lisp-indent'. - (unless (nth 2 parse-state) - (setf (nth 2 parse-state) last-sexp)) - (setq last-syntax-point (point))) - (and pr (progress-reporter-update pr (point)))) + (let ((ppss (lisp-indent-state-ppss parse-state))) + (unless (or (and (bolp) (eolp)) (nth 3 ppss)) + (lisp-indent-line (calculate-lisp-indent ppss)))) + (let ((indent nil)) + (while (progn (setq indent (lisp-indent-calc-next parse-state)) + (< (point) end)) + (unless (or (and (bolp) (eolp)) (not indent)) + (lisp-indent-line indent)) + (and pr (progress-reporter-update pr (point))))) (and pr (progress-reporter-done pr)) (move-marker end nil)))) -(defun lisp-indent-line (&optional parse-state) +(defun lisp-indent-line (&optional indent) "Indent current line as Lisp code." (interactive) (let ((pos (- (point-max) (point))) (indent (progn (beginning-of-line) - (calculate-lisp-indent (or parse-state (lisp-ppss)))))) + (or indent (calculate-lisp-indent (lisp-ppss)))))) (skip-chars-forward " \t") (if (or (null indent) (looking-at "\\s<\\s<\\s<")) ;; Don't alter indentation of a ;;; comment line @@ -1116,16 +1175,7 @@ Lisp function does not specify a special indentation." If optional arg ENDPOS is given, indent each line, stopping when ENDPOS is encountered." (interactive) - (let* ((indent-stack (list nil)) - ;; Use `syntax-ppss' to get initial state so we don't get - ;; confused by starting inside a string. We don't use - ;; `syntax-ppss' in the loop, because this is measurably - ;; slower when we're called on a long list. - (state (syntax-ppss)) - (init-depth (car state)) - (next-depth init-depth) - (last-depth init-depth) - (last-syntax-point (point))) + (let* ((parse-state (lisp-indent-initial-state))) ;; We need a marker because we modify the buffer ;; text preceding endpos. (setq endpos (copy-marker @@ -1135,64 +1185,20 @@ ENDPOS is encountered." (save-excursion (forward-sexp 1) (point))))) (save-excursion (while (< (point) endpos) - ;; Parse this line so we can learn the state to indent the - ;; next line. Preserve element 2 of the state (last sexp) for - ;; `calculate-lisp-indent'. - (let ((last-sexp (nth 2 state))) - (while (progn - (setq state (parse-partial-sexp - last-syntax-point (progn (end-of-line) (point)) - nil nil state)) - (setq last-sexp (or (nth 2 state) last-sexp)) - ;; Skip over newlines within strings. - (nth 3 state)) - (setq state (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table)) - (setq last-sexp (or (nth 2 state) last-sexp)) - (setq last-syntax-point (point))) - (setf (nth 2 state) last-sexp)) - (setq next-depth (car state)) - ;; If the line contains a comment indent it now with - ;; `indent-for-comment'. - (when (nth 4 state) - (indent-for-comment) - (end-of-line)) - (setq last-syntax-point (point)) - (when (< next-depth init-depth) - (setq indent-stack (nconc indent-stack - (make-list (- init-depth next-depth) nil)) - last-depth (- last-depth next-depth) - next-depth init-depth)) - ;; Now indent the next line according to what we learned from - ;; parsing the previous one. - (forward-line 1) - (when (< (point) endpos) - (let ((depth-delta (- next-depth last-depth))) - (cond ((< depth-delta 0) - (setq indent-stack (nthcdr (- depth-delta) indent-stack))) - ((> depth-delta 0) - (setq indent-stack (nconc (make-list depth-delta nil) - indent-stack)))) - (setq last-depth next-depth)) + (let ((indent (lisp-indent-calc-next parse-state))) + ;; If the line contains a comment indent it now with + ;; `indent-for-comment'. + (when (nth 4 (lisp-indent-state-ppss parse-state)) + (save-excursion + (goto-char (lisp-indent-state-ppss-point parse-state)) + (indent-for-comment) + (setf (lisp-indent-state-ppss-point parse-state) + (line-end-position)))) ;; But not if the line is blank, or just a comment (we ;; already called `indent-for-comment' above). (skip-chars-forward " \t") - (unless (or (eolp) (eq (char-syntax (char-after)) ?<)) - (indent-line-to - (or (car indent-stack) - ;; The state here is actually to the end of the - ;; previous line, but that's fine for our purposes. - ;; And parsing over the newline would only destroy - ;; element 2 (last sexp position). - (let ((val (calculate-lisp-indent state))) - (cond ((integerp val) - (setf (car indent-stack) val)) - ((consp val) ; (COLUMN CONTAINING-SEXP-START) - (car val)) - ;; `calculate-lisp-indent' only returns nil - ;; when we're in a string, but this won't - ;; happen because we skip strings above. - (t (error "This shouldn't happen!")))))))))) + (unless (or (eolp) (eq (char-syntax (char-after)) ?<) (not indent)) + (indent-line-to indent))))) (move-marker endpos nil))) (defun indent-pp-sexp (&optional arg) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 27f0bb5ec1..1f78eb3010 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -21,10 +21,7 @@ (require 'cl-lib) (require 'lisp-mode) -(ert-deftest indent-sexp () - "Test basics of \\[indent-sexp]." - (with-temp-buffer - (insert "\ +(defconst lisp-mode-tests--correctly-indented-sexp "\ \(a (prog1 (prog1 @@ -42,9 +39,14 @@ noindent\" 3 2) ; comment ;; comment b)") + +(ert-deftest indent-sexp () + "Test basics of \\[indent-sexp]." + (with-temp-buffer + (insert lisp-mode-tests--correctly-indented-sexp) (goto-char (point-min)) (let ((indent-tabs-mode nil) - (correct (buffer-string))) + (correct lisp-mode-tests--correctly-indented-sexp)) (dolist (mode '(fundamental-mode emacs-lisp-mode)) (funcall mode) (indent-sexp) @@ -97,5 +99,78 @@ noindent\" 3 (indent-sexp) (should (equal (buffer-string) correct))))) +(ert-deftest lisp-indent-region () + "Test basics of `lisp-indent-region'." + (with-temp-buffer + (insert lisp-mode-tests--correctly-indented-sexp) + (goto-char (point-min)) + (let ((indent-tabs-mode nil) + (correct lisp-mode-tests--correctly-indented-sexp)) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + ;; Don't mess up correctly indented code. + (should (string= (buffer-string) correct)) + ;; Correctly add indentation. + (save-excursion + (while (not (eobp)) + (delete-horizontal-space) + (forward-line))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct)) + ;; Correctly remove indentation. + (save-excursion + (let ((n 0)) + (while (not (eobp)) + (unless (looking-at "noindent\\|^[[:blank:]]*$") + (insert (make-string n ?\s))) + (cl-incf n) + (forward-line)))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + + +(ert-deftest lisp-indent-region-defun-with-docstring () + "Test Bug#26619." + (with-temp-buffer + (insert "\ +\(defun test () + \"This is a test. +Test indentation in emacs-lisp-mode\" + (message \"Hi!\"))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + +(ert-deftest lisp-indent-region-open-paren () + (with-temp-buffer + (insert "\ +\(with-eval-after-load 'foo + (setq bar `( + baz)))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + +(ert-deftest lisp-indent-region-in-sexp () + (with-temp-buffer + (insert "\ +\(when t + (when t + (list 1 2 3) + 'etc) + (quote etc) + (quote etc))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (search-backward "1") + (indent-region (point) (point-max)) + (should (equal (buffer-string) correct))))) + + (provide 'lisp-mode-tests) ;;; lisp-mode-tests.el ends here commit 17e540aa428c5392f7a9b4c1f7495bac8a8fe5da Author: Dmitry Gutov Date: Wed May 10 03:34:16 2017 +0300 Simplify url-encode-url and add a test * lisp/url/url-util.el (url-encode-url): Simplify. url-generic-parse-url copes with multibyte strings just fine (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24117#185). * test/lisp/url/url-parse-tests.el (url-generic-parse-url/multibyte-host-and-path): New test. diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 46d2d8ce5f..9897dea9c7 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -450,13 +450,10 @@ This function also performs URI normalization, e.g. converting the scheme to lowercase if it is uppercase. Apart from normalization, if URL is already URI-encoded, this function should return it unchanged." - (if (multibyte-string-p url) - (setq url (encode-coding-string url 'utf-8))) (let* ((obj (url-generic-parse-url url)) (user (url-user obj)) (pass (url-password obj)) - (host (url-host obj)) - (path-and-query (url-path-and-query obj)) + (path-and-query (url-path-and-query obj)) (path (car path-and-query)) (query (cdr path-and-query)) (frag (url-target obj))) @@ -464,12 +461,6 @@ should return it unchanged." (setf (url-user obj) (url-hexify-string user))) (if pass (setf (url-password obj) (url-hexify-string pass))) - ;; No special encoding for IPv6 literals. - (and host - (not (string-match "\\`\\[.*\\]\\'" host)) - (setf (url-host obj) - (decode-coding-string (url-host obj) 'utf-8))) - (if path (setq path (url-hexify-string path url-path-allowed-chars))) (if query diff --git a/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el index 05da7280aa..fd8abb0a5e 100644 --- a/test/lisp/url/url-parse-tests.el +++ b/test/lisp/url/url-parse-tests.el @@ -162,6 +162,11 @@ (should (equal (url-generic-parse-url "#") (url-parse-make-urlobj nil nil nil nil nil "" "" nil nil))) (should (equal (url-generic-parse-url "#foo") (url-parse-make-urlobj nil nil nil nil nil "" "foo" nil nil)))) +(ert-deftest url-generic-parse-url/multibyte-host-and-path () + (should (equal (url-generic-parse-url "http://банки.рф/фыва/") + (url-parse-make-urlobj "http" nil nil "банки.рф" nil + "/фыва/" nil nil t)))) + (provide 'url-parse-tests) ;;; url-parse-tests.el ends here commit 58326f0f117b229b690023d3851a00d876a7aca6 Author: Glenn Morris Date: Tue May 9 19:47:16 2017 -0400 More informative error when required feature missing * src/fns.c (Frequire): Include file name in missing feature error. * doc/lispref/loading.texi (Named Features): Don't quote actual error. diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 1199cfaa0f..d925c8c8f6 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -900,8 +900,7 @@ if loading the file fails. Normally, @code{require} returns @var{feature}. If loading the file succeeds but does not provide @var{feature}, -@code{require} signals an error, @samp{Required feature @var{feature} -was not provided}. +@code{require} signals an error about the missing feature. @end defun @defun featurep feature &optional subfeature diff --git a/src/fns.c b/src/fns.c index 10d35b6112..0332ab5dad 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2797,8 +2797,17 @@ suppressed. */) tem = Fmemq (feature, Vfeatures); if (NILP (tem)) - error ("Required feature `%s' was not provided", - SDATA (SYMBOL_NAME (feature))); + { + unsigned char *tem2 = SDATA (SYMBOL_NAME (feature)); + Lisp_Object tem3 = Fcar (Fcar (Vload_history)); + + if (NILP (tem3)) + error ("Required feature `%s' was not provided", tem2); + else + /* Cf autoload-do-load. */ + error ("Loading file %s failed to provide feature `%s'", + SDATA (tem3), tem2); + } /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; commit db30296baed2d9c3c80eb89f6fae256e81ee2fbc Author: Glenn Morris Date: Tue May 9 19:44:09 2017 -0400 Put re-loaded file back at start of load-history (bug#26837) * src/lread.c (readevalloop): Fix the "whole buffer" check to operate in the correct buffer. (Feval_buffer): Move point back to the start after checking for lexical binding. * test/src/lread-tests.el (lread-test-bug26837): New test. * test/data/somelib.el, test/data/somelib2.el: New test data files. diff --git a/src/lread.c b/src/lread.c index 6467043b1d..f0ad0c28e5 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1885,7 +1885,7 @@ readevalloop (Lisp_Object readcharfun, /* On the first cycle, we can easily test here whether we are reading the whole buffer. */ if (b && first_sexp) - whole_buffer = (PT == BEG && ZV == Z); + whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b)); instream = stream; read_next: @@ -2008,6 +2008,7 @@ This function preserves the position of point. */) record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); + BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); diff --git a/test/data/somelib.el b/test/data/somelib.el new file mode 100644 index 0000000000..7b8d403739 --- /dev/null +++ b/test/data/somelib.el @@ -0,0 +1,7 @@ +;;; -*- lexical-binding: t; -*- + +;; blah + +(defun somefunc () t) + +(provide 'somelib) diff --git a/test/data/somelib2.el b/test/data/somelib2.el new file mode 100644 index 0000000000..05156145a2 --- /dev/null +++ b/test/data/somelib2.el @@ -0,0 +1,7 @@ +;;; -*- lexical-binding: t; -*- + +;; blah + +(defun somefunc2 () t) + +(provide 'somelib2) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 84342348d4..0427fe64e4 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -142,4 +142,17 @@ literals (Bug#20852)." "unescaped character literals " "\", (, ), ;, [, ] detected!"))))) +(ert-deftest lread-test-bug26837 () + "Test for http://debbugs.gnu.org/26837 ." + (let ((load-path (cons + (file-name-as-directory + (expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY"))) + load-path))) + (load "somelib" nil t) + (should (string-suffix-p "/somelib.el" (caar load-history))) + (load "somelib2" nil t) + (should (string-suffix-p "/somelib2.el" (caar load-history))) + (load "somelib" nil t) + (should (string-suffix-p "/somelib.el" (caar load-history))))) + ;;; lread-tests.el ends here commit d6d5020c2593a1e8ac2fe7ef4f217cfbcacfd32d Author: Glenn Morris Date: Tue May 9 13:03:04 2017 -0400 Don't duplicate autoload code in package.el * lisp/emacs-lisp/autoload.el (autoload-rubric): Add a package option. * lisp/emacs-lisp/package.el (autoload-rubric): Declare. (package-autoload-ensure-default-file): Use autoload-rubric. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 8ad5e6b823..f6b09dcf31 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -355,24 +355,32 @@ put the output in." (defun autoload-rubric (file &optional type feature) "Return a string giving the appropriate autoload rubric for FILE. TYPE (default \"autoloads\") is a string stating the type of -information contained in FILE. If FEATURE is non-nil, FILE -will provide a feature. FEATURE may be a string naming the -feature, otherwise it will be based on FILE's name. +information contained in FILE. TYPE \"package\" acts like the default, +but adds an extra line to the output to modify `load-path'. + +If FEATURE is non-nil, FILE will provide a feature. FEATURE may +be a string naming the feature, otherwise it will be based on +FILE's name. At present, a feature is in fact always provided, but this should not be relied upon." - (let ((basename (file-name-nondirectory file))) + (let ((basename (file-name-nondirectory file)) + (lp (if (equal type "package") (setq type "autoloads")))) (concat ";;; " basename " --- automatically extracted " (or type "autoloads") "\n" ";;\n" ";;; Code:\n\n" - " \n" - ;; This is used outside of autoload.el, eg cus-dep, finder. - "(provide '" - (if (stringp feature) - feature - (file-name-sans-extension basename)) - ")\n" + (if lp + ;; `load-path' should contain only directory names. + "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n \n" + (concat + ;; This is used outside of autoload.el, eg cus-dep, finder. + " \n" + "(provide '" + (if (stringp feature) + feature + (file-name-sans-extension basename)) + ")\n")) ";; Local Variables:\n" ";; version-control: never\n" ";; no-byte-compile: t\n" diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7ae7ffff1a..c0ecb0447f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -905,25 +905,13 @@ untar into a directory named DIR; otherwise, signal an error." nil pkg-file nil 'silent)))) ;;;; Autoload -;; From Emacs 22, but changed so it adds to load-path. +(declare-function autoload-rubric "autoload" (file &optional type feature)) + (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." (unless (file-exists-p file) - (write-region - (concat ";;; " (file-name-nondirectory file) - " --- automatically extracted autoloads\n" - ";;\n" - ";;; Code:\n" - ;; `load-path' should contain only directory names - "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n" - " \n;; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" - ";; no-update-autoloads: t\n" - ";; End:\n" - ";;; " (file-name-nondirectory file) - " ends here\n") - nil file nil 'silent)) + (require 'autoload) + (write-region (autoload-rubric file "package" nil) nil file nil 'silent)) file) (defvar generated-autoload-file) commit 4c08509b3a250781039b9f957a9615ea9afe6aa9 Author: Michael Albinus Date: Tue May 9 14:35:56 2017 +0200 * test/lisp/net/tramp-tests.el: Keep additional test. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8db54979b6..a380e95c1a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1744,12 +1744,14 @@ This checks also `file-name-as-directory', `file-name-directory', (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn + ;; Write buffer. (with-temp-buffer (insert "foo") (write-region nil nil tmp-name)) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) + ;; Append. (with-temp-buffer (insert "bla") @@ -1757,11 +1759,19 @@ This checks also `file-name-as-directory', `file-name-directory', (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foobla"))) + (with-temp-buffer + (insert "baz") + (write-region nil nil tmp-name 3)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foobaz"))) + ;; Write string. (write-region "foo" nil tmp-name) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) + ;; Write partly. (with-temp-buffer (insert "123456789") commit daaec72a82e76f916e639acb51a8ad602433e8a9 Author: Noam Postavsky Date: Mon May 8 22:17:53 2017 -0400 Revert "Output number of characters added to file (Bug#354)" The extra message text turned out to be quite annoying in practice, and is generally more trouble than it's worth. Also revert several related changes. Partially revert "Handle `write-region' messages in Tramp properly" Revert "New var write-region-verbose, default nil" Revert "* src/fileio.c (write_region): Don't say "1 characters". (Bug#26796)" Revert "Minor tuneup of write-region change" Revert "Adjust write-region so file name is at the beginning again" Revert "Fix handling of non-integer START param to write-region" Revert "Output number of characters added to file (Bug#354)" * doc/emacs/files.texi (Misc File Ops): * etc/NEWS: * lisp/epa-file.el (epa-file-write-region): * lisp/gnus/mm-util.el (mm-append-to-file): * lisp/jka-compr.el (jka-compr-write-region): * lisp/net/ange-ftp.el (ange-ftp-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): * lisp/net/tramp.el (tramp-handle-write-region-message): * src/fileio.c (write_region, syms_of_fileio): * test/lisp/net/tramp-tests.el (tramp-test10-write-region): Remove extra characters from file writing messages. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index d36fe6541e..5e6afa5506 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1656,12 +1656,9 @@ similar to the @kbd{M-x find-file-literally} command @kbd{M-x write-region} is the inverse of @kbd{M-x insert-file}; it copies the contents of the region into the specified file. @kbd{M-x append-to-file} adds the text of the region to the end of the -specified file. @xref{Accumulating Text}. When called interactively, -these commands print a message in the echo area giving the name -of the file affected; if the variable @code{write-region-verbose} is -non-nil the message also reports the number of characters written. -The variable @code{write-region-inhibit-fsync} applies to -these commands, as well as saving files; see @ref{Customize Save}. +specified file. @xref{Accumulating Text}. The variable +@code{write-region-inhibit-fsync} applies to these commands, as well +as saving files; see @ref{Customize Save}. @findex set-file-modes @cindex file modes diff --git a/etc/NEWS b/etc/NEWS index 1f1f4b4b4b..4c0f4d2904 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -93,11 +93,6 @@ required capabilities are found in terminfo. See the FAQ node * Changes in Emacs 26.1 -+++ -** The functions write-region, append-to-file, and the like now also -output the number of characters added in addition to the name of the -file affected, if the new variable 'write-region-verbose' is non-nil. - ** The variable 'emacs-version' no longer includes the build number. This is now stored separately in a new variable, 'emacs-build-number'. diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 64e00e0aba..c97acb837a 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -290,10 +290,7 @@ If no one is selected, symmetric encryption will be performed. " (if (or (eq visit t) (eq visit nil) (stringp visit)) - (message "Wrote `%s' (%d characters)" buffer-file-name - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))))) + (message "Wrote %s" buffer-file-name)))) (put 'write-region 'epa-file 'epa-file-write-region) (defun epa-file-select-keys () diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index f4e79e5373..89f397e3ed 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -736,7 +736,7 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." inhibit-file-name-handlers) inhibit-file-name-handlers))) (write-region start end filename t 'no-message) - (message "Appended to `%s' (%d characters)" filename (- end start)))) + (message "Appended to %s" filename))) (defun mm-write-region (start end filename &optional append visit lockname coding-system inhibit) diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index e4f7348c81..26a7cf506f 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -357,10 +357,7 @@ There should be no more than seven characters after the final `/'." (and (or (eq visit t) (eq visit nil) (stringp visit)) - (message "Wrote `%s' (%d characters)" visit-file - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))) + (message "Wrote %s" visit-file)) ;; ensure `last-coding-system-used' has an appropriate value (setq last-coding-system-used coding-system-used) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 7b8b3fc880..ecb60e5a4f 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3284,10 +3284,7 @@ system TYPE.") (set-buffer-modified-p nil))) ;; ensure `last-coding-system-used' has an appropriate value (setq last-coding-system-used coding-system-used) - (ange-ftp-message "Wrote `%s' (%d characters)" abbr - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start)))) + (ange-ftp-message "Wrote %s" abbr) (ange-ftp-add-file-entry filename)) (ange-ftp-real-write-region start end filename append visit)))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 8bbdca795e..2825532c52 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -652,8 +652,6 @@ But handle the case, if the \"test\" command is not available." (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime)) - (tramp-handle-write-region-message v start end filename append visit) - (unless (equal curbuf (current-buffer)) (tramp-error v 'file-error diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 55fddf3dbd..cf3906aef3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1224,7 +1224,8 @@ file-notify events." (file-attributes filename)))) ;; The end. - (tramp-handle-write-region-message v start end filename append visit) + (when (or (eq visit t) (null visit) (stringp visit)) + (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index adadf9650e..e61b0ce526 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3412,7 +3412,8 @@ the result will be a local, non-Tramp, file name." ;; Set the ownership. (when need-chown (tramp-set-file-uid-gid filename uid gid)) - (tramp-handle-write-region-message v start end filename append visit) + (when (or (eq visit t) (null visit) (stringp visit)) + (tramp-message v 0 "Wrote %s" filename)) (run-hooks 'tramp-handle-write-region-hook))))) (defvar tramp-vc-registered-file-names nil diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4b288e199a..12eb367951 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1521,8 +1521,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." v 'file-error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) (when (eq visit t) - (set-visited-file-modtime)) - (tramp-handle-write-region-message v start end filename append visit)))) + (set-visited-file-modtime))))) ;; Internal file name functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4a1900c6f8..071114a015 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2753,27 +2753,6 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") -(defsubst tramp-handle-write-region-message - (vec start end filename &optional append visit) - "Message to be written for `tramp-*-handle-write-region'" - ;; We shall also don't write when autosaving. How to check? - (when (and (null noninteractive) - (or (eq visit t) (null visit) (stringp visit))) - (let ((nchars (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))) - (tramp-message - vec 0 "%s `%s'%s" - (cond - ((numberp append) "Updated") - (append "Added to") - (t "Wrote")) - filename - (cond - ((null (bound-and-true-p write-region-verbose)) "") - ((= nchars 1) " (1 character)") - (t (format " (%d characters)" nchars))))))) - (defun tramp-handle-directory-file-name (directory) "Like `directory-file-name' for Tramp files." ;; If localname component of filename is "/", leave it unchanged. diff --git a/src/fileio.c b/src/fileio.c index 6138bfc68b..acbf76e0d8 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5150,29 +5150,13 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } if (!auto_saving && !noninteractive) - { - EMACS_INT nchars = (STRINGP (start) ? SCHARS (start) - : XINT (end) - XINT (start)); - AUTO_STRING (format, - (NUMBERP (append) - ? (NILP (Vwrite_region_verbose) - ? "Updated `%s'" - : nchars == 1 - ? "Updated `%s' (1 character)" - : "Updated `%s' (%d characters)") - : ! NILP (append) - ? (NILP (Vwrite_region_verbose) - ? "Added to `%s'" - : nchars == 1 - ? "Added to `%s' (1 character)" - : "Added to `%s' (%d characters)") - : (NILP (Vwrite_region_verbose) - ? "Wrote `%s'" - : nchars == 1 - ? "Wrote `%s' (1 character)" - : "Wrote `%s' (%d characters)"))); - CALLN (Fmessage, format, visit_file, make_number (nchars)); - } + message_with_string ((NUMBERP (append) + ? "Updated %s" + : ! NILP (append) + ? "Added to %s" + : "Wrote %s"), + visit_file, 1); + return Qnil; } @@ -6142,11 +6126,6 @@ These are the annotations made by other annotation functions that were already called. See also `write-region-annotate-functions'. */); Vwrite_region_annotations_so_far = Qnil; - DEFVAR_LISP ("write-region-verbose", - Vwrite_region_verbose, - doc: /* If non-nil, be more verbose when writing a region. */); - Vwrite_region_verbose = Qnil; - DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers, doc: /* A list of file name handlers that temporarily should not be used. This applies only to the operation `inhibit-file-name-operation'. */); diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 742bdfd934..8db54979b6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -39,7 +39,6 @@ (require 'dired) (require 'ert) -(require 'ert-x) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -81,9 +80,6 @@ (when (getenv "NIX_STORE") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) -(defvar tramp--test-messages nil - "Captured messages from *Messages* buffer.") - (defvar tramp--test-expensive-test (null (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) @@ -1745,77 +1741,31 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-enabled)) (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) - (text-quoting-style 'grave) - (write-region-verbose - (and (null noninteractive) (boundp 'write-region-verbose))) - (tramp-message-show-message - (or tramp-message-show-message write-region-verbose))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect - (ert-with-message-capture tramp--test-messages - ;; Write buffer. - (setq tramp--test-messages "") + (progn (with-temp-buffer (insert "foo") (write-region nil nil tmp-name)) - (when write-region-verbose - (should - (string-match - (format "Wrote `%s' (3 characters)" tmp-name) - tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) - ;; Append. - (setq tramp--test-messages "") (with-temp-buffer (insert "bla") (write-region nil nil tmp-name 'append)) - (when write-region-verbose - (should - (string-match - (format "Added to `%s' (3 characters)" tmp-name) - tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foobla"))) - - (setq tramp--test-messages "") - (with-temp-buffer - (insert "baz") - (write-region nil nil tmp-name 3)) - (when write-region-verbose - (should - (string-match - (format "Updated `%s' (3 characters)" tmp-name) - tramp--test-messages))) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foobaz"))) - ;; Write string. - (setq tramp--test-messages "") (write-region "foo" nil tmp-name) - (when write-region-verbose - (should - (string-match - (format "Wrote `%s' (3 characters)" tmp-name) - tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) - ;; Write partly. - (setq tramp--test-messages "") (with-temp-buffer (insert "123456789") (write-region 3 5 tmp-name)) - (when write-region-verbose - (should - (string-match - (format "Wrote `%s' (2 characters)" tmp-name) - tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "34")))) commit 5e2cf8c804fe5fb3f97e0d777c0e0d8efd00b89a Author: Ken Brown Date: Mon May 8 15:11:23 2017 -0400 Skip a test from filenotify-tests.el on Cygwin * test/lisp/filenotify-tests.el (file-notify-test02-rm-watch): Skip the last part of the test on Cygwin; it fails due to timing issues. (file-notify--test-read-event): Remove `sit-for' that was added for Cygwin. diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 78a68f21bd..8a31c2cd8b 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -69,7 +69,6 @@ (defun file-notify--test-read-event () "Read one event. There are different timeouts for local and remote file notification libraries." - (sit-for 0.001 'nodisp) (read-event nil nil (cond @@ -405,7 +404,11 @@ This returns only for the local case and gfilenotify; otherwise it is nil. (file-notify--test-cleanup)) (unwind-protect - ;; Check, that removing watch descriptors out of order do not harm. + ;; Check, that removing watch descriptors out of order do not + ;; harm. This fails on Cygwin because of timing issues unless a + ;; long `sit-for' is added before the call to + ;; `file-notify--test-read-event'. + (if (not (eq system-type 'cygwin)) (let (results) (cl-flet ((first-callback (event) (when (eq (nth 1 event) 'deleted) (push 1 results))) @@ -434,7 +437,7 @@ This returns only for the local case and gfilenotify; otherwise it is nil. (should (equal results (list 2))) ;; The environment shall be cleaned up. - (file-notify--test-cleanup-p))) + (file-notify--test-cleanup-p)))) ;; Cleanup. (file-notify--test-cleanup))) commit 7ff7624a7aa62f30cabf14744e182e9ea6156290 Author: Paul Eggert Date: Mon May 8 10:46:21 2017 -0700 Merge from gnulib This incorporates: 2017-05-08 intprops: don’t depend on ‘verify’ 2017-05-07 utimens: on native Windows, improve resolution if fd < 0 2017-05-07 utimens: Improve error code on native Windows * lib/intprops.h, lib/utimens.c: Copy from gnulib. diff --git a/lib/intprops.h b/lib/intprops.h index 1ea9647e16..8f5ad54515 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -21,7 +21,6 @@ #define _GL_INTPROPS_H #include -#include /* Return a value with the common real type of E and V and the value of V. */ #define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) @@ -80,24 +79,7 @@ /* This include file assumes that signed types are two's complement without padding bits; the above macros have undefined behavior otherwise. If this is a problem for you, please let us know how to fix it for your host. - As a sanity check, test the assumption for some signed types that - bounds. */ -verify (TYPE_MINIMUM (signed char) == SCHAR_MIN); -verify (TYPE_MAXIMUM (signed char) == SCHAR_MAX); -verify (TYPE_MINIMUM (short int) == SHRT_MIN); -verify (TYPE_MAXIMUM (short int) == SHRT_MAX); -verify (TYPE_MINIMUM (int) == INT_MIN); -verify (TYPE_MAXIMUM (int) == INT_MAX); -verify (TYPE_MINIMUM (long int) == LONG_MIN); -verify (TYPE_MAXIMUM (long int) == LONG_MAX); -#ifdef LLONG_MAX -verify (TYPE_MINIMUM (long long int) == LLONG_MIN); -verify (TYPE_MAXIMUM (long long int) == LLONG_MAX); -#endif -/* Similarly, sanity-check one ISO/IEC TS 18661-1:2014 macro if defined. */ -#ifdef UINT_WIDTH -verify (TYPE_WIDTH (unsigned int) == UINT_WIDTH); -#endif + This assumption is tested by the intprops-tests module. */ /* Does the __typeof__ keyword work? This could be done by 'configure', but for now it's easier to do it by hand. */ diff --git a/lib/utimens.c b/lib/utimens.c index 5f3a846ea2..b4bfa8e322 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -349,11 +349,19 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) return 0; else { - #if 0 DWORD sft_error = GetLastError (); - fprintf (stderr, "utime SetFileTime error 0x%x\n", (unsigned int) sft_error); + #if 0 + fprintf (stderr, "fdutimens SetFileTime error 0x%x\n", (unsigned int) sft_error); #endif - errno = EINVAL; + switch (sft_error) + { + case ERROR_ACCESS_DENIED: /* fd was opened without O_RDWR */ + errno = EACCES; /* not specified by POSIX */ + break; + default: + errno = EINVAL; + break; + } return -1; } } @@ -465,7 +473,9 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) return -1; } -#if HAVE_WORKING_UTIMES +#ifdef USE_SETFILETIME + return _gl_utimens_windows (file, ts); +#elif HAVE_WORKING_UTIMES return utimes (file, t); #else { commit e93f39d2e6b56319511f778e85da32ba05359668 Author: Wilson Snyder Date: Mon May 8 13:44:47 2017 -0400 Fix various verilog-mode.el issues. * lisp/progmodes/verilog-mode.el (verilog-read-decls): Fix SystemVerilog 2012 import breaking AUTOINST. Reported by Johannes Schaefer. (verilog-auto-wire-type, verilog-insert-definition): Fix AUTOWIRE using logic in top-level non-SystemVerilog module, bug1142. Reported by Marcin K. (verilog-define-abbrev-table) (verilog-mode-abbrev-table): Don't expand abbrev inside comment/strings, bug1102. Reported by Slava Yuzhaninov. (verilog-auto): Fix AUTORESET widths pulling from AUTOREGINPUT, msg2143. Reported by Galen Seitz. (verilog-modify-compile-command): Fix expansion of __FLAGS__ when compile-command is globally set, bug1119. Reported by Galen Seitz. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 4860ea2599..ea1ad7c064 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,7 +123,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2016-11-14-26d3540-vpo-GNU" +(defconst verilog-mode-version "2017-05-08-b240c8f-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -387,6 +387,14 @@ wherever possible, since it is slow." ;; `("Verilog" ("MA" ["SAA" nil :help "Help SAA"] ["SAB" nil :help "Help SAA"]) ;; "----" ["MB" nil :help "Help MB"])) +(defun verilog-define-abbrev-table (tablename definitions &optional docstring &rest props) + "Filter `define-abbrev-table' TABLENAME DEFINITIONS +Provides DOCSTRING PROPS in newer Emacs (23.1)." + (condition-case nil + (apply 'define-abbrev-table tablename definitions docstring props) + (error + (define-abbrev-table tablename definitions)))) + (defun verilog-define-abbrev (table name expansion &optional hook) "Filter `define-abbrev' TABLE NAME EXPANSION and call HOOK. Provides SYSTEM-FLAG in newer Emacs." @@ -762,10 +770,13 @@ mode is experimental." (defcustom verilog-auto-wire-type nil "Non-nil specifies the data type to use with `verilog-auto-wire' etc. -Set this to \"logic\" for SystemVerilog code, or use `verilog-auto-logic'." +Set this to \"logic\" for SystemVerilog code, or use `verilog-auto-logic'. +Set this to \"wire\" to force use of wire when logic is otherwise appropriate; +this is generally only appropriate when making a non-SystemVerilog wrapper +containing SystemVerilog cells." :version "24.1" ; rev673 :group 'verilog-mode-actions - :type 'boolean) + :type 'string) (put 'verilog-auto-wire-type 'safe-local-variable `stringp) (defcustom verilog-auto-endcomments t @@ -1356,13 +1367,13 @@ See also `verilog-case-fold'." :type 'hook) (defcustom verilog-before-save-font-hook nil - "Hook run before `verilog-save-font-mods' removes highlighting." + "Hook run before `verilog-save-font-no-change-functions' removes highlighting." :version "24.3" ; rev735 :group 'verilog-mode-auto :type 'hook) (defcustom verilog-after-save-font-hook nil - "Hook run after `verilog-save-font-mods' restores highlighting." + "Hook run after `verilog-save-font-no-change-functions' restores highlighting." :version "24.3" ; rev735 :group 'verilog-mode-auto :type 'hook) @@ -1702,7 +1713,13 @@ If set will become buffer local.") (defvar verilog-mode-abbrev-table nil "Abbrev table in use in Verilog-mode buffers.") -(define-abbrev-table 'verilog-mode-abbrev-table ()) +;;(makunbound 'verilog-mode-abbrev-table) ; For testing, clear out old defvar +(verilog-define-abbrev-table + 'verilog-mode-abbrev-table () + "Abbrev table for Verilog mode skeletons." + :case-fixed t + ;; Only expand in code. + :enable-function (lambda () (not (verilog-in-comment-or-string-p)))) (verilog-define-abbrev verilog-mode-abbrev-table "class" "" 'verilog-sk-ovm-class) (verilog-define-abbrev verilog-mode-abbrev-table "always" "" 'verilog-sk-always) (verilog-define-abbrev verilog-mode-abbrev-table "begin" nil `verilog-sk-begin) @@ -1943,13 +1960,29 @@ be substituted." t t command)) command) +;; Eliminate compile warning +(defvar verilog-compile-command-pre-mod) +(defvar verilog-compile-command-post-mod) + (defun verilog-modify-compile-command () "Update `compile-command' using `verilog-expand-command'." - (when (and - (stringp compile-command) - (string-match "\\b\\(__FLAGS__\\|__FILE__\\)\\b" compile-command)) - (set (make-local-variable 'compile-command) - (verilog-expand-command compile-command)))) + ;; Entry into verilog-mode a call to this before Local Variables exist + ;; Likewise user may have hook or something that changes the flags. + ;; So, remember we're responsible for the expansion and on re-entry + ;; recompute __FLAGS__ on each reentry. + (when (stringp compile-command) + (when (and + (boundp 'verilog-compile-command-post-mod) + (equal compile-command verilog-compile-command-post-mod)) + (setq compile-command verilog-compile-command-pre-mod)) + (when (and + (string-match "\\b\\(__FLAGS__\\|__FILE__\\)\\b" compile-command)) + (set (make-local-variable 'verilog-compile-command-pre-mod) + compile-command) + (set (make-local-variable 'compile-command) + (verilog-expand-command compile-command)) + (set (make-local-variable 'verilog-compile-command-post-mod) + compile-command)))) (if (featurep 'xemacs) ;; Following code only gets called from compilation-mode-hook on XEmacs to add error handling. @@ -8428,13 +8461,13 @@ Return an array of [outputs inouts inputs wire reg assign const]." ;;(if dbg (setq dbg (concat dbg (format "Pt %s Vec %s C%c Kwd'%s'\n" (point) vec (following-char) keywd)))) (cond ((looking-at "//") - (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") - (setq enum (match-string 2))) + (when (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") + (setq enum (match-string 2))) (search-forward "\n")) ((looking-at "/\\*") (forward-char 2) - (if (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") - (setq enum (match-string 2))) + (when (looking-at "[^\n]*\\(auto\\|synopsys\\)\\s +enum\\s +\\([a-zA-Z0-9_]+\\)") + (setq enum (match-string 2))) (or (search-forward "*/") (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point)))) ((looking-at "(\\*") @@ -8447,7 +8480,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point)))) ((eq ?\; (following-char)) (cond (in-ign-to-semi ; Such as inside a "import ...;" in a module header - (setq in-ign-to-semi nil)) + (setq in-ign-to-semi nil rvalue nil)) ((and in-modport (not (eq in-modport t))) ; end of a modport declaration (verilog-modport-decls-set in-modport @@ -8503,7 +8536,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." (when (string-match "^\\\\" (match-string 1)) (setq keywd (concat keywd " "))) ; Escaped ID needs space at end ;; Add any :: package names to same identifier - (while (looking-at "\\s-*::\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)") + ;; '*' here is for "import x::*" + (while (looking-at "\\s-*::\\s-*\\(\\*\\|[a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)") (goto-char (match-end 0)) (setq keywd (concat keywd "::" (match-string 1))) (when (string-match "^\\\\" (match-string 1)) @@ -8568,8 +8602,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." (not (equal last-keywd "default"))) (setq in-clocking t)) ((equal keywd "import") - (if v2kargs-ok ; import in module header, not a modport import - (setq in-ign-to-semi t rvalue t))) + (when v2kargs-ok ; import in module header, not a modport import + (setq in-ign-to-semi t rvalue t))) ((equal keywd "type") (setq ptype t)) ((equal keywd "var")) @@ -10358,13 +10392,21 @@ When MODI is non-null, also add to modi-cache, for tracking." (verilog-insert-one-definition sig ;; Want "type x" or "output type x", not "wire type x" - (cond ((or (verilog-sig-type sig) + (cond ((and (equal "wire" verilog-auto-wire-type) + (or (not (verilog-sig-type sig)) + (equal "logic" (verilog-sig-type sig)))) + (if (member direction '("input" "output" "inout")) + direction + "wire")) + ;; + ((or (verilog-sig-type sig) verilog-auto-wire-type) (concat (when (member direction '("input" "output" "inout")) (concat direction " ")) - (or (verilog-sig-type sig) + (or (verilog-sig-type sig) verilog-auto-wire-type))) + ;; ((and verilog-auto-declare-nettype (member direction '("input" "output" "inout"))) (concat direction " " verilog-auto-declare-nettype)) @@ -13761,9 +13803,6 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) - ;; Doesn't matter when done, but combine it with a common changer - (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) - (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) ;; Must be done before autoin/out as creates a reg (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) ;; @@ -13789,6 +13828,10 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) ;; outputevery needs AUTOOUTPUTs done first (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every) + ;; Doesn't matter when done, but combine it with a common changer + (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) + ;; After AUTOREG*, as they may have set signal widths + (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) ;; After we've created all new variables (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) ;; Must be after all inputs outputs are generated commit 73e3ed48e21287d48fda8d04e55f8b79b526ca50 Author: Michael Albinus Date: Mon May 8 17:27:50 2017 +0200 Handle `write-region' messages in Tramp properly * lisp/net/tramp.el (tramp-handle-write-region-message): New defsubst. * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Use it. * lisp/net/tramp.el (tramp-password-prompt-regexp) (tramp-completion-mode-p): * lisp/net/tramp-cmds.el (tramp-reporter-dump-variable) (tramp-append-tramp-buffers): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Use `bound-and-true-p'. * lisp/net/tramp-compat.el (tramp-compat-delete-file): Don't check for `boundp' anymore. * test/lisp/net/tramp-tests.el (ert-x): Require it. (tramp--test-messages): New defvar. (tramp-test10-write-region): Extend test. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 2825532c52..8bbdca795e 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -652,6 +652,8 @@ But handle the case, if the \"test\" command is not available." (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime)) + (tramp-handle-write-region-message v start end filename append visit) + (unless (equal curbuf (current-buffer)) (tramp-error v 'file-error diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 99fc0cc709..a11908af63 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -247,10 +247,9 @@ buffer in your bug report. ;; Pretty print the cache. (set varsym (read (format "(%s)" (tramp-cache-print val)))) ;; There are non-7bit characters to be masked. - (when (and (boundp 'mm-7bit-chars) - (stringp val) + (when (and (stringp val) (string-match - (concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) + (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val)) (with-current-buffer reporter-eval-buffer (set varsym @@ -327,8 +326,7 @@ buffer in your bug report. ;; Append buffers only when we are in message mode. (when (and (eq major-mode 'message-mode) - (boundp 'mml-mode) - (symbol-value 'mml-mode)) + (bound-and-true-p mml-mode)) (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") (buffer-list (tramp-list-tramp-buffers)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 732922b60e..322e9c3689 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -197,10 +197,7 @@ Add the extension of F, if existing." (tramp-compat-funcall 'delete-file filename trash) ;; This Emacs version does not support the TRASH flag. (wrong-number-of-arguments - (let ((delete-by-moving-to-trash - (and (boundp 'delete-by-moving-to-trash) - (symbol-value 'delete-by-moving-to-trash) - trash))) + (let ((delete-by-moving-to-trash (and delete-by-moving-to-trash trash))) (delete-file filename))))) ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index aba6f414a4..55fddf3dbd 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -619,7 +619,8 @@ is no information where to trace the message.") (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) -;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'. +;; `dbus-event-error-hooks' has been renamed to +;; `dbus-event-error-functions' in Emacs 24.3. (add-hook (if (boundp 'dbus-event-error-functions) 'dbus-event-error-functions 'dbus-event-error-hooks) @@ -1223,11 +1224,7 @@ file-notify events." (file-attributes filename)))) ;; The end. - (when (or (eq visit t) (null visit) (stringp visit)) - (tramp-message v 0 "Wrote `%s' (%d characters)" filename - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))) + (tramp-handle-write-region-message v start end filename append visit) (run-hooks 'tramp-handle-write-region-hook))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 971cdaedf8..adadf9650e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3412,11 +3412,7 @@ the result will be a local, non-Tramp, file name." ;; Set the ownership. (when need-chown (tramp-set-file-uid-gid filename uid gid)) - (when (or (eq visit t) (null visit) (stringp visit)) - (tramp-message v 0 "Wrote `%s' (%d characters)" filename - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))) + (tramp-handle-write-region-message v start end filename append visit) (run-hooks 'tramp-handle-write-region-hook))))) (defvar tramp-vc-registered-file-names nil diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5a3e2566d7..4b288e199a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1521,7 +1521,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." v 'file-error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) (when (eq visit t) - (set-visited-file-modtime))))) + (set-visited-file-modtime)) + (tramp-handle-write-region-message v start end filename append visit)))) ;; Internal file name functions. @@ -1945,8 +1946,7 @@ If ARGUMENT is non-nil, use it as argument for (error (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (if (and (boundp 'auth-sources) - (symbol-value 'auth-sources) + (if (and (bound-and-true-p auth-sources) (search-forward-regexp tramp-smb-wrong-passwd-regexp nil t)) ;; Disable `auth-source' and `password-cache'. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 33e5900f3c..4a1900c6f8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -533,9 +533,8 @@ This regexp must match both `tramp-initial-end-of-output' and (defcustom tramp-password-prompt-regexp (format "^.*\\(%s\\).*:\^@? *" ;; `password-word-equivalents' has been introduced with Emacs 24.4. - (if (boundp 'password-word-equivalents) - (regexp-opt (symbol-value 'password-word-equivalents)) - "password\\|passphrase")) + (regexp-opt (or (bound-and-true-p password-word-equivalents) + '("password" "passphrase")))) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -2305,7 +2304,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." "Check, whether method / user name / host name completion is active." (or ;; Signal from outside. `non-essential' has been introduced in Emacs 24. - (and (boundp 'non-essential) (symbol-value 'non-essential)) + (bound-and-true-p non-essential) ;; This variable has been obsoleted in Emacs 26. tramp-completion-mode)) @@ -2754,6 +2753,27 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +(defsubst tramp-handle-write-region-message + (vec start end filename &optional append visit) + "Message to be written for `tramp-*-handle-write-region'" + ;; We shall also don't write when autosaving. How to check? + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (let ((nchars (cond ((null start) (buffer-size)) + ((stringp start) (length start)) + (t (- end start))))) + (tramp-message + vec 0 "%s `%s'%s" + (cond + ((numberp append) "Updated") + (append "Added to") + (t "Wrote")) + filename + (cond + ((null (bound-and-true-p write-region-verbose)) "") + ((= nchars 1) " (1 character)") + (t (format " (%d characters)" nchars))))))) + (defun tramp-handle-directory-file-name (directory) "Like `directory-file-name' for Tramp files." ;; If localname component of filename is "/", leave it unchanged. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8db54979b6..742bdfd934 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -39,6 +39,7 @@ (require 'dired) (require 'ert) +(require 'ert-x) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -80,6 +81,9 @@ (when (getenv "NIX_STORE") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) +(defvar tramp--test-messages nil + "Captured messages from *Messages* buffer.") + (defvar tramp--test-expensive-test (null (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) @@ -1741,31 +1745,77 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-enabled)) (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) + (text-quoting-style 'grave) + (write-region-verbose + (and (null noninteractive) (boundp 'write-region-verbose))) + (tramp-message-show-message + (or tramp-message-show-message write-region-verbose))) (unwind-protect - (progn + (ert-with-message-capture tramp--test-messages + ;; Write buffer. + (setq tramp--test-messages "") (with-temp-buffer (insert "foo") (write-region nil nil tmp-name)) + (when write-region-verbose + (should + (string-match + (format "Wrote `%s' (3 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) + ;; Append. + (setq tramp--test-messages "") (with-temp-buffer (insert "bla") (write-region nil nil tmp-name 'append)) + (when write-region-verbose + (should + (string-match + (format "Added to `%s' (3 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foobla"))) + + (setq tramp--test-messages "") + (with-temp-buffer + (insert "baz") + (write-region nil nil tmp-name 3)) + (when write-region-verbose + (should + (string-match + (format "Updated `%s' (3 characters)" tmp-name) + tramp--test-messages))) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foobaz"))) + ;; Write string. + (setq tramp--test-messages "") (write-region "foo" nil tmp-name) + (when write-region-verbose + (should + (string-match + (format "Wrote `%s' (3 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) + ;; Write partly. + (setq tramp--test-messages "") (with-temp-buffer (insert "123456789") (write-region 3 5 tmp-name)) + (when write-region-verbose + (should + (string-match + (format "Wrote `%s' (2 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "34")))) commit 52f7440b8ea8e18f7e83f8d107bd5e4df1bda7b1 Author: YAMAMOTO Mitsuharu Date: Mon May 8 08:20:53 2017 +0900 Fix glyph string generation for multi-font compositions (Bug#26742) * src/xdisp.c (glyph_string_containing_background_width): New function. (draw_glyphs): Use it to get correct background width. (compute_overhangs_and_x): Don't change x in the middle of composite characters. diff --git a/src/xdisp.c b/src/xdisp.c index 41458c3817..c730cdae05 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25421,6 +25421,20 @@ set_glyph_string_background_width (struct glyph_string *s, int start, int last_x } +/* Return glyph string that shares background with glyph string S and + whose `background_width' member has been set. */ + +static struct glyph_string * +glyph_string_containing_background_width (struct glyph_string *s) +{ + if (s->cmp) + while (s->cmp_from) + s = s->prev; + + return s; +} + + /* Compute overhangs and x-positions for glyph string S and its predecessors, or successors. X is the starting x-position for S. BACKWARD_P means process predecessors. */ @@ -25434,7 +25448,8 @@ compute_overhangs_and_x (struct glyph_string *s, int x, bool backward_p) { if (FRAME_RIF (s->f)->compute_glyph_string_overhangs) FRAME_RIF (s->f)->compute_glyph_string_overhangs (s); - x -= s->width; + if (!s->cmp || s->cmp_to == s->cmp->glyph_len) + x -= s->width; s->x = x; s = s->prev; } @@ -25446,7 +25461,8 @@ compute_overhangs_and_x (struct glyph_string *s, int x, bool backward_p) if (FRAME_RIF (s->f)->compute_glyph_string_overhangs) FRAME_RIF (s->f)->compute_glyph_string_overhangs (s); s->x = x; - x += s->width; + if (!s->cmp || s->cmp_to == s->cmp->glyph_len) + x += s->width; s = s->next; } } @@ -25778,7 +25794,10 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, USE_SAFE_ALLOCA; BUILD_GLYPH_STRINGS (i, end, head, tail, hl, x, last_x); if (tail) - x_reached = tail->x + tail->background_width; + { + s = glyph_string_containing_background_width (tail); + x_reached = s->x + s->background_width; + } else x_reached = x; @@ -25933,6 +25952,9 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, compute_overhangs_and_x (h, tail->x + tail->width, false); append_glyph_string_lists (&head, &tail, h, t); } + tail = glyph_string_containing_background_width (tail); + if (clip_tail) + clip_tail = glyph_string_containing_background_width (clip_tail); if (clip_head || clip_tail) for (s = head; s; s = s->next) { commit 3c4c8ca06e3306ccbcd07e354eb51abe53b52d22 Author: Philipp Stephani Date: Sat May 6 19:16:49 2017 +0200 Fix all unescaped character literals diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index f8de084f77..a4709c3b4b 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -656,9 +656,9 @@ that variable's documentation." (setq timeclock-mode-string (propertize (format " %c%s%c " - (if last-in ?< ?[) + (if last-in ?< ?\[) (timeclock-seconds-to-string remainder nil t) - (if last-in ?> ?])) + (if last-in ?> ?\])) 'help-echo "timeclock: time remaining")))) (put 'timeclock-mode-string 'risky-local-variable t) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 831b9c1ac2..a697aa7d03 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -90,7 +90,7 @@ (defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?j ?k ?l ?H ?M ?L ?n ?t ?T ?w ?W ?$ ?% - ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?` + ?^ ?\( ?\) ?- ?+ ?| ?{ ?} ?\[ ?\] ?' ?` ?\; ?, ?0 ?? ?/ ?\ ?\C-m space return delete backspace diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index abc8d7d6bc..01cdd8bef9 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -102,7 +102,7 @@ HANKAKU-KATAKANA belongs to `japanese-jisx0201-kana'.") (?$B!'(B ?:) (?$B!((B ?\;) (?$B!)(B ??) (?$B!*(B ?!) (?$B!+(B nil ?(I^(B) (?$B!,(B nil ?(I_(B) (?$B!-(B ?') (?$B!.(B ?`) (?$B!0(B ?^) (?$B!2(B ?_) (?$B!<(B ?- ?(I0(B) (?$B!=(B ?-) (?$B!>(B ?-) (?$B!?(B ?/) (?$B!@(B ?\\) (?$B!A(B ?~) (?$B!C(B ?|) (?$B!F(B ?`) (?$B!G(B ?') (?$B!H(B ?\") (?$B!I(B ?\") - (?\$B!J(B ?\() (?\$B!K(B ?\)) (?\$B!N(B ?[) (?\$B!O(B ?]) (?\$B!P(B ?{) (?\$B!Q(B ?}) + (?\$B!J(B ?\() (?\$B!K(B ?\)) (?\$B!N(B ?\[) (?\$B!O(B ?\]) (?\$B!P(B ?{) (?\$B!Q(B ?}) (?$B!R(B ?<) (?$B!S(B ?>) (?\$B!V(B nil ?\(I"(B) (?\$B!W(B nil ?\(I#(B) (?$B!\(B ?+) (?$B!](B ?-) (?$B!a(B ?=) (?$B!c(B ?<) (?$B!d(B ?>) (?$B!l(B ?') (?$B!m(B ?\") (?$B!o(B ?\\) (?$B!p(B ?$) (?$B!s(B ?%) (?$B!t(B ?#) (?$B!u(B ?&) (?$B!v(B ?*) diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el index af9f66c47f..600193ddc1 100644 --- a/lisp/leim/quail/cyrillic.el +++ b/lisp/leim/quail/cyrillic.el @@ -235,8 +235,8 @@ ("^" ?:) ("&" ??) ("*" ?*) - ("(" ?() - (")" ?)) + ("(" ?\() + (")" ?\)) ("_" ?_) ("+" ?+) ("~" ?Ё) @@ -789,8 +789,8 @@ Sorry, but `ghe with upturn' is not included in ISO 8859-5." ("^" ?:) ("&" ??) ("*" ?*) - ("(" ?() - (")" ?)) + ("(" ?\() + (")" ?\)) ("_" ?_) ("+" ?+) ("~" ?') diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 7ff35645bd..b0fdfce8e8 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1517,8 +1517,8 @@ construct the base name." (setq string (mh-replace-string "-lbrace" " ")) (setq string (mh-replace-string "-rbrace" " ")) (setq string (mh-replace-string "-search" " ")) - (subst-char-in-region (point-min) (point-max) ?( ? t) - (subst-char-in-region (point-min) (point-max) ?) ? t) + (subst-char-in-region (point-min) (point-max) ?\( ? t) + (subst-char-in-region (point-min) (point-max) ?\) ? t) (subst-char-in-region (point-min) (point-max) ?- ? t) (goto-char (point-min)) (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r ?_))) diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index 6acb1ff9d4..d56960c9fa 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -621,7 +621,7 @@ whose value is a range-list." (defun xsdre-parse-escape () (let ((ch (car xsdre-current-regexp))) (xsdre-advance) - (cond ((memq ch '(?\\ ?| ?. ?- ?^ ?* ?+ ?( ?) ?{ ?} ?[ ?])) ch) + (cond ((memq ch '(?\\ ?| ?. ?- ?^ ?* ?+ ?\( ?\) ?{ ?} ?\[ ?\])) ch) ((eq ch ?r) ?\r) ((eq ch ?n) ?\n) ((eq ch ?t) ?\t) diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el index a6c21bce87..6a7fdc59c2 100644 --- a/lisp/obsolete/complete.el +++ b/lisp/obsolete/complete.el @@ -570,7 +570,7 @@ GOTO-END is non-nil, however, it instead replaces up to END." (substring regex (1+ p))) p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) (let ((bump (if (memq (aref regex p) - '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) + '(?$ ?^ ?\. ?* ?+ ?? ?\[ ?\] ?\\)) -1 0))) (setq regex (concat (substring regex 0 (+ p bump)) PC-ndelims-regex diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el index 5b611aa2d0..a7a98d0ca5 100644 --- a/lisp/obsolete/vi.el +++ b/lisp/obsolete/vi.el @@ -1444,10 +1444,10 @@ Currently, CHAR could be [,{,(,\",',`,<,*, etc." (vi-set-last-change-command 'vi-quote-words arg char) (if (not (looking-at "\\<")) (forward-word -1)) (insert char) - (cond ((char-equal char ?[) (setq char ?])) + (cond ((char-equal char ?\[) (setq char ?\])) ((char-equal char ?{) (setq char ?})) ((char-equal char ?<) (setq char ?>)) - ((char-equal char ?() (setq char ?))) + ((char-equal char ?\() (setq char ?\))) ((char-equal char ?`) (setq char ?'))) (vi-end-of-word arg) (forward-char 1) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 58cc2d96a6..1d26403035 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -133,7 +133,7 @@ the variable." ;; if ref is indexed grab the indices -- beware nested indices (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) (let ((str (substring ref 0 (match-beginning 0)))) - (= (org-count ?( str) (org-count ?) str)))) + (= (org-count ?\( str) (org-count ?\) str)))) (setq index (match-string 1 ref)) (setq ref (substring ref 0 (match-beginning 0)))) ;; assign any arguments to pass to source block diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 10cca6a4a0..ab3ff3aa20 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1664,7 +1664,7 @@ ARG is the prefix the user entered with \\[universal-argument]." ada-mode-map (char-to-string key) 'ada-adjust-case-interactive))) - '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+ + '( ?` ?_ ?# ?% ?& ?* ?\( ?\) ?- ?= ?+ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) (defun ada-loose-case-word (&optional _arg) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 23ea91fe95..c0f1aaf39d 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2173,8 +2173,8 @@ See `cperl-electric-parens'." (insert (make-string (prefix-numeric-value arg) (cdr (assoc last-command-event '((?{ .?}) - (?[ . ?]) - (?( . ?)) + (?\[ . ?\]) + (?\( . ?\)) (?< . ?>)))))) (forward-char (- (prefix-numeric-value arg)))) (self-insert-command (prefix-numeric-value arg))))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 7ab1442c64..8cb912706f 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3118,10 +3118,10 @@ Link exprs of the form: (setq span-start (char-after (- span-start 1))) (setq span-end (char-after span-end)) (cond - ((= span-start ?)) t) - ((= span-start ?]) t) - ((= span-end ?() t) - ((= span-end ?[) t) + ((= span-start ?\)) t) + ((= span-start ?\]) t) + ((= span-end ?\() t) + ((= span-end ?\[) t) (t nil))) (t nil)))) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 1282f08b07..e7497e8e4f 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -4172,8 +4172,8 @@ Otherwise, just expand the file name." ([(control ?t)] ?t idlwave-shell-toggle-toolbar) ([(control up)] up idlwave-shell-stack-up) ([(control down)] down idlwave-shell-stack-down) - ([( ?[)] ?[ idlwave-shell-goto-previous-bp t t) - ([( ?])] ?] idlwave-shell-goto-next-bp t t) + ([( ?\[)] ?\[ idlwave-shell-goto-previous-bp t t) + ([( ?\])] ?\] idlwave-shell-goto-next-bp t t) ([(control ?f)] ?f idlwave-shell-window))) (mod (and (listp idlwave-shell-debug-modifiers) idlwave-shell-debug-modifiers)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index a0bbf55a8f..db965c5a58 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -599,8 +599,8 @@ This is buffer-local in every such buffer.") map) "Keymap used in Shell-Script mode.") -(defvar sh-skeleton-pair-default-alist '((?( _ ?)) (?\)) - (?[ ?\s _ ?\s ?]) (?\]) +(defvar sh-skeleton-pair-default-alist '((?\( _ ?\)) (?\)) + (?\[ ?\s _ ?\s ?\]) (?\]) (?{ _ ?}) (?\})) "Value to use for `skeleton-pair-default-alist' in Shell-Script mode.") diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 2c7ce03665..902a5aace0 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1524,7 +1524,7 @@ The first line is assumed to look like \"#!.../program ...\"." (defun tcl-quote (string) "Quote STRING according to Tcl rules." (mapconcat (lambda (char) - (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ?\s ?\;)) + (if (memq char '(?\[ ?\] ?{ ?} ?\\ ?\" ?$ ?\s ?\;)) (concat "\\" (char-to-string char)) (char-to-string char))) string "")) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 9f3bad1c1a..4860ea2599 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -14003,7 +14003,7 @@ See also `verilog-header' for an alternative format." (define-skeleton verilog-sk-task "Insert a task definition." () - > "task " '(verilog-sk-prompt-name) & ?; \n + > "task " '(verilog-sk-prompt-name) & ?\; \n > _ \n > "begin" \n > \n @@ -14013,7 +14013,7 @@ See also `verilog-header' for an alternative format." (define-skeleton verilog-sk-function "Insert a function definition." () - > "function [" '(verilog-sk-prompt-width) | -1 '(verilog-sk-prompt-name) ?; \n + > "function [" '(verilog-sk-prompt-width) | -1 '(verilog-sk-prompt-name) ?\; \n > _ \n > "begin" \n > \n @@ -14208,13 +14208,13 @@ and the case items." '(setq input "state") > "// State registers for " str | -23 \n '(setq verilog-sk-state str) - > "reg [" '(verilog-sk-prompt-width) | -1 verilog-sk-state ", next_" verilog-sk-state ?; \n + > "reg [" '(verilog-sk-prompt-width) | -1 verilog-sk-state ", next_" verilog-sk-state ?\; \n '(setq input nil) > \n > "// State FF for " verilog-sk-state \n > "always @ ( " (read-string "clock:" "posedge clk") " or " (verilog-sk-prompt-reset) " ) begin" \n > "if ( " verilog-sk-reset " ) " verilog-sk-state " = 0; else" \n - > verilog-sk-state " = next_" verilog-sk-state ?; \n + > verilog-sk-state " = next_" verilog-sk-state ?\; \n > (- verilog-indent-level-behavioral) "end" (progn (electric-verilog-terminate-line) nil) > \n > "// Next State Logic for " verilog-sk-state \n diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 92de90c6d9..dbfa87e207 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -487,8 +487,8 @@ Each alist element, which looks like (ELEMENT ...), is passed to Elements might be (?\\=` ?\\=` _ \"\\='\\='\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).") -(defvar skeleton-pair-default-alist '((?( _ ?)) (?\)) - (?[ _ ?]) (?\]) +(defvar skeleton-pair-default-alist '((?\( _ ?\)) (?\)) + (?\[ _ ?\]) (?\]) (?{ _ ?}) (?\}) (?< _ ?>) (?\>) (?« _ ?») (?\») diff --git a/lisp/woman.el b/lisp/woman.el index 720fe66be8..aa856c3957 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -4420,7 +4420,7 @@ Needs doing properly!" ;; A field is contained between a pair of field delimiter ;; characters and consists of sub-strings separated by padding ;; indicator characters: - (setq delim (string delim ?[ ?^ delim ?] ?* delim)) + (setq delim (string delim ?\[ ?^ delim ?\] ?* delim)) (save-excursion (while (re-search-forward delim end t) (goto-char (match-beginning 0)) commit bcbd8f7e4e929604bb3dfef9937432cb05b5f648 Author: Alan Mackenzie Date: Sun May 7 09:27:00 2017 +0000 CC Mode internal cache: Handle a cache pos being inside a two-char construct. Cache c-state-semi-nonlit-pos-cache was failing when a cache position was, e.g., between the two characters of an opening comment "/*", and additionally there were an odd number of quote marks (apostrophes) in the comment. This happened in .../src/xdisp.c in the Emacs master branch around 2017-05-02 at buffer position 615001. * lisp/progmodes/cc-defs.el (c-emacs-features): Repurpose symbol pps-extended-state to mean that there are at least 11 elements in the parser state. * lisp/progmodes/cc-engine.el (c-cache-to-parse-ps-state) (c-parse-ps-state-to-cache): Rewrite these to use enhanced cache element list types which indicate potentially being inside two-char constructs. (c-parse-ps-state-below): Rewrite to use the new versions of the above two functions. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 8dd56106af..dd8f8afc6a 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1914,14 +1914,18 @@ non-nil, a caret is prepended to invert the set." (set-buffer-modified-p nil)) (kill-buffer buf)) - ;; See if `parse-partial-sexp' returns the eighth element. - (if (c-safe (>= (length (save-excursion - (parse-partial-sexp (point) (point)))) - 10)) - (setq list (cons 'pps-extended-state list)) - (error (concat - "CC Mode is incompatible with this version of Emacs - " - "`parse-partial-sexp' has to return at least 10 elements."))) + ;; Check how many elements `parse-partial-sexp' returns. + (let ((ppss-size (or (c-safe (length + (save-excursion + (parse-partial-sexp (point) (point))))) + 0))) + (cond + ((>= ppss-size 11) (setq list (cons 'pps-extended-state list))) + ((>= ppss-size 10)) + (t (error + (concat + "CC Mode is incompatible with this version of Emacs - " + "`parse-partial-sexp' has to return at least 10 elements."))))) ;;(message "c-emacs-features: %S" list) list) @@ -1944,10 +1948,9 @@ might be present: (i.e. the syntax class `!'). `gen-string-delim' Generic string delimiters work (i.e. the syntax class `|'). -`pps-extended-state' `parse-partial-sexp' returns a list with at least 10 - elements, i.e. it contains the position of the start of - the last comment or string. It's always set - CC Mode - no longer works in emacsen without this feature. +`pps-extended-state' `parse-partial-sexp' returns a list with at least 11 + elements, i.e. it indicates having stopped after the + first character of a potential two-char construct. `posix-char-classes' The regexp engine understands POSIX character classes. `col-0-paren' It's possible to turn off the ad-hoc rule that a paren in column zero is the start of a defun. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4af7c35974..6d7bab7a65 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -2575,17 +2575,24 @@ comment at the start of cc-engine.el for more info." (defun c-cache-to-parse-ps-state (elt) ;; Create a list suitable to use as the old-state parameter to - ;; `parse-partial-sexp', out of ELT. ELT is either just a number, a buffer - ;; position, or it is a list (POS TYPE STARTING-POS). Here POS is the - ;; buffer position the other elements are pertinent for, TYPE is either 'c - ;; or 'c++ (for a comment) or a character (for a string delimiter) or t - ;; (meaning a string fence opened the string), STARTING-POS is the starting - ;; position of the comment or string. - (if (consp elt) + ;; `parse-partial-sexp', out of ELT, a member of + ;; `c-state-semi-nonlit-pos-cache'. ELT is either just a number, or a list + ;; with 2, 3, or 4 members (See `c-parse-ps-state-to-cache'). That number + ;; or the car of the list is the "position element" of ELT, the position + ;; where ELT is valid. + ;; + ;; POINT is left at the postition for which the returned state is valid. It + ;; will be either the position element of ELT, or one character before + ;; that. (The latter happens in Emacs <= 25 and XEmacs, when ELT indicates + ;; its position element directly follows a potential first character of a + ;; two char construct (such as a comment opener or an escaped character).) + (if (and (consp elt) (>= (length elt) 3)) + ;; Inside a string or comment (let ((depth 0) (containing nil) (last nil) in-string in-comment (after-quote nil) (min-depth 0) com-style com-str-start (intermediate nil) - (between-syntax nil) + (char-1 (nth 3 elt)) ; first char of poss. 2-char construct + (pos (car elt)) (type (cadr elt))) (setq com-str-start (car (cddr elt))) (cond @@ -2596,28 +2603,88 @@ comment at the start of cc-engine.el for more info." com-style (if (eq type 'c++) 1 nil))) (t (c-benign-error "Invalid type %s in c-cache-to-parse-ps-state" elt))) - (list depth containing last - in-string in-comment after-quote - min-depth com-style com-str-start - intermediate nil)) - (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) + (if (memq 'pps-extended-state c-emacs-features) + (progn + (goto-char pos) + (list depth containing last + in-string in-comment after-quote + min-depth com-style com-str-start + intermediate char-1)) + (goto-char (if char-1 + (1- pos) + pos)) + (list depth containing last + in-string in-comment nil + min-depth com-style com-str-start + intermediate))) + + ;; Not in a string or comment. + (if (memq 'pps-extended-state c-emacs-features) + (progn + (goto-char (if (consp elt) (car elt) elt)) + (list 0 nil nil nil nil + (and (consp elt) (eq (nth 1 elt) 9)) ; 9 is syntax code for "escape". + 0 nil nil nil + (and (consp elt) (nth 1 elt)))) + (goto-char (if (consp elt) (car elt) elt)) + (if (and (consp elt) (cdr elt)) (backward-char)) + (copy-tree '(0 nil nil nil nil + nil + 0 nil nil nil))))) (defun c-parse-ps-state-to-cache (state) ;; Convert STATE, a `parse-partial-sexp' state valid at POINT, to an element - ;; for the `c-state-semi-nonlit-pos-cache' cache. This is either POINT - ;; (when point is not in a literal) or a list (POINT TYPE STARTING-POS), - ;; where TYPE is the type of the literal, either 'string, 'c, or 'c++, and - ;; STARTING-POS is the starting position of the comment or string. - (cond - ((nth 3 state) ; A string - (list (point) (nth 3 state) (nth 8 state))) - ((and (nth 4 state) ; A comment - (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment. - (list (point) - (if (eq (nth 7 state) 1) 'c++ 'c) - (nth 8 state))) - (t ; Neither string nor comment. - (point)))) + ;; for the `c-state-semi-nonlit-pos-cache' cache. This is one of + ;; o - POINT (when point is not in a literal); + ;; o - (POINT CHAR-1) (when the last character before point is potentially + ;; the first of a two-character construct + ;; o - (POINT TYPE STARTING-POS) (when in a literal); + ;; o - (POINT TYPE STARTING-POS CHAR-1) (Combination of the previous two), + ;; where TYPE is the type of the literal (either 'c, or 'c++, or the + ;; character which closes the string), STARTING-POS is the starting + ;; position of the comment or string. CHAR-1 is either the character + ;; potentially forming the first half of a two-char construct (in Emacs <= + ;; 25 and XEmacs) or the syntax of the character (in Emacs >= 26). + (if (memq 'pps-extended-state c-emacs-features) + ;; Emacs >= 26. + (let ((basic + (cond + ((nth 3 state) ; A string + (list (point) (nth 3 state) (nth 8 state))) + ((and (nth 4 state) ; A comment + (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment. + (list (point) + (if (eq (nth 7 state) 1) 'c++ 'c) + (nth 8 state))) + (t ; Neither string nor comment. + (point))))) + (if (nth 10 state) + (append (if (consp basic) + basic + (list basic)) + (list (nth 10 state))) + basic)) + + ;; Emacs <= 25, XEmacs. + (cond + ((nth 3 state) ; A string + (if (eq (char-before) ?\\) + (list (point) (nth 3 state) (nth 8 state) ?\\) + (list (point) (nth 3 state) (nth 8 state)))) + ((and (nth 4 state) ; comment + (not (eq (nth 7 state) 'syntax-table))) + (if (and (eq (char-before) ?*) + (> (- (point) (nth 8 state)) 2)) ; not "/*/". + (list (point) + (if (eq (nth 7 state) 1) 'c++ 'c) + (nth 8 state) + ?*) + (list (point) + (if (eq (nth 7 state) 1) 'c++ 'c) + (nth 8 state)))) + (t (if (memq (char-before) '(?/ ?\\)) + (list (point) (char-before)) + (point)))))) (defsubst c-ps-state-cache-pos (elt) ;; Get the buffer position from ELT, an element from the cache @@ -2637,7 +2704,7 @@ comment at the start of cc-engine.el for more info." (save-restriction (widen) (let ((c c-state-semi-nonlit-pos-cache) - elt state pos npos high-elt) + elt state npos high-elt) ;; Trim the cache to take account of buffer changes. (while (and c (> (c-ps-state-cache-pos (car c)) c-state-semi-nonlit-pos-cache-limit)) @@ -2647,29 +2714,27 @@ comment at the start of cc-engine.el for more info." (while (and c (> (c-ps-state-cache-pos (car c)) here)) (setq high-elt (car c)) (setq c (cdr c))) - (setq pos (or (and c (c-ps-state-cache-pos (car c))) - (point-min))) + (goto-char (or (and c (c-ps-state-cache-pos (car c))) + (point-min))) + (setq state + (if c + (c-cache-to-parse-ps-state (car c)) + (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) - (if high-elt - (setq state (c-cache-to-parse-ps-state (car c))) - (setq elt (if c (car c) (point-min))) - (setq state - (if c - (c-cache-to-parse-ps-state (car c)) - (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) + (when (not high-elt) + ;; We need to extend the cache. Add an element to + ;; `c-state-semi-nonlit-pos-cache' each iteration of the following. (while - ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. - (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) - (setq state (parse-partial-sexp pos npos nil nil state)) + (<= (setq npos (+ (point) c-state-nonlit-pos-interval)) here) + (setq state (parse-partial-sexp (point) npos nil nil state)) (setq elt (c-parse-ps-state-to-cache state)) (setq c-state-semi-nonlit-pos-cache - (cons elt c-state-semi-nonlit-pos-cache)) - (setq pos npos))) + (cons elt c-state-semi-nonlit-pos-cache)))) - (if (> pos c-state-semi-nonlit-pos-cache-limit) - (setq c-state-semi-nonlit-pos-cache-limit pos)) + (if (> (point) c-state-semi-nonlit-pos-cache-limit) + (setq c-state-semi-nonlit-pos-cache-limit (point))) - (cons pos state))))) + (cons (point) state))))) (defun c-state-safe-place (here) ;; Return a buffer position before HERE which is "safe", i.e. outside any commit 55b07d33796a4697b37215c18b4630eeaaa4fb76 Author: Glenn Morris Date: Sat May 6 18:34:36 2017 -0700 ; Update contributor name ; Ref http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00114.html diff --git a/admin/authors.el b/admin/authors.el index d8f56fd925..a361bf9ee2 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -209,7 +209,7 @@ If REALNAME is nil, ignore that author.") "David O'Toole" "Devon Sean McCullough" "Dominique de Waleffe" - "Edward O'Connor" + "Theresa O'Connor" "Exal de Jesus Garcia Carrillo" "George McNinch" "Greg McGary" diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 1ebe852a3c..8f592ec87a 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -236,7 +236,7 @@ Andrew Cohen wrote @file{spam-wash.el}, to decode and clean email before it is analyzed for spam. @item -Edward O'Connor wrote @file{json.el}, a file for parsing and +Theresa O'Connor wrote @file{json.el}, a file for parsing and generating JSON files. @item diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 599b373fd4..5c8977c6b0 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -1451,7 +1451,7 @@ Monnier, Keith Moore, Jan Moringen, Morioka Tomohiko, Glenn Morris, Don Morrison, Diane Murray, Riccardo Murri, Sen Nagata, Erik Naggum, Gergely Nagy, Nobuyoshi Nakada, Thomas Neumann, Mike Newton, Thien-Thi Nguyen, Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Nikšić, Jeff Norden, -Andrew Norman, Edward O'Connor, Kentaro Ohkouchi, Christian Ohler, +Andrew Norman, Theresa O'Connor, Kentaro Ohkouchi, Christian Ohler, Kenichi Okada, Alexandre Oliva, Bob Olson, Michael Olson, Takaaki Ota, Pieter E. J. Pareit, Ross Patterson, David Pearson, Juan Pechiar, Jeff Peck, Damon Anton Permezel, Tom Perrine, William M. Perry, Per diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1 index 6ce0065b93..c5b168b8a2 100644 --- a/doc/lispref/ChangeLog.1 +++ b/doc/lispref/ChangeLog.1 @@ -4495,7 +4495,7 @@ 2011-09-17 Chong Yidong * tips.texi (Key Binding Conventions): Don't bind a key sequence - ending in C-g. Suggested by Edward O'Connor. + ending in C-g. Suggested by Theresa O'Connor. 2011-09-17 Eli Zaretskii diff --git a/etc/AUTHORS b/etc/AUTHORS index 9f951dfc1b..05a6d101dc 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -1211,7 +1211,7 @@ and changed diary.el tex-mode.el holiday.el cal-chinese.el diary-ins.el diary-insert.el cal-persian.el cal-islamic.el calendar.texi list-holidays.el -Edward O'Connor: wrote json.el +Theresa O'Connor: wrote json.el and changed erc.el erc-viper.el erc-log.el erc-track.el viper.el erc-backend.el erc-chess.el erc-dcc.el erc-ezbounce.el erc-goodies.el erc-list.el erc-macs.el erc-match.el erc-ring.el erc-services.el diff --git a/leim/ChangeLog.1 b/leim/ChangeLog.1 index ec9f051860..e7f8a46a86 100644 --- a/leim/ChangeLog.1 +++ b/leim/ChangeLog.1 @@ -871,7 +871,7 @@ * Makefile.in (install): Change ownership of installed files. -2007-10-20 Edward O'Connor (tiny change) +2007-10-20 Theresa O'Connor (tiny change) * quail/latin-ltx.el ("\\qed"): Add this rule. diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index 9b1625597a..46db752e46 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -13538,7 +13538,7 @@ mh-tool-bar.el, mh-xface.el. Remove mh-customize.el, mh-init.el. (mh-autoloads): Don't use comments on otherwise empty lines. -2006-01-29 Edward O'Connor +2006-01-29 Theresa O'Connor * emulation/viper.el (viper-major-mode-modifier-list): Add insert-state and vi-state entries for erc-mode. @@ -18772,7 +18772,7 @@ (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache function. -2005-11-04 Edward O'Connor (tiny change) +2005-11-04 Theresa O'Connor (tiny change) * net/goto-addr.el (goto-address-url-regexp): Remove `data:' URLs from goto-address-url-regexp. diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13 index f28c452b4b..f86590bf27 100644 --- a/lisp/ChangeLog.13 +++ b/lisp/ChangeLog.13 @@ -16523,7 +16523,7 @@ * vc-hooks.el (vc-find-root): Stop searching when the user changes. -2007-05-09 Edward O'Connor (tiny change) +2007-05-09 Theresa O'Connor (tiny change) * progmodes/python.el (python-font-lock-keywords) (python-open-block-statement-p, python-mode): Add support for the new diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 597b1a16bf..a3397b1e47 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -7854,7 +7854,7 @@ * net/xesam.el (xesam-kill-buffer-function): Wrap code by `ignore-errors' (the function must succeed always). -2008-08-28 Edward O'Connor +2008-08-28 Theresa O'Connor * json.el (json-read-number): New arg. Handle explicitly signed numbers. @@ -19656,7 +19656,7 @@ * time.el: Fix compiler warning. -2008-02-21 Edward O'Connor +2008-02-21 Theresa O'Connor * json.el: New file (JavaScript Object Notation parser / generator). diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 00e86aed61..059a07996b 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -7343,7 +7343,7 @@ (js-paren-indent-offset, js-square-indent-offset) (js-curly-indent-offset): Add :safe (Bug#12257). -2012-08-22 Edward O'Connor +2012-08-22 Theresa O'Connor * json.el (json-key-format): Add error properties. (json-encode-key): New function. diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index 851abafdb6..373b179b6f 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -435,7 +435,7 @@ * erc-lang.el (language): * erc-backend.el (erc-server-connect): Fix buggy call to `message'. -2007-12-07 Edward O'Connor +2007-12-07 Theresa O'Connor * erc-services.el: Provide a hook that runs when nickserv confirms that the user has successfully identified. @@ -1979,7 +1979,7 @@ * erc.el (erc-buffer-filter): Make sure all buffers returned from this are live. -2006-05-01 Edward O'Connor +2006-05-01 Theresa O'Connor * erc-goodies.el (erc-handle-irc-url): New function, suitable as a value for `url-irc-function'. @@ -2314,7 +2314,7 @@ sections may be skipped if using the version of ERC that comes with Emacs. -2006-01-29 Edward O'Connor +2006-01-29 Theresa O'Connor * erc-viper.el: Remove. Now that ERC is included in Emacs, these work-arounds live in Viper itself. @@ -2370,7 +2370,7 @@ other versions of Emacs. (erc-insert-timestamp-right): Use the new function. -2006-01-25 Edward O'Connor +2006-01-25 Theresa O'Connor * erc.el (erc-modules): Ensure that `erc-button-mode' gets enabled before `erc-match-mode'. @@ -2721,7 +2721,7 @@ xemacs feature as future versions of XEmacs might accept three arguments. -2005-10-18 Edward O'Connor +2005-10-18 Theresa O'Connor * erc.el: Tell emacs-lisp-mode how to font-lock define-erc-module docstrings. @@ -2765,7 +2765,7 @@ * erc-match.el (erc-log-matches-make-buffer): Use erc-view-mode-enter rather than view-mode-enter. -2005-10-05 Edward O'Connor +2005-10-05 Theresa O'Connor * erc-backend.el (erc-encode-string-for-target): If str is nil, pass the empty string to erc-encode-coding-string instead, which @@ -3305,7 +3305,7 @@ * erc.el: autoload erc-select-read-args, which, because it parses erc-select's args, can be called before erc.el is loaded. -2005-04-07 Edward O'Connor +2005-04-07 Theresa O'Connor * erc-viper.el: Remove final newlines from previously-existing ERC buffers. (Minor bug fix.) @@ -3460,14 +3460,14 @@ (erc-load-irc-script-lines): Use `erc-command-indicator' instead of `erc-prompt'. -2005-01-23 Edward O'Connor +2005-01-23 Theresa O'Connor * erc-viper.el: Ensure that `viper-comint-mode-hook' runs in buffers whose `erc-mode-hook' has already run when this file is loaded. Explicitly `require' erc.el. -2005-01-22 Edward O'Connor +2005-01-22 Theresa O'Connor * erc.el (erc-mode): Remove frobbing of `require-final-newline'. @@ -3479,7 +3479,7 @@ Emacs, some of the hacks in this file should be merged into Viper itself. -2005-01-21 Edward O'Connor +2005-01-21 Theresa O'Connor * erc.el (erc-mode): Set `require-final-newline' to nil in ERC buffers. This prevents a Viper misfeature whereby extraneous @@ -3683,7 +3683,7 @@ fixes a bug which caused an error to occur when trying to enable the module using the customization interface. -2005-01-08 Edward O'Connor +2005-01-08 Theresa O'Connor * erc-track.el: Support using faces to indicate channel activity in the modeline under XEmacs. @@ -3959,7 +3959,7 @@ * erc.el (erc-process-ctcp-query, erc-process-ctcp-reply): Display message in the active window, not the server window. -2004-12-16 Edward O'Connor +2004-12-16 Theresa O'Connor * erc-track.el (erc-track-position-in-mode-line): Check for 'erc-track-mode variable with boundp. From Adrian Aichner @@ -3971,12 +3971,12 @@ in erc-send-ctcp-message would eat consecutive whitespace etc. (erc-send-ctcp-message, erc-send-ctcp-notice): Use it. -2004-12-15 Edward O'Connor +2004-12-15 Theresa O'Connor * erc.el (erc-send-ctcp-message): Fix braino with my previous patch. It always helps to C-x C-s before `cvs commit'. -2004-12-15 Edward O'Connor +2004-12-15 Theresa O'Connor * erc.el (erc-send-ctcp-message): Only upcase the ctcp command, and not the entire message. Brian Palmer's change of 2004-12-12 had broken /me. @@ -5646,7 +5646,7 @@ * erc-log.el (erc-save-buffer-in-logs): bind `inhibit-read-only' to t around call to `erase-buffer'. -2004-02-23 Edward O'Connor +2004-02-23 Theresa O'Connor * erc-chess.el, erc-dcc.el, erc-ezbounce.el, erc-list.el, erc-macs.el, erc-ring.el, erc-stamp.el, erc.el: Normalized buffer diff --git a/lisp/json.el b/lisp/json.el index 049c9b1951..5f403a411b 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2006-2017 Free Software Foundation, Inc. -;; Author: Edward O'Connor +;; Author: Theresa O'Connor ;; Version: 1.4 ;; Keywords: convenience diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1 index 516fdf975b..75be6af62a 100644 --- a/lisp/url/ChangeLog.1 +++ b/lisp/url/ChangeLog.1 @@ -1237,7 +1237,7 @@ * url-expand.el (url-identity-expander, url-default-expander): Update all callers. -2007-08-09 Edward O'Connor (tiny change) +2007-08-09 Theresa O'Connor (tiny change) * url-auth.el (url-basic-auth): When prompting for username and password, default to the username and password in the URL. commit 723b16a87586a7e61e0ee40cd0815b3a7c519032 Author: Paul Eggert Date: Sat May 6 18:29:56 2017 -0700 ; Spelling fixes diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index a3b081a0bb..6dfddf72e8 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -24621,7 +24621,7 @@ * progmodes/octave.el (octave-beginning-of-line) (octave-end-of-line): Check before using up-list because it jumps - out of more syntactic contructs since moving to smie. + out of more syntactic constructs since moving to smie. (octave-indent-comment): New function. (octave-mode): Use it in smie-indent-functions. (Bug#14350) (octave-begin-keywords, octave-end-keywords) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 2c81710b23..165e5deb63 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1045,7 +1045,7 @@ This function simply drops any transparency." (defun css--named-color (start-point str) "Check whether STR, seen at point, is CSS named color. Returns STR if it is a valid color. Special care is taken -to exclude some SCSS contructs." +to exclude some SCSS constructs." (when-let ((color (assoc str css--color-map))) (save-excursion (goto-char start-point) commit 09d750fcb62d72de00d9d2a947f64520dfb3bc6a Author: Glenn Morris Date: Sat May 6 18:21:04 2017 -0700 Silence an mh-compat compiler warning * lisp/mh-e/mh-compat.el (mh-url-unreserved-chars): Always define. diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 099fc9bbba..dbdadb10bf 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -316,15 +316,14 @@ XEmacs does not have `test-completion'. This function returns nil on that system." nil) ;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. -(if (not (boundp 'url-unreserved-chars)) - (defconst mh-url-unreserved-chars - '( - ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z - ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z - ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 - ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) - "A list of characters that are _NOT_ reserved in the URL spec. -This is taken from RFC 2396.")) +(defconst mh-url-unreserved-chars + '( + ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z + ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z + ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 + ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) + "A list of characters that are _NOT_ reserved in the URL spec. +This is taken from RFC 2396.") (defun-mh mh-url-hexify-string url-hexify-string (str) "Escape characters in a string. commit 1f8036a522d4a7603e0b07fa5cc70f5bbdc15653 Author: Glenn Morris Date: Sat May 6 18:20:21 2017 -0700 Evaluate mh-require when compiling * lisp/mh-e/mh-alias.el, lisp/mh-e/mh-folder.el: * lisp/mh-e/mh-gnus.el, lisp/mh-e/mh-search.el: Evaluate mh-require when compiling, as require is automatically. * lisp/mh-e/mh-gnus.el: No longer disable byte-compilation. diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 82602eecf2..d62ac671ea 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -252,8 +252,9 @@ Blind aliases or users from /etc/passwd are not expanded." (t (mh-alias-ali alias)))) -(mh-require 'crm nil t) ; completing-read-multiple -(mh-require 'multi-prompt nil t) +(eval-and-compile + (mh-require 'crm nil t) ; completing-read-multiple + (mh-require 'multi-prompt nil t)) ;;;###mh-autoload (defun mh-read-address (prompt) diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index acef35d6cd..f846f17943 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -525,7 +525,7 @@ font-lock is done highlighting.") (cons (current-buffer) nil))))) ;; Register mh-folder-mode as supporting which-function-mode... -(mh-require 'which-func nil t) +(eval-and-compile (mh-require 'which-func nil t)) (when (and (boundp 'which-func-modes) (listp which-func-modes)) (add-to-list 'which-func-modes 'mh-folder-mode)) diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 3afdb7501f..318759ddc1 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -30,11 +30,12 @@ (require 'mh-e) -(mh-require 'gnus-util nil t) -(mh-require 'mm-bodies nil t) -(mh-require 'mm-decode nil t) -(mh-require 'mm-view nil t) -(mh-require 'mml nil t) +(eval-and-compile + (mh-require 'gnus-util nil t) + (mh-require 'mm-bodies nil t) + (mh-require 'mm-decode nil t) + (mh-require 'mm-view nil t) + (mh-require 'mml nil t)) ;; Copy of function from gnus-util.el. ;; TODO This is not in Gnus 5.11. @@ -170,7 +171,6 @@ PROMPT overrides the default one used to ask user for a file name." (provide 'mh-gnus) ;; Local Variables: -;; no-byte-compile: t ;; no-update-autoloads: t ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 099f922a5e..7ff35645bd 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1416,7 +1416,7 @@ being the list of messages originally from that folder." (when cur-msg (mh-goto-msg cur-msg t t)) (set-buffer-modified-p old-buffer-modified-flag))) -(mh-require 'which-func nil t) +(eval-and-compile (mh-require 'which-func nil t)) ;; Shush compiler. (defvar which-func-mode) ; < Emacs 22, XEmacs commit 233cfb0ea93ecdd2b63298be4243059e2e7a91fd Author: Glenn Morris Date: Sat May 6 18:01:34 2017 -0700 Remove obsolete method of changing byte-compile-dest-file * lisp/emacs-lisp/bytecomp.el (byte-compile-dest-file): Define unconditionally. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 25102548a9..201733ff03 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -166,24 +166,19 @@ file name, and return the name of the compiled file." (funcall handler 'byte-compiler-base-file-name filename) filename))) -(or (fboundp 'byte-compile-dest-file) - ;; The user may want to redefine this along with emacs-lisp-file-regexp, - ;; so only define it if it is undefined. - ;; Note - redefining this function is obsolete as of 23.2. - ;; Customize byte-compile-dest-file-function instead. - (defun byte-compile-dest-file (filename) - "Convert an Emacs Lisp source file name to a compiled file name. +(defun byte-compile-dest-file (filename) + "Convert an Emacs Lisp source file name to a compiled file name. If `byte-compile-dest-file-function' is non-nil, uses that function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension `.el'), adds `c' to it; otherwise adds `.elc'." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc")))))) + (if byte-compile-dest-file-function + (funcall byte-compile-dest-file-function filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc"))))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") commit c311b8b15e91dd07e2d23d8d21ebb53d0b5f2204 Author: Paul Eggert Date: Sat May 6 18:00:23 2017 -0700 New var write-region-verbose, default nil By popular demand, write-region char counts are now off by default (Bug#26796). * src/fileio.c (write-region-verbose): New Lisp var. (write_region): Output char count only if the var is non-nil. * doc/emacs/files.texi (Misc File Ops), etc/NEWS: Document this. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index bc977b72c1..d36fe6541e 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1657,9 +1657,10 @@ similar to the @kbd{M-x find-file-literally} command copies the contents of the region into the specified file. @kbd{M-x append-to-file} adds the text of the region to the end of the specified file. @xref{Accumulating Text}. When called interactively, -these commands will print a message in the echo area giving the name -of the file affected as well as the number of characters which were -added. The variable @code{write-region-inhibit-fsync} applies to +these commands print a message in the echo area giving the name +of the file affected; if the variable @code{write-region-verbose} is +non-nil the message also reports the number of characters written. +The variable @code{write-region-inhibit-fsync} applies to these commands, as well as saving files; see @ref{Customize Save}. @findex set-file-modes diff --git a/etc/NEWS b/etc/NEWS index 2918c6ebee..1f1f4b4b4b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -94,9 +94,9 @@ required capabilities are found in terminfo. See the FAQ node * Changes in Emacs 26.1 +++ -** The functions write-region, append-to-file, and the like now output -the number of characters added in addition to the name of the file -affected. +** The functions write-region, append-to-file, and the like now also +output the number of characters added in addition to the name of the +file affected, if the new variable 'write-region-verbose' is non-nil. ** The variable 'emacs-version' no longer includes the build number. This is now stored separately in a new variable, 'emacs-build-number'. diff --git a/src/fileio.c b/src/fileio.c index ad5ab618b0..6138bfc68b 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5153,17 +5153,24 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, { EMACS_INT nchars = (STRINGP (start) ? SCHARS (start) : XINT (end) - XINT (start)); - AUTO_STRING (format, NUMBERP (append) - ? (nchars != 1 - ? "Updated `%s' (%d characters)" - : "Updated `%s' (%d character)") - : ! NILP (append) - ? (nchars != 1 - ? "Added to `%s' (%d characters)" - : "Added to `%s' (%d character)") - : (nchars != 1 - ? "Wrote `%s' (%d characters)" - : "Wrote `%s' (%d character)")); + AUTO_STRING (format, + (NUMBERP (append) + ? (NILP (Vwrite_region_verbose) + ? "Updated `%s'" + : nchars == 1 + ? "Updated `%s' (1 character)" + : "Updated `%s' (%d characters)") + : ! NILP (append) + ? (NILP (Vwrite_region_verbose) + ? "Added to `%s'" + : nchars == 1 + ? "Added to `%s' (1 character)" + : "Added to `%s' (%d characters)") + : (NILP (Vwrite_region_verbose) + ? "Wrote `%s'" + : nchars == 1 + ? "Wrote `%s' (1 character)" + : "Wrote `%s' (%d characters)"))); CALLN (Fmessage, format, visit_file, make_number (nchars)); } return Qnil; @@ -6135,6 +6142,11 @@ These are the annotations made by other annotation functions that were already called. See also `write-region-annotate-functions'. */); Vwrite_region_annotations_so_far = Qnil; + DEFVAR_LISP ("write-region-verbose", + Vwrite_region_verbose, + doc: /* If non-nil, be more verbose when writing a region. */); + Vwrite_region_verbose = Qnil; + DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers, doc: /* A list of file name handlers that temporarily should not be used. This applies only to the operation `inhibit-file-name-operation'. */); commit 7f3d63908cd05fb34347d942e435c2964cd8b249 Author: Glenn Morris Date: Sat May 6 17:58:20 2017 -0700 Write autoloads file atomically * lisp/emacs-lisp/autoload.el (autoload--save-buffer): New function, to save buffer atomically. (autoload-save-buffers, update-directory-autoloads): Use autoload--save-buffer. * lisp/Makefile.in ($(lisp)/loaddefs.el): No longer write to a temp file by hand. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index cbbea78a00..1da8814370 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -203,28 +203,17 @@ $(lisp)/finder-inf.el: # batch-update-autoloads, which only updates the autoloads whose # sources have changed. -# Write to a temporary file in case we're doing a parallel build and a -# CANNOT_DUMP-mode Emacs needs to read loaddefs at startup. -# (FIXME: This seems like something that batch-update-autoloads should -# do internally, then it would Just Work for all loaddefs files.) -# We start by copying an existing loaddefs.el to loaddefs.tmp to avoid -# regenerating the entire file anew, which is slow; starting from an -# almost-correct content will enable the "only update where necessary" -# feature of batch-update-autoloads. - # Use expand-file-name rather than $abs_scrdir so that Emacs does not # get confused when it compares file-names for equality. autoloads .PHONY: $(lisp)/loaddefs.el $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) @echo Directories for loaddefs: ${SUBDIRS_ALMOST} - @if test -f $@ ; then cp $@ $(lisp)/loaddefs.tmp ; fi $(AM_V_GEN)$(emacs) -l autoload \ --eval '(setq autoload-ensure-writable t)' \ --eval '(setq autoload-builtin-package-versions t)' \ - --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$(lisp)/loaddefs.tmp")))' \ + --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ -f batch-update-autoloads ${SUBDIRS_ALMOST} - $(top_srcdir)/build-aux/move-if-change $(lisp)/loaddefs.tmp $@ # autoloads only runs when loaddefs.el is nonexistent, although it # generates a number of different files. Provide a force option to enable diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 9865b3198b..8ad5e6b823 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -866,11 +866,26 @@ FILE's modification time." (error "%s:0:0: error: %s: %s" file (car err) (cdr err))) )) +;; For parallel builds, to stop another process reading a half-written file. +(defun autoload--save-buffer () + "Save current buffer to its file, atomically." + ;; Copied from byte-compile-file. + (let* ((version-control 'never) + (tempfile (make-temp-name buffer-file-name)) + (kill-emacs-hook + (cons (lambda () (ignore-errors (delete-file tempfile))) + kill-emacs-hook))) + (write-region (point-min) (point-max) tempfile nil 1) + (backup-buffer) + (rename-file tempfile buffer-file-name t) + (set-buffer-modified-p nil) + (set-visited-file-modtime) + (or noninteractive (message "Wrote %s" buffer-file-name)))) + (defun autoload-save-buffers () (while autoload-modified-buffers (with-current-buffer (pop autoload-modified-buffers) - (let ((version-control 'never)) - (save-buffer))))) + (autoload--save-buffer)))) ;; FIXME This command should be deprecated. ;; See http://debbugs.gnu.org/22213#41 @@ -1110,8 +1125,7 @@ write its autoloads into the specified file instead." ;; dependencies don't trigger unnecessarily. (if (not changed) (set-buffer-modified-p nil) - (let ((version-control 'never)) - (save-buffer))) + (autoload--save-buffer)) ;; In case autoload entries were added to other files because of ;; file-local autoload-generated-file settings. commit 03d941982fbdf96260fc47d1cafbdda78c1d128e Author: Glenn Morris Date: Sat May 6 17:07:10 2017 -0700 Write autoloads file once only * lisp/emacs-lisp/autoload.el (autoload-find-generated-file): Simplify. Don't bother about ensuring the output file exists. (autoload-generated-file): Add doc. (autoload-ensure-writable): Update doc. (autoload-ensure-file-writeable): Handle non-existing file. (autoload-ensure-default-file): Remove function. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 4d0554e610..9865b3198b 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -255,30 +255,22 @@ expression, in which case we want to handle forms differently." ;; Those properties are now set in lisp-mode.el. (defun autoload-find-generated-file () - "Visit the autoload file for the current buffer, and return its buffer. -If a buffer is visiting the desired autoload file, return it." + "Visit the autoload file for the current buffer, and return its buffer." (let ((enable-local-variables :safe) - (enable-local-eval nil)) + (enable-local-eval nil) + (delay-mode-hooks t) + (file (autoload-generated-file))) ;; We used to use `raw-text' to read this file, but this causes ;; problems when the file contains non-ASCII characters. - (let* ((delay-mode-hooks t) - (file (autoload-generated-file)) - (file-missing (not (file-exists-p file)))) - (when file-missing - (autoload-ensure-default-file file)) - (with-current-buffer - (find-file-noselect - (autoload-ensure-file-writeable - file)) - ;; block backups when the file has just been created, since - ;; the backups will just be the auto-generated headers. - ;; bug#23203 - (when file-missing - (setq buffer-backed-up t) - (save-buffer)) - (current-buffer))))) + (with-current-buffer (find-file-noselect + (autoload-ensure-file-writeable file)) + (if (zerop (buffer-size)) (insert (autoload-rubric file))) + (current-buffer)))) (defun autoload-generated-file () + "Return `generated-autoload-file' as an absolute name. +If local to the current buffer, expand using the default directory; +otherwise, using `source-directory'/lisp." (expand-file-name generated-autoload-file ;; File-local settings of generated-autoload-file should ;; be interpreted relative to the file's location, @@ -391,7 +383,7 @@ not be relied upon." " ends here\n"))) (defvar autoload-ensure-writable nil - "Non-nil means `autoload-ensure-default-file' makes existing file writable.") + "Non-nil means `autoload-find-generated-file' makes existing file writable.") ;; Just in case someone tries to get you to overwrite a file that you ;; don't want to. ;;;###autoload @@ -401,6 +393,7 @@ not be relied upon." ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, ;; which was designed to handle CVSREAD=1 and equivalent. (and autoload-ensure-writable + (file-exists-p file) (let ((modes (file-modes file))) (if (zerop (logand modes #o0200)) ;; Ignore any errors here, and let subsequent attempts @@ -408,12 +401,6 @@ not be relied upon." (ignore-errors (set-file-modes file (logior modes #o0200)))))) file) -(defun autoload-ensure-default-file (file) - "Make sure that the autoload file FILE exists, creating it if needed. -If the file already exists and `autoload-ensure-writable' is non-nil, -make it writable." - (write-region (autoload-rubric file) nil file)) - (defun autoload-insert-section-header (outbuf autoloads load-name file time) "Insert the section-header line, which lists the file name and which functions are in it, etc." commit f31689c803a13836ef3528d6e2b4c98c767c42c7 Author: Paul Eggert Date: Sat May 6 15:29:16 2017 -0700 Port .gdbinit to GDB 7.11.1 + Python 2.7.12 * src/.gdbinit (Lisp_Object_Printer.to_string): Explicitly convert integer val to 'int', so that older GDBs do not complain about the conversion. * src/lisp.h (Lisp_Object) [CHECK_LISP_OBJECT_TYPE]: Give the struct a tag, so that older GDB pretty-printers have a tag to hang their hat on. diff --git a/src/.gdbinit b/src/.gdbinit index 29689e20a9..80aa95ba40 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1311,7 +1311,7 @@ if hasattr(gdb, 'printing'): # pretty-printing could be fancier. if not val: return "XIL(0)" # Easier to read than "XIL(0x0)". - return "XIL(0x%x)" % val + return "XIL(0x%x)" % int(val) def build_pretty_printer (): pp = Emacs_Pretty_Printers ("Emacs") diff --git a/src/lisp.h b/src/lisp.h index 5d4c64a2e5..de3a548cb6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -546,7 +546,7 @@ enum Lisp_Fwd_Type #ifdef CHECK_LISP_OBJECT_TYPE -typedef struct { EMACS_INT i; } Lisp_Object; +typedef struct Lisp_Object { EMACS_INT i; } Lisp_Object; #define LISP_INITIALLY(i) {i} commit 7cd7f5b4032092389a00e23af3ab435628febed3 Author: Paul Eggert Date: Sat May 6 14:24:12 2017 -0700 Pretty-print const Lisp_Objects in .gdbinit * src/.gdbinit (Emacs_Pretty_Printers.__call__): Compare unqualified type to Lisp_Object, to do the right thing when the expression has type ‘Lisp_Object const’. Problem reported by Eli Zaretskii in: http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00138.html diff --git a/src/.gdbinit b/src/.gdbinit index 0596188e05..29689e20a9 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1280,7 +1280,7 @@ if hasattr(gdb, 'printing'): RegexpCollectionPrettyPrinter except when printing Lisp_Object.""" def __call__ (self, val): """Look up the pretty-printer for the provided value.""" - type = val.type + type = val.type.unqualified () typename = type.tag or type.name basic_type = gdb.types.get_basic_type (type) basic_typename = basic_type.tag or basic_type.name commit 0a13c725132ade2709da217cac70e3847a387c58 Author: Paul Eggert Date: Sat May 6 14:21:19 2017 -0700 Pacify GCC setjmp/longjmp warning * src/eval.c (internal_lisp_condition_case): Do not modify local var VAR, to pacify GCC’s setjmp/longjmp warning which in some cases mistakenly diagnoses VAR possibly being modified between a setjmp and a longjmp. diff --git a/src/eval.c b/src/eval.c index 0030271c53..848955c279 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1277,18 +1277,19 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (NILP (var)) return Fprogn (handler_body); + Lisp_Object handler_var = var; if (!NILP (Vinternal_interpreter_environment)) { val = Fcons (Fcons (var, val), Vinternal_interpreter_environment); - var = Qinternal_interpreter_environment; + handler_var = Qinternal_interpreter_environment; } - /* Bind VAR to VAL while evaluating HANDLER_BODY. The - unbind_to just undoes VAR's binding; whoever longjumped + /* Bind HANDLER_VAR to VAL while evaluating HANDLER_BODY. + The unbind_to undoes just this binding; whoever longjumped to us unwound the stack to C->pdlcount before throwing. */ ptrdiff_t count = SPECPDL_INDEX (); - specbind (var, val); + specbind (handler_var, val); return unbind_to (count, Fprogn (handler_body)); } } commit cea3b22bc742699d60c33194b73b391c05a2456d Author: Philipp Date: Sat May 6 23:19:22 2017 +0200 Fix bootstrap build of files.el * lisp/files.el (file-name-non-special): Don't use cl-letf. diff --git a/lisp/files.el b/lisp/files.el index 7e627d36d4..8ac1993754 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -29,7 +29,6 @@ ;;; Code: (eval-when-compile - (require 'cl-lib) (require 'pcase) (require 'easy-mmode)) ; For `define-minor-mode'. @@ -7032,13 +7031,18 @@ only these files will be asked to be saved." (when (and visit buffer-file-name) (setq buffer-file-name (concat "/:" buffer-file-name)))))) (`unquote-then-quote - (cl-letf* ((buffer (or (car arguments) (current-buffer))) - ((buffer-local-value 'buffer-file-name buffer) - (substring (buffer-file-name buffer) 2))) + ;; We can't use `cl-letf' with `(buffer-local-value)' here + ;; because it wouldn't work during bootstrapping. + (let ((buffer (current-buffer))) ;; `unquote-then-quote' is only used for the ;; `verify-visited-file-modtime' action, which takes a buffer ;; as only optional argument. - (apply operation arguments))) + (with-current-buffer (or (car arguments) buffer) + (let ((buffer-file-name (substring buffer-file-name 2))) + ;; Make sure to hide the temporary buffer change from the + ;; underlying operation. + (with-current-buffer buffer + (apply operation arguments)))))) (_ (apply operation arguments))))) commit 5772b920f40a8c9f0a5266caf8d0f4729f6d2c13 Author: Noam Postavsky Date: Sat May 6 16:20:57 2017 -0400 ; INSTALL.REPO: Mention cases that 'make bootstrap' can't handle (Bug#26246). diff --git a/INSTALL.REPO b/INSTALL.REPO index 1b56b0b934..ce346bb246 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -50,8 +50,21 @@ To update loaddefs.el (and similar files), do: $ make autoloads If either of the above partial procedures fails, try 'make bootstrap'. -If CPU time is not an issue, 'make bootstrap' is the most thorough way -to rebuild, and avoid any spurious problems. +If CPU time is not an issue, 'make bootstrap' is a more thorough way +to rebuild, avoiding spurious problems. + +Occasionally, there are changes that 'make bootstrap' won't be able to +handle. The most thorough cleaning can be achieved by 'git clean -fx' +which will leave you with only files from the git repository. Here +are some faster methods for a couple of particular error cases: + + /usr/bin/m4:aclocal.m4:9: cannot open `m4/count-leading-zeros.m4': No such file or directory + +This can be fixed with 'rm aclocal.m4'. + + make: *** No rule to make target 'lib/Makefile.am', needed by 'lib/Makefile.in' + +This can be fixed with 'rm lib/Makefile Makefile'. Because the repository version of Emacs is a work in progress, it will sometimes fail to build. Please wait a day or so (and check the commit b104d764216026d77680a79993a051725e5ab94c Author: Eli Zaretskii Date: Sat May 6 23:23:36 2017 +0300 ; Fix last change * test/src/emacs-module-tests.el (module-function-object): Fix thinko in last change. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 8cef1cfa7d..eb7c82b2f6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -81,9 +81,9 @@ changes." (rx (or "#") (prin1-to-string obj))))))) commit 89b5a8283375f83b8f0e174a3a8760158b99be6e Author: Eli Zaretskii Date: Sat May 6 23:00:34 2017 +0300 Fix last change for MS-Windows * test/src/emacs-module-tests.el (module-function-object): Port to MS-Windows. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 7859fc5dce..8cef1cfa7d 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -78,7 +78,12 @@ changes." (let ((obj (nth 2 body))) (should (equal (type-of obj) 'module-function)) (should (string-match-p - (rx "#") (prin1-to-string obj))))))) commit 1784ce6080e4895a48ce71747a136d9642baa73e Author: Eli Zaretskii Date: Sat May 6 22:54:45 2017 +0300 ; * src/alloc.c (make_module_function): Avoid compiler warning. diff --git a/src/alloc.c b/src/alloc.c index cecd9f5505..faa14eebb3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3945,7 +3945,7 @@ make_user_ptr (void (*finalizer) (void *), void *p) /* Create a new module function environment object. */ Lisp_Object -make_module_function () +make_module_function (void) { return allocate_misc (Lisp_Misc_Module_Function); } commit a3e9694078e24d19db860aa4ff8dec8bc34b59b7 Author: Philipp Stephani Date: Sat Apr 22 18:04:29 2017 +0200 Introduce new misc type for module function This resolves a couple of FIXMEs in emacs-module.c. * src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions. * src/alloc.c (make_module_function): New function. (mark_object): GC support. * src/data.c (Ftype_of, syms_of_data): Handle module function type. * src/print.c (print_object): Print support for new type. * src/emacs-module.c (module_make_function, Finternal_module_call): Use new module function type, remove FIXMEs. (module_format_fun_env): Adapt and give it external linkage. * test/src/emacs-module-tests.el (module-function-object): Add unit test. diff --git a/src/alloc.c b/src/alloc.c index ab6b2960af..cecd9f5505 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3943,6 +3943,12 @@ make_user_ptr (void (*finalizer) (void *), void *p) return obj; } +/* Create a new module function environment object. */ +Lisp_Object +make_module_function () +{ + return allocate_misc (Lisp_Misc_Module_Function); +} #endif static void @@ -6634,6 +6640,7 @@ mark_object (Lisp_Object arg) #ifdef HAVE_MODULES case Lisp_Misc_User_Ptr: + case Lisp_Misc_Module_Function: XMISCANY (obj)->gcmarkbit = true; break; #endif diff --git a/src/data.c b/src/data.c index 141b26ccf3..44f7ba0e88 100644 --- a/src/data.c +++ b/src/data.c @@ -233,6 +233,8 @@ for example, (type-of 1) returns `integer'. */) case Lisp_Misc_Finalizer: return Qfinalizer; #ifdef HAVE_MODULES + case Lisp_Misc_Module_Function: + return Qmodule_function; case Lisp_Misc_User_Ptr: return Quser_ptr; #endif @@ -3729,6 +3731,7 @@ syms_of_data (void) DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); #ifdef HAVE_MODULES + DEFSYM (Qmodule_function, "module-function"); DEFSYM (Quser_ptr, "user-ptr"); #endif DEFSYM (Qfloat, "float"); diff --git a/src/emacs-module.c b/src/emacs-module.c index 1b445dcc3b..cd025a1396 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -62,10 +62,6 @@ enum /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); -/* Function prototype for the module Lisp functions. */ -typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, - emacs_value [], void *); - /* Function prototype for module user-pointer finalizers. These should not throw C++ exceptions, so emacs-module.h declares the corresponding interfaces with EMACS_NOEXCEPT. There is only C code @@ -102,7 +98,6 @@ struct emacs_runtime_private struct module_fun_env; -static Lisp_Object module_format_fun_env (const struct module_fun_env *); static Lisp_Object value_to_lisp (emacs_value); static emacs_value lisp_to_value (Lisp_Object); static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *); @@ -184,22 +179,6 @@ static emacs_value const module_nil = 0; do { } while (false) -/* Function environments. */ - -/* A function environment is an auxiliary structure used by - `module_make_function' to store information about a module - function. It is stored in a save pointer and retrieved by - `internal--module-call'. Its members correspond to the arguments - given to `module_make_function'. */ - -struct module_fun_env -{ - ptrdiff_t min_arity, max_arity; - emacs_subr subr; - void *data; -}; - - /* Implementation of runtime and environment functions. These should abide by the following rules: @@ -382,14 +361,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, : min_arity <= max_arity))) xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity)); - /* FIXME: This should be freed when envobj is GC'd. */ - struct module_fun_env *envptr = xmalloc (sizeof *envptr); + Lisp_Object envobj = make_module_function (); + struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj); envptr->min_arity = min_arity; envptr->max_arity = max_arity; envptr->subr = subr; envptr->data = data; - Lisp_Object envobj = make_save_ptr (envptr); Lisp_Object doc = Qnil; if (documentation) { @@ -677,17 +655,8 @@ usage: (module-call ENVOBJ &rest ARGLIST) */) (ptrdiff_t nargs, Lisp_Object *arglist) { Lisp_Object envobj = arglist[0]; - /* FIXME: Rather than use a save_value, we should create a new object type. - Making save_value visible to Lisp is wrong. */ - CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj); - struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj); - CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj); - /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0) - is a module_fun_env pointer. If some other part of Emacs also - exports save_value objects to Elisp, than we may be getting here this - other kind of save_value which will likely hold something completely - different in this field. */ - struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0); + CHECK_TYPE (MODULE_FUNCTIONP (envobj), Qmodule_function_p, envobj); + struct Lisp_Module_Function *envptr = XMODULE_FUNCTION (envobj); EMACS_INT len = nargs - 1; eassume (0 <= envptr->min_arity); if (! (envptr->min_arity <= len @@ -976,10 +945,12 @@ module_handle_throw (emacs_env *env, Lisp_Object tag_val) /* Return a string object that contains a user-friendly representation of the function environment. */ -static Lisp_Object -module_format_fun_env (const struct module_fun_env *env) +Lisp_Object +module_format_fun_env (const struct Lisp_Module_Function *env) { /* Try to print a function name if possible. */ + /* FIXME: Move this function into print.c, then use prin1-to-string + above. */ const char *path, *sym; static char const noaddr_format[] = "#"; char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256]; @@ -1048,8 +1019,7 @@ syms_of_module (void) code or modules should not access it. */ Funintern (Qmodule_refs_hash, Qnil); - DEFSYM (Qsave_value_p, "save-value-p"); - DEFSYM (Qsave_pointer_p, "save-pointer-p"); + DEFSYM (Qmodule_function_p, "module-function-p"); defsubr (&Smodule_load); diff --git a/src/lisp.h b/src/lisp.h index daf57ed906..5d4c64a2e5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -464,6 +464,7 @@ enum Lisp_Misc_Type Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, #ifdef HAVE_MODULES + Lisp_Misc_Module_Function, Lisp_Misc_User_Ptr, #endif /* Currently floats are not a misc type, @@ -2385,6 +2386,28 @@ struct Lisp_User_Ptr void (*finalizer) (void *); void *p; }; + +#include "emacs-module.h" + +/* Function prototype for the module Lisp functions. */ +typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, + emacs_value [], void *); + +/* Function environments. */ + +/* A function environment is an auxiliary structure used by + `module_make_function' to store information about a module + function. It is stored in a save pointer and retrieved by + `internal--module-call'. Its members correspond to the arguments + given to `module_make_function'. */ + +struct Lisp_Module_Function +{ + struct Lisp_Misc_Any base; + ptrdiff_t min_arity, max_arity; + emacs_subr subr; + void *data; +}; #endif /* A finalizer sentinel. */ @@ -2437,6 +2460,7 @@ union Lisp_Misc struct Lisp_Finalizer u_finalizer; #ifdef HAVE_MODULES struct Lisp_User_Ptr u_user_ptr; + struct Lisp_Module_Function u_module_function; #endif }; @@ -2485,6 +2509,19 @@ XUSER_PTR (Lisp_Object a) eassert (USER_PTRP (a)); return XUNTAG (a, Lisp_Misc); } + +INLINE bool +MODULE_FUNCTIONP (Lisp_Object o) +{ + return MISCP (o) && XMISCTYPE (o) == Lisp_Misc_Module_Function; +} + +INLINE struct Lisp_Module_Function * +XMODULE_FUNCTION (Lisp_Object o) +{ + eassert (MODULE_FUNCTIONP (o)); + return XUNTAG (o, Lisp_Misc); +} #endif @@ -3889,8 +3926,10 @@ extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); #ifdef HAVE_MODULES /* Defined in alloc.c. */ extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p); +extern Lisp_Object make_module_function (void); /* Defined in emacs-module.c. */ +extern Lisp_Object module_format_fun_env (const struct Lisp_Module_Function *); extern void syms_of_module (void); #endif diff --git a/src/print.c b/src/print.c index 872103bd4c..7e411a80c8 100644 --- a/src/print.c +++ b/src/print.c @@ -2103,6 +2103,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) printchar ('>', printcharfun); break; } + + case Lisp_Misc_Module_Function: + print_string (module_format_fun_env (XMODULE_FUNCTION (obj)), + printcharfun); + break; #endif case Lisp_Misc_Finalizer: diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 93e85ae22d..7859fc5dce 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -59,6 +59,29 @@ (ert-deftest mod-test-sum-docstring () (should (string= (documentation 'mod-test-sum) "Return A + B"))) +(ert-deftest module-function-object () + "Extract and test the implementation of a module function. +This test needs to be changed whenever the implementation +changes." + (let ((func (symbol-function #'mod-test-sum))) + (should (consp func)) + (should (equal (length func) 4)) + (should (equal (nth 0 func) 'lambda)) + (should (equal (nth 1 func) '(&rest args))) + (should (equal (nth 2 func) "Return A + B")) + (let ((body (nth 3 func))) + (should (consp body)) + (should (equal (length body) 4)) + (should (equal (nth 0 body) #'apply)) + (should (equal (nth 1 body) '#'internal--module-call)) + (should (equal (nth 3 body) 'args)) + (let ((obj (nth 2 body))) + (should (equal (type-of obj) 'module-function)) + (should (string-match-p + (rx "#") + (prin1-to-string obj))))))) + ;; ;; Non-local exists (throw, signal). ;; commit 5e47c2e52b9b7616668c5586084e0128b231272a Author: Philipp Stephani Date: Sat Apr 22 00:12:23 2017 +0200 Fix quoted files for 'verify-visited-file-modtime' Fixes Bug#25951. * lisp/files.el (file-name-non-special): Set the file name for the correct buffer. * test/lisp/files-tests.el (files-tests--file-name-non-special--buffers): Add unit test. (files-tests--with-advice, files-tests--with-temp-file): New helper macros. diff --git a/lisp/files.el b/lisp/files.el index d193749bb8..7e627d36d4 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -29,6 +29,7 @@ ;;; Code: (eval-when-compile + (require 'cl-lib) (require 'pcase) (require 'easy-mmode)) ; For `define-minor-mode'. @@ -7031,7 +7032,12 @@ only these files will be asked to be saved." (when (and visit buffer-file-name) (setq buffer-file-name (concat "/:" buffer-file-name)))))) (`unquote-then-quote - (let ((buffer-file-name (substring buffer-file-name 2))) + (cl-letf* ((buffer (or (car arguments) (current-buffer))) + ((buffer-local-value 'buffer-file-name buffer) + (substring (buffer-file-name buffer) 2))) + ;; `unquote-then-quote' is only used for the + ;; `verify-visited-file-modtime' action, which takes a buffer + ;; as only optional argument. (apply operation arguments))) (_ (apply operation arguments))))) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 80bbeb1bc5..4583b1af3c 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1,4 +1,4 @@ -;;; files-tests.el --- tests for files.el. +;;; files-tests.el --- tests for files.el. -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2017 Free Software Foundation, Inc. @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'nadvice) ;; Set to t if the local variable was set, `query' if the query was ;; triggered. @@ -251,5 +252,66 @@ be $HOME." (start-file-process "foo" nil "true")))) (should (eq (let ((default-directory "/:/")) (shell-command "true")) 0))) +(defmacro files-tests--with-advice (symbol where function &rest body) + (declare (indent 3)) + (cl-check-type symbol symbol) + (cl-check-type where keyword) + (cl-check-type function function) + (macroexp-let2 nil function function + `(progn + (advice-add #',symbol ,where ,function) + (unwind-protect + (progn ,@body) + (advice-remove #',symbol ,function))))) + +(defmacro files-tests--with-temp-file (name &rest body) + (declare (indent 1)) + (cl-check-type name symbol) + `(let ((,name (make-temp-file "emacs"))) + (unwind-protect + (progn ,@body) + (delete-file ,name)))) + +(ert-deftest files-tests--file-name-non-special--buffers () + "Check that Bug#25951 is fixed. +We call `verify-visited-file-modtime' on a buffer visiting a file +with a quoted name. We use two different variants: first with +the buffer current and a nil argument, second passing the buffer +object explicitly. In both cases no error should be raised and +the `file-name-non-special' handler for quoted file names should +be invoked with the right arguments." + (files-tests--with-temp-file temp-file-name + (with-temp-buffer + (let* ((buffer-visiting-file (current-buffer)) + (actual-args ()) + (log (lambda (&rest args) (push args actual-args)))) + (insert-file-contents (concat "/:" temp-file-name) :visit) + (should (stringp buffer-file-name)) + (should (string-prefix-p "/:" buffer-file-name)) + (should (consp (visited-file-modtime))) + (should (equal (find-file-name-handler buffer-file-name + #'verify-visited-file-modtime) + #'file-name-non-special)) + (files-tests--with-advice file-name-non-special :before log + ;; This should call the file name handler with the right + ;; buffer and not signal an error. The file hasn't been + ;; modified, so `verify-visited-file-modtime' should return + ;; t. + (should (equal (verify-visited-file-modtime) t)) + (with-temp-buffer + (should (stringp (buffer-file-name buffer-visiting-file))) + ;; This should call the file name handler with the right + ;; buffer and not signal an error. The file hasn't been + ;; modified, so `verify-visited-file-modtime' should return + ;; t. + (should (equal (verify-visited-file-modtime buffer-visiting-file) + t)))) + ;; Verify that the handler was actually called. We called + ;; `verify-visited-file-modtime' twice, so both calls should be + ;; recorded in reverse order. + (should (equal actual-args + `((verify-visited-file-modtime ,buffer-visiting-file) + (verify-visited-file-modtime nil)))))))) + (provide 'files-tests) ;;; files-tests.el ends here commit 26c71bfe8cb37332b4806ca7f43d59fd1a616c3b Author: Noam Postavsky Date: Sat May 6 14:03:06 2017 -0400 ; etc/NEWS: Fix default-frame-alist reference (Bug#26280). diff --git a/etc/NEWS b/etc/NEWS index 73c088c962..2918c6ebee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -143,8 +143,8 @@ you can disable the feature by adding '(inhibit-double-buffering . t) -to default-frame-parameters. Or inject this parameter into the -selected frame by evaluating this form: +to default-frame-alist. Or inject this parameter into the selected +frame by evaluating this form: (modify-frame-parameters nil '((inhibit-double-buffering . t))) commit 6555f1abebc3c5885a639fe8f825722837557973 Author: Eli Zaretskii Date: Sat May 6 13:39:36 2017 +0300 * src/fileio.c (write_region): Don't say "1 characters". (Bug#26796) diff --git a/src/fileio.c b/src/fileio.c index 7f65cf5aae..ad5ab618b0 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5151,13 +5151,19 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (!auto_saving && !noninteractive) { - AUTO_STRING (format, NUMBERP (append) - ? "Updated `%s' (%d characters)" - : ! NILP (append) - ? "Added to `%s' (%d characters)" - : "Wrote `%s' (%d characters)"); EMACS_INT nchars = (STRINGP (start) ? SCHARS (start) : XINT (end) - XINT (start)); + AUTO_STRING (format, NUMBERP (append) + ? (nchars != 1 + ? "Updated `%s' (%d characters)" + : "Updated `%s' (%d character)") + : ! NILP (append) + ? (nchars != 1 + ? "Added to `%s' (%d characters)" + : "Added to `%s' (%d character)") + : (nchars != 1 + ? "Wrote `%s' (%d characters)" + : "Wrote `%s' (%d character)")); CALLN (Fmessage, format, visit_file, make_number (nchars)); } return Qnil; commit 3472666f82472bc0de8dcfefed0ec442ea715a76 Author: Eli Zaretskii Date: Sat May 6 11:22:44 2017 +0300 Turn on GC_CHECK_MARKED_OBJECTS by default under ENABLE_CHECKING * src/alloc.c (GC_CHECK_MARKED_OBJECTS): Define to 1 by default of ENABLE_CHECKING is defined. (mark_object): Test for GC_CHECK_MARKED_OBJECTS being non-zero, instead of being defined. diff --git a/src/alloc.c b/src/alloc.c index 88a1a1ed66..ab6b2960af 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -75,14 +75,20 @@ along with GNU Emacs. If not, see . */ static bool valgrind_p; #endif -/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. */ +/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. + We turn that on by default when ENABLE_CHECKING is defined; + define GC_CHECK_MARKED_OBJECTS to zero to disable. */ + +#if defined ENABLE_CHECKING && !defined GC_CHECK_MARKED_OBJECTS +# define GC_CHECK_MARKED_OBJECTS 1 +#endif /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd memory. Can do this only if using gmalloc.c and if not checking marked objects. */ #if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \ - || defined HYBRID_MALLOC || defined GC_CHECK_MARKED_OBJECTS) + || defined HYBRID_MALLOC || GC_CHECK_MARKED_OBJECTS) #undef GC_MALLOC_CHECK #endif @@ -6343,7 +6349,7 @@ mark_object (Lisp_Object arg) { register Lisp_Object obj; void *po; -#ifdef GC_CHECK_MARKED_OBJECTS +#if GC_CHECK_MARKED_OBJECTS struct mem_node *m; #endif ptrdiff_t cdr_count = 0; @@ -6362,7 +6368,7 @@ mark_object (Lisp_Object arg) /* Perform some sanity checks on the objects marked here. Abort if we encounter an object we know is bogus. This increases GC time by ~80%. */ -#ifdef GC_CHECK_MARKED_OBJECTS +#if GC_CHECK_MARKED_OBJECTS /* Check that the object pointed to by PO is known to be a Lisp structure allocated from the heap. */ @@ -6431,7 +6437,7 @@ mark_object (Lisp_Object arg) if (VECTOR_MARKED_P (ptr)) break; -#ifdef GC_CHECK_MARKED_OBJECTS +#if GC_CHECK_MARKED_OBJECTS m = mem_find (po); if (m == MEM_NIL && !SUBRP (obj) && !main_thread_p (po)) emacs_abort (); @@ -6448,7 +6454,7 @@ mark_object (Lisp_Object arg) switch (pvectype) { case PVEC_BUFFER: -#ifdef GC_CHECK_MARKED_OBJECTS +#if GC_CHECK_MARKED_OBJECTS { struct buffer *b; FOR_EACH_BUFFER (b) commit ff315081a1dd8aa3efc30d65f32f8af503059f86 Author: Eli Zaretskii Date: Sat May 6 11:06:38 2017 +0300 ; * lisp/replace.el (query-replace-regexp, replace-regexp): Doc fixes. diff --git a/lisp/replace.el b/lisp/replace.el index a7b8ae6a34..477cc9c305 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -405,8 +405,8 @@ replace backward. Fourth and fifth arg START and END specify the region to operate on. -In TO-STRING, `\\&' or `\\0' stands for whatever matched the whole of -REGEXP, and `\\=\\N' (where N is a digit) stands for whatever matched +In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, +and `\\=\\N' (where N is a digit) stands for whatever matched the Nth `\\(...\\)' (1-based) in REGEXP. The `\\(...\\)' groups are counted from 1. `\\?' lets you edit the replacement text in the minibuffer @@ -652,9 +652,9 @@ replace backward. Fourth and fifth arg START and END specify the region to operate on. -In TO-STRING, `\\&' or `\\0' stands for whatever matched the whole of -REGEXP, and `\\=\\N' (where N is a digit) stands for -whatever matched the Nth `\\(...\\)' (1-based) in REGEXP. +In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, +and `\\=\\N' (where N is a digit) stands for whatever matched +the Nth `\\(...\\)' (1-based) in REGEXP. `\\?' lets you edit the replacement text in the minibuffer at the given position for each replacement. @@ -663,7 +663,8 @@ followed by a Lisp expression used as part of the replacement text. Inside of that expression, `\\&' is a string denoting the whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective numeric values from `string-to-number', and `\\#' itself for -`replace-count', the number of replacements occurred so far. +`replace-count', the number of replacements occurred so far, starting +from zero. If your Lisp expression is an identifier and the next letter in the replacement string would be interpreted as part of it, you commit 927dcbd2e6e0e53fcfb09296716e11c002ab1518 Author: Tom Tromey Date: Thu Jan 5 07:11:06 2017 -0700 Fix erc-join with channel password Bug#25349 * lisp/erc/erc-join.el (erc-autojoin-after-ident): Switch order of server names. (erc-autojoin-channels, erc-autojoin-add, erc-autojoin-remove): Likewise. (erc-server-join-channel): Move to erc.el. * lisp/erc/erc.el (erc-server-join-channel): Move from erc-join.el. (erc-cmd-JOIN): Use erc-server-join-channel. diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 151ea15f07..aa83ffe92a 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -129,7 +129,7 @@ This function is run from `erc-nickserv-identified-hook'." (setq erc--autojoin-timer (erc-cancel-timer erc--autojoin-timer))) (when (eq erc-autojoin-timing 'ident) - (let ((server (or erc-server-announced-name erc-session-server)) + (let ((server (or erc-session-server erc-server-announced-name)) (joined (mapcar (lambda (buf) (with-current-buffer buf (erc-default-target))) (erc-channel-list erc-server-process)))) @@ -155,38 +155,24 @@ This function is run from `erc-nickserv-identified-hook'." ;; `erc-autojoin-timing' is `connect': (dolist (l erc-autojoin-channels-alist) (when (string-match (car l) server) - (dolist (chan (cdr l)) - (let ((buffer (erc-get-buffer chan))) - ;; Only auto-join the channels that we aren't already in - ;; using a different nick. - (when (or (not buffer) - (not (with-current-buffer buffer - (erc-server-process-alive)))) - (erc-server-join-channel server chan))))))) + (let ((server (or erc-session-server erc-server-announced-name))) + (dolist (chan (cdr l)) + (let ((buffer (erc-get-buffer chan))) + ;; Only auto-join the channels that we aren't already in + ;; using a different nick. + (when (or (not buffer) + (not (with-current-buffer buffer + (erc-server-process-alive)))) + (erc-server-join-channel server chan)))))))) ;; Return nil to avoid stomping on any other hook funcs. nil) -(defun erc-server-join-channel (server channel) - (let* ((secret (plist-get (nth 0 (auth-source-search - :max 1 - :host server - :port "irc" - :user channel)) - :secret)) - (password (if (functionp secret) - (funcall secret) - secret))) - (erc-server-send (concat "JOIN " channel - (if password - (concat " " password) - ""))))) - (defun erc-autojoin-add (proc parsed) "Add the channel being joined to `erc-autojoin-channels-alist'." (let* ((chnl (erc-response.contents parsed)) (nick (car (erc-parse-user (erc-response.sender parsed)))) (server (with-current-buffer (process-buffer proc) - (or erc-server-announced-name erc-session-server)))) + (or erc-session-server erc-server-announced-name)))) (when (erc-current-nick-p nick) (when (and erc-autojoin-domain-only (string-match "[^.\n]+\\.\\([^.\n]+\\.[^.\n]+\\)$" server)) @@ -209,7 +195,7 @@ This function is run from `erc-nickserv-identified-hook'." (let* ((chnl (car (erc-response.command-args parsed))) (nick (car (erc-parse-user (erc-response.sender parsed)))) (server (with-current-buffer (process-buffer proc) - (or erc-server-announced-name erc-session-server)))) + (or erc-session-server erc-server-announced-name)))) (when (erc-current-nick-p nick) (when (and erc-autojoin-domain-only (string-match "[^.\n]+\\.\\([^.\n]+\\.[^.\n]+\\)$" server)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8c65016ed2..8547821f08 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3030,6 +3030,23 @@ For a list of user commands (/join /part, ...): (defalias 'erc-cmd-H 'erc-cmd-HELP) (put 'erc-cmd-HELP 'process-not-needed t) +(defun erc-server-join-channel (server channel &optional secret) + (let* ((secret (or secret + (plist-get (nth 0 (auth-source-search + :max 1 + :host server + :port "irc" + :user channel)) + :secret))) + (password (if (functionp secret) + (funcall secret) + secret))) + (erc-log (format "cmd: JOIN: %s" channel)) + (erc-server-send (concat "JOIN " channel + (if password + (concat " " password) + ""))))) + (defun erc-cmd-JOIN (channel &optional key) "Join the channel given in CHANNEL, optionally with KEY. If CHANNEL is specified as \"-invite\", join the channel to which you @@ -3049,10 +3066,9 @@ were most recently invited. See also `invitation'." (if (erc-member-ignore-case chnl joined-channels) (switch-to-buffer (car (erc-member-ignore-case chnl joined-channels))) - (erc-log (format "cmd: JOIN: %s" chnl)) - (erc-server-send (if (and chnl key) - (format "JOIN %s %s" chnl key) - (format "JOIN %s" chnl))))))) + (let ((server (with-current-buffer (process-buffer erc-server-process) + (or erc-session-server erc-server-announced-name)))) + (erc-server-join-channel server chnl key)))))) t) (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) commit 966020bc52d26274e950b1d7c7e2072735db699b Author: Tino Calancha Date: Sat May 6 12:30:48 2017 +0900 Ensure the created temp file in a test is new * test/lisp/buff-menu-tests.el (buff-menu-24962): Use `make-temp-file' to create the temp file. diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el index 43214f2506..21ffb2ebf3 100644 --- a/test/lisp/buff-menu-tests.el +++ b/test/lisp/buff-menu-tests.el @@ -27,12 +27,10 @@ (ert-deftest buff-menu-24962 () "Test for http://debbugs.gnu.org/24962 ." - (let ((file (expand-file-name "foo" temporary-file-directory)) - buf) + (let* ((file (make-temp-file "foo")) + (buf (find-file file))) (unwind-protect (progn - (write-region "foo" nil file) - (setq buf (find-file file)) (rename-buffer " foo") (list-buffers) (with-current-buffer "*Buffer List*" commit a95fefd1e699ba683331f2813d0956f4142ba986 Author: Glenn Morris Date: Fri May 5 21:44:09 2017 -0400 Decruftify dns-mode.el a little bit * lisp/textmodes/dns-mode.el (dns-mode-control-entities): New constant. (dns-mode-control-entity, dns-mode-bad-control-entity) (dns-mode-type, dns-mode-class): New faces. (dns-mode-control-entity-face, dns-mode-bad-control-entity-face) (dns-mode-type-face, dns-mode-class): Make these variables use the new faces, and mark as obsolete. (dns-mode-font-lock-keywords): Use dns-mode-control-entities. diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 01f509d913..cc8bad6337 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -48,6 +48,9 @@ "DNS master file mode configuration." :group 'data) +(defconst dns-mode-control-entities '("INCLUDE" "ORIGIN" "TTL") + "Lists of strings with known DNS control entities.") + (defconst dns-mode-classes '("IN" "CS" "CH" "HS") "List of strings with known DNS classes.") @@ -62,28 +65,59 @@ "MAILA" "TLSA" "NSEC3") "List of strings with known DNS types.") -;; Font lock. +(defface dns-mode-control-entity '((t :inherit font-lock-keyword-face)) + "Face used for DNS control entities, e.g. $ORIGIN." + :version "26.1" + :group 'dns-mode) + +(defface dns-mode-bad-control-entity '((t :inherit font-lock-warning-face)) + "Face used for non-standard DNS control entities, e.g. $FOO." + :version "26.1" + :group 'dns-mode) + +(defface dns-mode-type '((t :inherit font-lock-type-face)) + "Face used for DNS types, e.g., SOA." + :version "26.1" + :group 'dns-mode) + +(defface dns-mode-class '((t :inherit font-lock-constant-face)) + "Face used for DNS classes, e.g., IN." + :version "26.1" + :group 'dns-mode) -(defvar dns-mode-control-entity-face 'font-lock-keyword-face +(defvar dns-mode-control-entity-face ''dns-mode-control-entity "Name of face used for control entities, e.g. $ORIGIN.") +(make-obsolete-variable 'dns-mode-control-entity-face + "customize the face `dns-mode-control-entity' instead." + "26.1" 'set) -(defvar dns-mode-bad-control-entity-face 'font-lock-warning-face +(defvar dns-mode-bad-control-entity-face ''dns-mode-bad-control-entity "Name of face used for non-standard control entities, e.g. $FOO.") +(make-obsolete-variable + 'dns-mode-bad-control-entity-face + "customize the face `dns-mode-bad-control-entity' instead." + "26.1" 'set) -(defvar dns-mode-type-face 'font-lock-type-face +(defvar dns-mode-type-face ''dns-mode-type "Name of face used for DNS types, e.g., SOA.") +(make-obsolete-variable 'dns-mode-type-face + "customize the face `dns-mode-type' instead." + "26.1" 'set) -(defvar dns-mode-class-face 'font-lock-constant-face +(defvar dns-mode-class-face ''dns-mode-class "Name of face used for DNS classes, e.g., IN.") +(make-obsolete-variable 'dns-mode-class + "customize the face `dns-mode-class' instead." + "26.1" 'set) (defcustom dns-mode-font-lock-keywords - `(("^$ORIGIN" 0 ,dns-mode-control-entity-face) - ("^$INCLUDE" 0 ,dns-mode-control-entity-face) - ("^$TTL" 0 ,dns-mode-control-entity-face) + `((,(concat "^$" (regexp-opt dns-mode-control-entities)) + 0 ,dns-mode-control-entity-face) ("^$[a-z0-9A-Z]+" 0 ,dns-mode-bad-control-entity-face) (,(regexp-opt dns-mode-classes) 0 ,dns-mode-class-face) (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face)) "Font lock keywords used to highlight text in DNS master file mode." + :version "26.1" :type 'sexp :group 'dns-mode) commit 2b91f3d1eac402128c753e0780c50488a4f9cacb Author: Paul Eggert Date: Fri May 5 15:59:24 2017 -0700 Pretty-print Lisp_Object values in GDB * src/.gdbinit: Add a pretty-printer for Lisp_Object values. Now, GDB displays them as "XIL(0xXXX)" rather than displaying them as "..." when CHECK_LISP_OBJECT_TYPE is in effect and as "DDDDD" otherwise. diff --git a/src/.gdbinit b/src/.gdbinit index 6d7476d5a7..0596188e05 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1264,3 +1264,60 @@ commands end continue end + + +# Put the Python code at the end of .gdbinit so that if GDB does not +# support Python, GDB will do all the above initializations before +# reporting an error. + +python + +# Omit pretty-printing in older (pre-7.3) GDBs that lack it. +if hasattr(gdb, 'printing'): + + class Emacs_Pretty_Printers (gdb.printing.RegexpCollectionPrettyPrinter): + """A collection of pretty-printers. This is like GDB's + RegexpCollectionPrettyPrinter except when printing Lisp_Object.""" + def __call__ (self, val): + """Look up the pretty-printer for the provided value.""" + type = val.type + typename = type.tag or type.name + basic_type = gdb.types.get_basic_type (type) + basic_typename = basic_type.tag or basic_type.name + for printer in self.subprinters: + if (printer.enabled + and ((printer.regexp == '^Lisp_Object$' + and typename == 'Lisp_Object') + or (basic_typename + and printer.compiled_re.search (basic_typename)))): + return printer.gen_printer (val) + return None + + class Lisp_Object_Printer: + "A printer for Lisp_Object values." + def __init__ (self, val): + self.val = val + + def to_string (self): + "Yield a string that can be fed back into GDB." + val = self.val + basic_type = gdb.types.get_basic_type (val.type) + if (basic_type.code == gdb.TYPE_CODE_STRUCT + and gdb.types.has_field (basic_type, "i")): + val = val["i"] + # Yield "XIL(N)", where N is a C integer. This helps humans + # distinguish Lisp_Object values from ordinary integers even + # when Lisp_Object is an integer. Perhaps some day the + # pretty-printing could be fancier. + if not val: + return "XIL(0)" # Easier to read than "XIL(0x0)". + return "XIL(0x%x)" % val + + def build_pretty_printer (): + pp = Emacs_Pretty_Printers ("Emacs") + pp.add_printer ('Lisp_Object', '^Lisp_Object$', Lisp_Object_Printer) + return pp + + gdb.printing.register_pretty_printer (gdb.current_objfile (), + build_pretty_printer (), True) +end commit 1c9c02f51cc24954536e3e2536c5b2c1d571e3df Author: Peder O. Klingenberg Date: Fri May 5 14:03:04 2017 -0400 Tweak dns-mode font-lock * lisp/textmodes/dns-mode.el (dns-mode-font-lock-keywords): Highlight $TTL as a control entity. (Bug#26780) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 02cb2a2876..01f509d913 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -79,6 +79,7 @@ (defcustom dns-mode-font-lock-keywords `(("^$ORIGIN" 0 ,dns-mode-control-entity-face) ("^$INCLUDE" 0 ,dns-mode-control-entity-face) + ("^$TTL" 0 ,dns-mode-control-entity-face) ("^$[a-z0-9A-Z]+" 0 ,dns-mode-bad-control-entity-face) (,(regexp-opt dns-mode-classes) 0 ,dns-mode-class-face) (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face)) commit 4af24317b4c043ffa4ce303e57276954920bf204 Author: Glenn Morris Date: Thu May 4 23:15:53 2017 -0700 Fontify the doc-string in some CL forms as such * lisp/emacs-lisp/lisp-mode.el (defconstant, defparameter): Add the doc-string-elt property. (Bug#26778) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 54d916887c..7448864ff9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -164,6 +164,9 @@ (put 'defalias 'doc-string-elt 3) (put 'defvaralias 'doc-string-elt 3) (put 'define-category 'doc-string-elt 2) +;; CL +(put 'defconstant 'doc-string-elt 3) +(put 'defparameter 'doc-string-elt 3) (defvar lisp-doc-string-elt-property 'doc-string-elt "The symbol property that holds the docstring position info.") commit b8732c652ad69f815c2f4d4c4c966437463327fa Author: Glenn Morris Date: Thu May 4 22:26:17 2017 -0700 * lisp/emacs-lisp/cl-lib.el (cl-mapcar): Remove recent autoload cookie. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 1f8615fad3..936c852526 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -349,7 +349,6 @@ Call `cl-float-limits' to set this.") (declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs &optional acc)) -;;;###autoload (defun cl-mapcar (cl-func cl-x &rest cl-rest) "Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, commit ee0dd3031cd521f54c08287f4a3e7bc3ee515f55 Author: Dmitry Gutov Date: Fri May 5 03:43:07 2017 +0300 cl-defmethod: Make the edebug spec more technically correct * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Denote the edebug spec part for qualifiers as [&rest atom], per http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00053.html. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 107d520b1e..068f4fb0c8 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -415,8 +415,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (&define ; this means we are defining something [&or symbolp ("setf" symbolp)] ;; ^^ This is the methods symbol - [ &optional keywordp ; this is key :before etc - &optional stringp ] ; :extra can be followed by a string + [ &rest atom ] ; Multiple qualifiers are allowed. + ; Like in CLOS spec, we support + ; any non-list values. listp ; arguments [ &optional stringp ] ; documentation string def-body))) ; part to be debugged commit 167f47d202c6f68105f6f1e80922d5513d9ec7f4 Author: Mike Kupfer Date: Thu May 4 14:30:17 2017 -0800 Fix MH-E not to load cl at runtime (Bug#25552) * lisp/mh-e/mh-acros.el (defun-mh): Check at runtime, not compile time, whether the target is bound. * lisp/mh-e/mh-compat.el: Enable compilation. Pull in mh-acros at compile time. Authored-by: Glenn Morris , Noam Postavsky diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 0c89efbe3c..d424247a4f 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -90,10 +90,9 @@ loads \"cl\" appropriately." "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." - (let ((defined-p (fboundp function))) - (if defined-p - `(defalias ',name ',function) - `(defun ,name ,arg-list ,@body)))) + `(if (fboundp ',function) + (defalias ',name ',function) + (defun ,name ,arg-list ,@body))) (put 'defun-mh 'lisp-indent-function 'defun) (put 'defun-mh 'doc-string-elt 4) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 3f3990e869..099fc9bbba 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -40,7 +40,7 @@ ;; Items are listed alphabetically (except for mh-require which is ;; needed sooner it would normally appear). -(require 'mh-acros) +(eval-when-compile (require 'mh-acros)) (mh-do-in-gnu-emacs (defalias 'mh-require 'require)) @@ -374,7 +374,6 @@ XEmacs." (provide 'mh-compat) ;; Local Variables: -;; no-byte-compile: t ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil ;; End: commit d15a4805d6347412ae1d605dcf5e8d3fe0f8e743 Author: Jean-Christophe Helary Date: Thu May 4 20:32:40 2017 +0200 Multiline support in NS "Open Selected File" service. * lisp/term/ns-win.el (ns-open-file-service): new function. Wraps the original call in a (split-string) to create as many calls as there are lines. (ns-spi-service-call): Call `ns-open-file-service' instead of `dnd-open-file'. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 70bd817d93..4df5f0abe2 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -229,6 +229,15 @@ The properties returned may include `top', `left', `height', and `width'." (declare-function dnd-open-file "dnd" (uri action)) +;; Handles multiline strings that are passed to the "open-file" service. +(defun ns-open-file-service (filenames) + "Open multiple files when selecting a multiline string FILENAMES." + (let ((filelist (split-string filenames "[\n\r]+" t "[ \u00A0\t]+"))) + ;; The path strings are trimmed for spaces, nbsp and tabs. + (dolist (filestring filelist) + (dnd-open-file filestring nil)))) + + (defun ns-spi-service-call () "Respond to a service request." (interactive) @@ -236,7 +245,7 @@ The properties returned may include `top', `left', `height', and `width'." (switch-to-buffer (generate-new-buffer "*untitled*")) (insert ns-input-spi-arg)) ((string-equal ns-input-spi-name "open-file") - (dnd-open-file ns-input-spi-arg nil)) + (ns-open-file-service ns-input-spi-arg)) ((string-equal ns-input-spi-name "mail-selection") (compose-mail) (rfc822-goto-eoh) commit f5ca518b9274e4abaecd1398cce6a24b77139ae3 Author: Dmitry Gutov Date: Thu May 4 18:26:46 2017 +0300 ; xref-collect-matches: Add a TODO diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index a12fa14620..9b6a560971 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -920,6 +920,9 @@ IGNORES is a list of glob patterns." (let* ((grep-find-template (replace-regexp-in-string "" " -E" grep-find-template t t)) (grep-highlight-matches nil) + ;; TODO: Sanitize the regexp to remove Emacs-specific terms, + ;; so that Grep can search for the "relaxed" version. Can we + ;; do that reliably enough, without creating false negatives? (command (xref--rgrep-command (xref--regexp-to-extended regexp) files (expand-file-name dir) commit 53348c6b9ffa46c15ec04ff08ffb6ec742c86ea4 Author: Eli Zaretskii Date: Thu May 4 18:11:53 2017 +0300 ; Remove redundant definition of the 'DebPrint' macro * nt/inc/ms-w32.h (DebPrint): Remove redundant definition (defined in src/conf_post.h). diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 671c9fa9d2..957d8c6bdb 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -596,13 +596,6 @@ typedef unsigned int EMACS_UINT; /* #define FULL_DEBUG */ /* #define EMACSDEBUG */ -#ifdef EMACSDEBUG -extern void _DebPrint (const char *fmt, ...); -#define DebPrint(stuff) _DebPrint stuff -#else -#define DebPrint(stuff) -#endif - #ifdef _MSC_VER #if _MSC_VER >= 800 && !defined(__cplusplus) /* Unnamed type definition in parentheses. commit 4a3e3922523b1c4b4837a75ffaa5665043fc0102 Author: Göktuğ Kayaalp Date: Thu May 4 15:46:13 2017 +0300 Require cl-lib at runtime in vc-hg * lisp/vc/vc-hg.el: Require cl-lib at runtime as well (bug#26609). diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 5348341950..37ea928a9c 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -102,10 +102,11 @@ ;;; Code: (eval-when-compile - (require 'cl-lib) (require 'vc) (require 'vc-dir)) +(require 'cl-lib) + (declare-function vc-compilation-mode "vc-dispatcher" (backend)) ;;; Customization options commit fed13bd8c81fa20f1a67386a13d1ba3a9daaed8c Author: Tino Calancha Date: Thu May 4 19:47:45 2017 +0900 Inherit incompatible/obsolete package faces from error Don't use the same face for installed packages as for incompatible or obsolete ones. * lisp/emacs-lisp/package.el (package-status-incompat): Inherit from error. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bef1e8dd59..7ae7ffff1a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2904,7 +2904,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." :version "25.1") (defface package-status-incompat - '((t :inherit font-lock-comment-face)) + '((t :inherit error)) "Face used on the status and version of incompat packages." :version "25.1") commit b0370a89f6dd57b95be30b8218e17c12d886c27a Author: Michael Albinus Date: Thu May 4 12:21:32 2017 +0200 Set process property `adjust-window-size-function' to `ignore' in Tramp * lisp/net/tramp-adb.el (tramp-adb-parse-device-names) (tramp-adb-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl) (tramp-smb-maybe-open-connection): Set process property `adjust-window-size-function' to `ignore'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a80bc0bdb2..2825532c52 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -203,6 +203,7 @@ pass to the OPERATION." tramp-current-host nil nil)) result) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) (while (tramp-compat-process-live-p p) (accept-process-output p 0.1)) @@ -1230,6 +1231,7 @@ connection if a previous connection has died for some reason." (unless (tramp-compat-process-live-p p) (tramp-error vec 'file-error "Terminated!")) (tramp-set-connection-property p "vector" vec) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) ;; Check whether the properties have been changed. If diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 593be33e83..aba6f414a4 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1082,6 +1082,7 @@ file names." (tramp-set-connection-property p "vector" v) (process-put p 'events events) (process-put p 'watch-name localname) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) (set-process-filter p 'tramp-gvfs-monitor-file-process-filter) ;; There might be an error if the monitor is not supported. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 71afb9aeb7..971cdaedf8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2517,6 +2517,7 @@ The method used must be an out-of-band method." command)))) (tramp-message orig-vec 6 "%s" command) (tramp-set-connection-property p "vector" orig-vec) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) ;; We must adapt `tramp-local-end-of-line' for @@ -4719,6 +4720,7 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. (tramp-set-connection-property p "vector" vec) (set-process-sentinel p 'tramp-process-sentinel) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons (butlast (append vec nil) 2) (current-time)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 014e1e8601..5a3e2566d7 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -526,6 +526,7 @@ pass to the OPERATION." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-with-tar) @@ -788,6 +789,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-get-acl) (when (> (point-max) (point-min)) @@ -1384,6 +1386,7 @@ target of the symlink differ." (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" v) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) (tramp-process-actions p v nil tramp-smb-actions-set-acl) (goto-char (point-max)) @@ -1890,6 +1893,7 @@ If ARGUMENT is non-nil, use it as argument for (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-connection-property p "vector" vec) + (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) ;; Set variables for computing the prompt for reading password. commit 5c4dbbb745f31fda95843bbc6d2fd070b9473c65 Author: Nicolas Petton Date: Thu May 4 11:34:41 2017 +0200 * lisp/emacs-lisp/seq.el: Bump seq version. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 963a1ddf96..23e444fe24 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.19 +;; Version: 2.20 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org commit 88f96e69cfcd265f2ef0db3e134ac9e29e64ec3e Author: Damien Cassou Date: Mon Apr 17 11:01:39 2017 +0200 Add seq-set-equal-p to test for set equality * lisp/emacs-lisp/seq.el (seq-set-equal-p): Add function to compare two lists as if they were sets. * test/lisp/emacs-lisp/seq-tests.el (test-seq-set-equal-p): Add test for seq-set-equal-p. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 93e8fa8a5f..c7cf9f5e1a 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -792,6 +792,33 @@ it is a function of two arguments to use instead of the default @code{equal}. @end defun +@defun seq-set-equal-p sequence1 sequence2 &optional testfn +This function checks whether @var{sequence1} and @var{sequence2} +contain the same elements, regardless of the order. If the optional +argument @var{testfn} is non-@code{nil}, it is a function of two +arguments to use instead of the default @code{equal}. + +@example +@group +(seq-set-equal-p '(a b c) '(c b a)) +@result{} t +@end group +@group +(seq-set-equal-p '(a b c) '(c b)) +@result{} nil +@end group +@group +(seq-set-equal-p '("a" "b" "c") '("c" "b" "a")) +@result{} t +@end group +@group +(seq-set-equal-p '("a" "b" "c") '("c" "b" "a") #'eq) +@result{} nil +@end group +@end example + +@end defun + @defun seq-position sequence elt &optional function This function returns the index of the first element in @var{sequence} that is equal to @var{elt}. If the optional argument diff --git a/etc/NEWS b/etc/NEWS index d79eecf767..73c088c962 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -899,6 +899,9 @@ instead of its first. * Lisp Changes in Emacs 26.1 +** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 +contain the same elements, regardless of the order. + +++ ** Emacs now supports records for user-defined types, via the new functions 'make-record', 'record', and 'recordp'. Records are now diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 10de248479..963a1ddf96 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -355,6 +355,12 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." e)) sequence)) +(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) + "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1) + (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2))) + (cl-defgeneric seq-position (sequence elt &optional testfn) "Return the index of the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 788524bedb..495cf1e543 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -197,6 +197,31 @@ Evaluate BODY for each created sequence. (should (seq-every-p #'identity seq)) (should (seq-every-p #'test-sequences-evenp seq)))) +(ert-deftest test-seq-set-equal-p () + (with-test-sequences (seq1 '(1 2 3)) + (should (seq-set-equal-p seq1 seq1)) + (should (seq-set-equal-p seq1 seq1 #'eq)) + + (with-test-sequences (seq2 '(3 2 1)) + (should (seq-set-equal-p seq1 seq2)) + (should (seq-set-equal-p seq2 seq1)) + (should (seq-set-equal-p seq1 seq2 #'eq)) + (should (seq-set-equal-p seq2 seq1 #'eq))) + + (with-test-sequences (seq2 '(3 1)) + (should-not (seq-set-equal-p seq1 seq2)) + (should-not (seq-set-equal-p seq2 seq1)))) + + (should (seq-set-equal-p '("a" "b" "c") + '("c" "b" "a"))) + (should-not (seq-set-equal-p '("a" "b" "c") + '("c" "b" "a") #'eq)) + (should-not (seq-set-equal-p '(("a" 1) ("b" 1) ("c" 1)) + '(("c" 2) ("b" 2) ("a" 2)))) + (should (seq-set-equal-p '(("a" 1) ("b" 1) ("c" 1)) + '(("c" 2) ("b" 2) ("a" 2)) + (lambda (i1 i2) (equal (car i1) (car i2)))))) + (ert-deftest test-seq-empty-p () (with-test-sequences (seq '(0)) (should-not (seq-empty-p seq))) commit 250d24fa7333046fb187cf4f544dc4358f16e2df Author: Paul Eggert Date: Wed May 3 18:21:20 2017 -0700 Spelling fixes * lisp/gnus/nndiary.el (nndiary-last-occurrence): Rename from nndiary-last-occurence. (nndiary-next-occurrence): Rename from nndiary-next-occurence. All uses changed. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 1d200ce136..292d55d50c 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -690,7 +690,7 @@ information, is available via the @code{process-contact} function. The current working directory of the subprocess is set to the current buffer's value of @code{default-directory} if that is local (as determined by `unhandled-file-name-directory'), or "~" otherwise. If -you want to run a process in a remote direcotry use +you want to run a process in a remote directory use @code{start-file-process}. @end defun diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 99d3a2b38e..b81c6d08f5 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -159,7 +159,7 @@ There are currently two built-in format functions: ;; Code partly stolen from article-make-date-line (let* ((extras (mail-header-extra header)) (sched (gnus-diary-header-schedule extras)) - (occur (nndiary-next-occurence sched (current-time))) + (occur (nndiary-next-occurrence sched (current-time))) (now (current-time)) (real-time (time-subtract occur now))) (if (null real-time) @@ -194,7 +194,7 @@ There are currently two built-in format functions: ;; Returns a formatted time string for the next occurrence of this message. (let* ((extras (mail-header-extra header)) (sched (gnus-diary-header-schedule extras)) - (occur (nndiary-next-occurence sched (current-time)))) + (occur (nndiary-next-occurrence sched (current-time)))) (format-time-string gnus-diary-time-format occur))) @@ -206,8 +206,8 @@ There are currently two built-in format functions: (e2 (mail-header-extra h2)) (s1 (gnus-diary-header-schedule e1)) (s2 (gnus-diary-header-schedule e2)) - (o1 (nndiary-next-occurence s1 now)) - (o2 (nndiary-next-occurence s2 now))) + (o1 (nndiary-next-occurrence s1 now)) + (o2 (nndiary-next-occurrence s2 now))) (if (and (= (car o1) (car o2)) (= (cadr o1) (cadr o2))) (< (mail-header-number h1) (mail-header-number h2)) (time-less-p o1 o2)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 183cd46fa4..9bdd0c66f5 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -8600,7 +8600,7 @@ these articles." ;; subject, while the second pop gets us back to the state ;; before we started to deal with the thread. presumably we want ;; to think of the thread and its associated subject matches as - ;; a single thing so that we onnly need to pop once to get back + ;; a single thing so that we need to pop only once to get back ;; to the original view. (pop gnus-newsgroup-limits) (gnus-summary-position-point)))) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index bed35b55b3..0390b5b8d2 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -1304,9 +1304,7 @@ all. This may very well take some time.") res)) (sort res 'time-less-p))) -;; FIXME: "occurrence" is misspelled in this function name. - -(defun nndiary-last-occurence (sched) +(defun nndiary-last-occurrence (sched) ;; Returns the last occurrence of schedule SCHED as an Emacs time struct, or ;; nil for permanent schedule or errors. (let ((minute (nndiary-max (nth 0 sched))) @@ -1385,10 +1383,11 @@ all. This may very well take some time.") (nnheader-report 'nndiary "Undecidable schedule") nil)) )))) +(define-obsolete-function-alias + 'nndiary-last-occurence + 'nndiary-last-occurrence "26.1") -;; FIXME: "occurrence" is misspelled in this function name. - -(defun nndiary-next-occurence (sched now) +(defun nndiary-next-occurrence (sched now) ;; Returns the next occurrence of schedule SCHED, starting from time NOW. ;; If there's no next occurrence, returns the last one (if any) which is then ;; in the past. @@ -1517,10 +1516,13 @@ all. This may very well take some time.") )) ))) )) - (nndiary-last-occurence sched)) + (nndiary-last-occurrence sched)) ;; else - (nndiary-last-occurence sched)) + (nndiary-last-occurrence sched)) )) +(define-obsolete-function-alias + 'nndiary-next-occurence + 'nndiary-next-occurrence "26.1") (defun nndiary-expired-article-p (file) (with-temp-buffer @@ -1529,7 +1531,7 @@ all. This may very well take some time.") ;; An article has expired if its last schedule (if any) is in the ;; past. A permanent schedule never expires. (and sched - (setq sched (nndiary-last-occurence sched)) + (setq sched (nndiary-last-occurrence sched)) (time-less-p sched (current-time)))) ;; else (nnheader-report 'nndiary "Could not read file %s" file) @@ -1543,7 +1545,7 @@ all. This may very well take some time.") (sched (nndiary-schedule))) ;; The article should be re-considered as unread if there's a reminder ;; between the group timestamp and the current time. - (when (and sched (setq sched (nndiary-next-occurence sched now))) + (when (and sched (setq sched (nndiary-next-occurrence sched now))) (let ((reminders ;; add the next occurrence itself at the end. (append (nndiary-compute-reminders sched) (list sched)))) (while (and reminders (time-less-p (car reminders) timestamp)) commit 5c1631b9e9e6a6429e14810a3309f56bb901853d Author: Paul Eggert Date: Wed May 3 18:18:56 2017 -0700 Merge from pkg-config * m4/pkg.m4: Copy from pkg-config 0.29.1. diff --git a/m4/pkg.m4 b/m4/pkg.m4 index c5b26b52e6..82bea96ee7 100644 --- a/m4/pkg.m4 +++ b/m4/pkg.m4 @@ -1,29 +1,60 @@ -# pkg.m4 - Macros to locate and utilise pkg-config. -*- Autoconf -*- -# serial 1 (pkg-config-0.24) -# -# Copyright © 2004 Scott James Remnant . -# -# 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 2 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, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# PKG_PROG_PKG_CONFIG([MIN-VERSION]) -# ---------------------------------- +dnl pkg.m4 - Macros to locate and utilise pkg-config. -*- Autoconf -*- +dnl serial 11 (pkg-config-0.29.1) +dnl +dnl Copyright © 2004 Scott James Remnant . +dnl Copyright © 2012-2015 Dan Nicholson +dnl +dnl This program is free software; you can redistribute it and/or modify +dnl it under the terms of the GNU General Public License as published by +dnl the Free Software Foundation; either version 2 of the License, or +dnl (at your option) any later version. +dnl +dnl This program is distributed in the hope that it will be useful, but +dnl WITHOUT ANY WARRANTY; without even the implied warranty of +dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +dnl General Public License for more details. +dnl +dnl You should have received a copy of the GNU General Public License +dnl along with this program; if not, write to the Free Software +dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +dnl 02111-1307, USA. +dnl +dnl As a special exception to the GNU General Public License, if you +dnl distribute this file as part of a program that contains a +dnl configuration script generated by Autoconf, you may include it under +dnl the same distribution terms that you use for the rest of that +dnl program. + +dnl PKG_PREREQ(MIN-VERSION) +dnl ----------------------- +dnl Since: 0.29 +dnl +dnl Verify that the version of the pkg-config macros are at least +dnl MIN-VERSION. Unlike PKG_PROG_PKG_CONFIG, which checks the user's +dnl installed version of pkg-config, this checks the developer's version +dnl of pkg.m4 when generating configure. +dnl +dnl To ensure that this macro is defined, also add: +dnl m4_ifndef([PKG_PREREQ], +dnl [m4_fatal([must install pkg-config 0.29 or later before running autoconf/autogen])]) +dnl +dnl See the "Since" comment for each macro you use to see what version +dnl of the macros you require. +m4_defun([PKG_PREREQ], +[m4_define([PKG_MACROS_VERSION], [0.29.1]) +m4_if(m4_version_compare(PKG_MACROS_VERSION, [$1]), -1, + [m4_fatal([pkg.m4 version $1 or higher is required but ]PKG_MACROS_VERSION[ found])]) +])dnl PKG_PREREQ + +dnl PKG_PROG_PKG_CONFIG([MIN-VERSION]) +dnl ---------------------------------- +dnl Since: 0.16 +dnl +dnl Search for the pkg-config tool and set the PKG_CONFIG variable to +dnl first found in the path. Checks that the version of pkg-config found +dnl is at least MIN-VERSION. If MIN-VERSION is not specified, 0.9.0 is +dnl used since that's the first version where most current features of +dnl pkg-config existed. AC_DEFUN([PKG_PROG_PKG_CONFIG], [m4_pattern_forbid([^_?PKG_[A-Z_]+$]) m4_pattern_allow([^PKG_CONFIG(_(PATH|LIBDIR|SYSROOT_DIR|ALLOW_SYSTEM_(CFLAGS|LIBS)))?$]) @@ -45,18 +76,19 @@ if test -n "$PKG_CONFIG"; then PKG_CONFIG="" fi fi[]dnl -])# PKG_PROG_PKG_CONFIG - -# PKG_CHECK_EXISTS(MODULES, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) -# -# Check to see whether a particular set of modules exists. Similar -# to PKG_CHECK_MODULES(), but does not set variables or print errors. -# -# Please remember that m4 expands AC_REQUIRE([PKG_PROG_PKG_CONFIG]) -# only at the first occurence in configure.ac, so if the first place -# it's called might be skipped (such as if it is within an "if", you -# have to call PKG_CHECK_EXISTS manually -# -------------------------------------------------------------- +])dnl PKG_PROG_PKG_CONFIG + +dnl PKG_CHECK_EXISTS(MODULES, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) +dnl ------------------------------------------------------------------- +dnl Since: 0.18 +dnl +dnl Check to see whether a particular set of modules exists. Similar to +dnl PKG_CHECK_MODULES(), but does not set variables or print errors. +dnl +dnl Please remember that m4 expands AC_REQUIRE([PKG_PROG_PKG_CONFIG]) +dnl only at the first occurence in configure.ac, so if the first place +dnl it's called might be skipped (such as if it is within an "if", you +dnl have to call PKG_CHECK_EXISTS manually AC_DEFUN([PKG_CHECK_EXISTS], [AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl if test -n "$PKG_CONFIG" && \ @@ -66,8 +98,10 @@ m4_ifvaln([$3], [else $3])dnl fi]) -# _PKG_CONFIG([VARIABLE], [COMMAND], [MODULES]) -# --------------------------------------------- +dnl _PKG_CONFIG([VARIABLE], [COMMAND], [MODULES]) +dnl --------------------------------------------- +dnl Internal wrapper calling pkg-config via PKG_CONFIG and setting +dnl pkg_failed based on the result. m4_define([_PKG_CONFIG], [if test -n "$$1"; then pkg_cv_[]$1="$$1" @@ -79,10 +113,11 @@ m4_define([_PKG_CONFIG], else pkg_failed=untried fi[]dnl -])# _PKG_CONFIG +])dnl _PKG_CONFIG -# _PKG_SHORT_ERRORS_SUPPORTED -# ----------------------------- +dnl _PKG_SHORT_ERRORS_SUPPORTED +dnl --------------------------- +dnl Internal check to see if pkg-config supports short errors. AC_DEFUN([_PKG_SHORT_ERRORS_SUPPORTED], [AC_REQUIRE([PKG_PROG_PKG_CONFIG]) if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then @@ -90,19 +125,17 @@ if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then else _pkg_short_errors_supported=no fi[]dnl -])# _PKG_SHORT_ERRORS_SUPPORTED - - -# PKG_CHECK_MODULES(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], -# [ACTION-IF-NOT-FOUND]) -# -# -# Note that if there is a possibility the first call to -# PKG_CHECK_MODULES might not happen, you should be sure to include an -# explicit call to PKG_PROG_PKG_CONFIG in your configure.ac -# -# -# -------------------------------------------------------------- +])dnl _PKG_SHORT_ERRORS_SUPPORTED + + +dnl PKG_CHECK_MODULES(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], +dnl [ACTION-IF-NOT-FOUND]) +dnl -------------------------------------------------------------- +dnl Since: 0.4.0 +dnl +dnl Note that if there is a possibility the first call to +dnl PKG_CHECK_MODULES might not happen, you should be sure to include an +dnl explicit call to PKG_PROG_PKG_CONFIG in your configure.ac AC_DEFUN([PKG_CHECK_MODULES], [AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl AC_ARG_VAR([$1][_CFLAGS], [C compiler flags for $1, overriding pkg-config])dnl @@ -156,16 +189,40 @@ else AC_MSG_RESULT([yes]) $3 fi[]dnl -])# PKG_CHECK_MODULES +])dnl PKG_CHECK_MODULES + + +dnl PKG_CHECK_MODULES_STATIC(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], +dnl [ACTION-IF-NOT-FOUND]) +dnl --------------------------------------------------------------------- +dnl Since: 0.29 +dnl +dnl Checks for existence of MODULES and gathers its build flags with +dnl static libraries enabled. Sets VARIABLE-PREFIX_CFLAGS from --cflags +dnl and VARIABLE-PREFIX_LIBS from --libs. +dnl +dnl Note that if there is a possibility the first call to +dnl PKG_CHECK_MODULES_STATIC might not happen, you should be sure to +dnl include an explicit call to PKG_PROG_PKG_CONFIG in your +dnl configure.ac. +AC_DEFUN([PKG_CHECK_MODULES_STATIC], +[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl +_save_PKG_CONFIG=$PKG_CONFIG +PKG_CONFIG="$PKG_CONFIG --static" +PKG_CHECK_MODULES($@) +PKG_CONFIG=$_save_PKG_CONFIG[]dnl +])dnl PKG_CHECK_MODULES_STATIC -# PKG_INSTALLDIR(DIRECTORY) -# ------------------------- -# Substitutes the variable pkgconfigdir as the location where a module -# should install pkg-config .pc files. By default the directory is -# $libdir/pkgconfig, but the default can be changed by passing -# DIRECTORY. The user can override through the --with-pkgconfigdir -# parameter. +dnl PKG_INSTALLDIR([DIRECTORY]) +dnl ------------------------- +dnl Since: 0.27 +dnl +dnl Substitutes the variable pkgconfigdir as the location where a module +dnl should install pkg-config .pc files. By default the directory is +dnl $libdir/pkgconfig, but the default can be changed by passing +dnl DIRECTORY. The user can override through the --with-pkgconfigdir +dnl parameter. AC_DEFUN([PKG_INSTALLDIR], [m4_pushdef([pkg_default], [m4_default([$1], ['${libdir}/pkgconfig'])]) m4_pushdef([pkg_description], @@ -176,16 +233,18 @@ AC_ARG_WITH([pkgconfigdir], AC_SUBST([pkgconfigdir], [$with_pkgconfigdir]) m4_popdef([pkg_default]) m4_popdef([pkg_description]) -]) dnl PKG_INSTALLDIR +])dnl PKG_INSTALLDIR -# PKG_NOARCH_INSTALLDIR(DIRECTORY) -# ------------------------- -# Substitutes the variable noarch_pkgconfigdir as the location where a -# module should install arch-independent pkg-config .pc files. By -# default the directory is $datadir/pkgconfig, but the default can be -# changed by passing DIRECTORY. The user can override through the -# --with-noarch-pkgconfigdir parameter. +dnl PKG_NOARCH_INSTALLDIR([DIRECTORY]) +dnl -------------------------------- +dnl Since: 0.27 +dnl +dnl Substitutes the variable noarch_pkgconfigdir as the location where a +dnl module should install arch-independent pkg-config .pc files. By +dnl default the directory is $datadir/pkgconfig, but the default can be +dnl changed by passing DIRECTORY. The user can override through the +dnl --with-noarch-pkgconfigdir parameter. AC_DEFUN([PKG_NOARCH_INSTALLDIR], [m4_pushdef([pkg_default], [m4_default([$1], ['${datadir}/pkgconfig'])]) m4_pushdef([pkg_description], @@ -196,13 +255,15 @@ AC_ARG_WITH([noarch-pkgconfigdir], AC_SUBST([noarch_pkgconfigdir], [$with_noarch_pkgconfigdir]) m4_popdef([pkg_default]) m4_popdef([pkg_description]) -]) dnl PKG_NOARCH_INSTALLDIR +])dnl PKG_NOARCH_INSTALLDIR -# PKG_CHECK_VAR(VARIABLE, MODULE, CONFIG-VARIABLE, -# [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) -# ------------------------------------------- -# Retrieves the value of the pkg-config variable for the given module. +dnl PKG_CHECK_VAR(VARIABLE, MODULE, CONFIG-VARIABLE, +dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) +dnl ------------------------------------------- +dnl Since: 0.28 +dnl +dnl Retrieves the value of the pkg-config variable for the given module. AC_DEFUN([PKG_CHECK_VAR], [AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl AC_ARG_VAR([$1], [value of $3 for $2, overriding pkg-config])dnl @@ -211,4 +272,4 @@ _PKG_CONFIG([$1], [variable="][$3]["], [$2]) AS_VAR_COPY([$1], [pkg_cv_][$1]) AS_VAR_IF([$1], [""], [$5], [$4])dnl -])# PKG_CHECK_VAR +])dnl PKG_CHECK_VAR commit f0708fc5e424a2b5b814c59be0ec7234a739a500 Author: Tom Tromey Date: Wed Jan 25 00:53:49 2017 -0700 Add color highlighting to css-mode Bug#25525 * lisp/textmodes/css-mode.el (css--color-map): New constant. (css-value-class-alist): Use css--color-map. (css--number-regexp, css--percent-regexp) (css--number-or-percent-regexp, css--angle-regexp): New constants. (css--color-skip-blanks, css--rgb-color, css--hsl-color): New functions. (css--colors-regexp): New constant. (css--hex-color, css--named-color, css--compute-color) (css--contrasty-color, css--fontify-colors) (css--fontify-region): New functions. (css-mode): Set font-lock-fontify-region-function. (css-mode-syntax-table): Set syntax on more characters. (css-fontify-colors): New defcustom. (scss-mode-syntax-table): Define syntax for ?$ and ?%. * test/lisp/textmodes/css-mode-tests.el (css-test-property-values): Update. (css-test-rgb-parser, css-test-hsl-parser) (css-test-named-color): New tests. * etc/NEWS: Add entry. diff --git a/etc/NEWS b/etc/NEWS index 410e681c9e..d79eecf767 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -735,6 +735,11 @@ pseudo-element, with the default being guessed from context). By default the information is looked up on the Mozilla Developer Network, but this can be customized using 'css-lookup-url-format'. +--- +*** CSS colors are fontified using the color they represent as the +background. For instance, #ff0000 would be fontified with a red +background. + +++ ** Emacs now supports character name escape sequences in character and string literals. The syntax variants \N{character name} and diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index d4a5cfe629..2c81710b23 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -33,6 +33,8 @@ ;;; Code: (require 'eww) +(require 'cl-lib) +(require 'color) (require 'seq) (require 'sgml-mode) (require 'smie) @@ -487,8 +489,157 @@ further value candidates, since that list would be infinite.") (mapcar #'car css-property-alist) "Identifiers for properties.") +(defconst css--color-map + '(("black" . "#000000") + ("silver" . "#c0c0c0") + ("gray" . "#808080") + ("white" . "#ffffff") + ("maroon" . "#800000") + ("red" . "#ff0000") + ("purple" . "#800080") + ("fuchsia" . "#ff00ff") + ("green" . "#008000") + ("lime" . "#00ff00") + ("olive" . "#808000") + ("yellow" . "#ffff00") + ("navy" . "#000080") + ("blue" . "#0000ff") + ("teal" . "#008080") + ("aqua" . "#00ffff") + ("orange" . "#ffa500") + ("aliceblue" . "#f0f8ff") + ("antiquewhite" . "#faebd7") + ("aquamarine" . "#7fffd4") + ("azure" . "#f0ffff") + ("beige" . "#f5f5dc") + ("bisque" . "#ffe4c4") + ("blanchedalmond" . "#ffebcd") + ("blueviolet" . "#8a2be2") + ("brown" . "#a52a2a") + ("burlywood" . "#deb887") + ("cadetblue" . "#5f9ea0") + ("chartreuse" . "#7fff00") + ("chocolate" . "#d2691e") + ("coral" . "#ff7f50") + ("cornflowerblue" . "#6495ed") + ("cornsilk" . "#fff8dc") + ("crimson" . "#dc143c") + ("darkblue" . "#00008b") + ("darkcyan" . "#008b8b") + ("darkgoldenrod" . "#b8860b") + ("darkgray" . "#a9a9a9") + ("darkgreen" . "#006400") + ("darkgrey" . "#a9a9a9") + ("darkkhaki" . "#bdb76b") + ("darkmagenta" . "#8b008b") + ("darkolivegreen" . "#556b2f") + ("darkorange" . "#ff8c00") + ("darkorchid" . "#9932cc") + ("darkred" . "#8b0000") + ("darksalmon" . "#e9967a") + ("darkseagreen" . "#8fbc8f") + ("darkslateblue" . "#483d8b") + ("darkslategray" . "#2f4f4f") + ("darkslategrey" . "#2f4f4f") + ("darkturquoise" . "#00ced1") + ("darkviolet" . "#9400d3") + ("deeppink" . "#ff1493") + ("deepskyblue" . "#00bfff") + ("dimgray" . "#696969") + ("dimgrey" . "#696969") + ("dodgerblue" . "#1e90ff") + ("firebrick" . "#b22222") + ("floralwhite" . "#fffaf0") + ("forestgreen" . "#228b22") + ("gainsboro" . "#dcdcdc") + ("ghostwhite" . "#f8f8ff") + ("gold" . "#ffd700") + ("goldenrod" . "#daa520") + ("greenyellow" . "#adff2f") + ("grey" . "#808080") + ("honeydew" . "#f0fff0") + ("hotpink" . "#ff69b4") + ("indianred" . "#cd5c5c") + ("indigo" . "#4b0082") + ("ivory" . "#fffff0") + ("khaki" . "#f0e68c") + ("lavender" . "#e6e6fa") + ("lavenderblush" . "#fff0f5") + ("lawngreen" . "#7cfc00") + ("lemonchiffon" . "#fffacd") + ("lightblue" . "#add8e6") + ("lightcoral" . "#f08080") + ("lightcyan" . "#e0ffff") + ("lightgoldenrodyellow" . "#fafad2") + ("lightgray" . "#d3d3d3") + ("lightgreen" . "#90ee90") + ("lightgrey" . "#d3d3d3") + ("lightpink" . "#ffb6c1") + ("lightsalmon" . "#ffa07a") + ("lightseagreen" . "#20b2aa") + ("lightskyblue" . "#87cefa") + ("lightslategray" . "#778899") + ("lightslategrey" . "#778899") + ("lightsteelblue" . "#b0c4de") + ("lightyellow" . "#ffffe0") + ("limegreen" . "#32cd32") + ("linen" . "#faf0e6") + ("mediumaquamarine" . "#66cdaa") + ("mediumblue" . "#0000cd") + ("mediumorchid" . "#ba55d3") + ("mediumpurple" . "#9370db") + ("mediumseagreen" . "#3cb371") + ("mediumslateblue" . "#7b68ee") + ("mediumspringgreen" . "#00fa9a") + ("mediumturquoise" . "#48d1cc") + ("mediumvioletred" . "#c71585") + ("midnightblue" . "#191970") + ("mintcream" . "#f5fffa") + ("mistyrose" . "#ffe4e1") + ("moccasin" . "#ffe4b5") + ("navajowhite" . "#ffdead") + ("oldlace" . "#fdf5e6") + ("olivedrab" . "#6b8e23") + ("orangered" . "#ff4500") + ("orchid" . "#da70d6") + ("palegoldenrod" . "#eee8aa") + ("palegreen" . "#98fb98") + ("paleturquoise" . "#afeeee") + ("palevioletred" . "#db7093") + ("papayawhip" . "#ffefd5") + ("peachpuff" . "#ffdab9") + ("peru" . "#cd853f") + ("pink" . "#ffc0cb") + ("plum" . "#dda0dd") + ("powderblue" . "#b0e0e6") + ("rosybrown" . "#bc8f8f") + ("royalblue" . "#4169e1") + ("saddlebrown" . "#8b4513") + ("salmon" . "#fa8072") + ("sandybrown" . "#f4a460") + ("seagreen" . "#2e8b57") + ("seashell" . "#fff5ee") + ("sienna" . "#a0522d") + ("skyblue" . "#87ceeb") + ("slateblue" . "#6a5acd") + ("slategray" . "#708090") + ("slategrey" . "#708090") + ("snow" . "#fffafa") + ("springgreen" . "#00ff7f") + ("steelblue" . "#4682b4") + ("tan" . "#d2b48c") + ("thistle" . "#d8bfd8") + ("tomato" . "#ff6347") + ("turquoise" . "#40e0d0") + ("violet" . "#ee82ee") + ("wheat" . "#f5deb3") + ("whitesmoke" . "#f5f5f5") + ("yellowgreen" . "#9acd32") + ("rebeccapurple" . "#663399")) + "Map CSS named colors to their hex RGB value.") + (defconst css-value-class-alist - '((absolute-size + `((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large" "xx-large") (alphavalue number) @@ -550,36 +701,7 @@ further value candidates, since that list would be infinite.") (line-width length "thin" "medium" "thick") (linear-gradient "linear-gradient()") (margin-width "auto" length percentage) - (named-color - "aliceblue" "antiquewhite" "aqua" "aquamarine" "azure" "beige" - "bisque" "black" "blanchedalmond" "blue" "blueviolet" "brown" - "burlywood" "cadetblue" "chartreuse" "chocolate" "coral" - "cornflowerblue" "cornsilk" "crimson" "cyan" "darkblue" - "darkcyan" "darkgoldenrod" "darkgray" "darkgreen" "darkkhaki" - "darkmagenta" "darkolivegreen" "darkorange" "darkorchid" - "darkred" "darksalmon" "darkseagreen" "darkslateblue" - "darkslategray" "darkturquoise" "darkviolet" "deeppink" - "deepskyblue" "dimgray" "dodgerblue" "firebrick" "floralwhite" - "forestgreen" "fuchsia" "gainsboro" "ghostwhite" "gold" - "goldenrod" "gray" "green" "greenyellow" "honeydew" "hotpink" - "indianred" "indigo" "ivory" "khaki" "lavender" "lavenderblush" - "lawngreen" "lemonchiffon" "lightblue" "lightcoral" "lightcyan" - "lightgoldenrodyellow" "lightgray" "lightgreen" "lightpink" - "lightsalmon" "lightseagreen" "lightskyblue" "lightslategray" - "lightsteelblue" "lightyellow" "lime" "limegreen" "linen" - "magenta" "maroon" "mediumaquamarine" "mediumblue" "mediumorchid" - "mediumpurple" "mediumseagreen" "mediumslateblue" - "mediumspringgreen" "mediumturquoise" "mediumvioletred" - "midnightblue" "mintcream" "mistyrose" "moccasin" "navajowhite" - "navy" "oldlace" "olive" "olivedrab" "orange" "orangered" - "orchid" "palegoldenrod" "palegreen" "paleturquoise" - "palevioletred" "papayawhip" "peachpuff" "peru" "pink" "plum" - "powderblue" "purple" "rebeccapurple" "red" "rosybrown" - "royalblue" "saddlebrown" "salmon" "sandybrown" "seagreen" - "seashell" "sienna" "silver" "skyblue" "slateblue" "slategray" - "snow" "springgreen" "steelblue" "tan" "teal" "thistle" "tomato" - "turquoise" "violet" "wheat" "white" "whitesmoke" "yellow" - "yellowgreen") + (named-color . ,(mapcar #'car css--color-map)) (number "calc()") (numeric-figure-values "lining-nums" "oldstyle-nums") (numeric-fraction-values "diagonal-fractions" "stacked-fractions") @@ -663,11 +785,23 @@ cannot be completed sensibly: `custom-ident', (modify-syntax-entry ?\[ "(]" st) (modify-syntax-entry ?\] ")[" st) ;; Special chars that sometimes come at the beginning of words. - (modify-syntax-entry ?@ "'" st) - ;; (modify-syntax-entry ?: "'" st) - (modify-syntax-entry ?# "'" st) + ;; We'll treat them as symbol constituents. + (modify-syntax-entry ?@ "_" st) + (modify-syntax-entry ?# "_" st) + (modify-syntax-entry ?. "_" st) ;; Distinction between words and symbols. (modify-syntax-entry ?- "_" st) + + (modify-syntax-entry ?! "." st) + (modify-syntax-entry ?$ "." st) + (modify-syntax-entry ?% "." st) + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?, "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?? "." st) st)) (defvar css-mode-map @@ -782,6 +916,217 @@ cannot be completed sensibly: `custom-ident', (defvar css-font-lock-defaults '(css-font-lock-keywords nil t)) +(defconst css--number-regexp + "\\(\\(?:[0-9]*\\.[0-9]+\\(?:[eE][0-9]+\\)?\\)\\|[0-9]+\\)" + "A regular expression matching a CSS number.") + +(defconst css--percent-regexp "\\([0-9]+\\)%" + "A regular expression matching a CSS percentage.") + +(defconst css--number-or-percent-regexp + (concat "\\(?:" css--percent-regexp "\\)\\|\\(?:" css--number-regexp "\\)") + "A regular expression matching a CSS number or a CSS percentage.") + +(defconst css--angle-regexp + (concat css--number-regexp + (regexp-opt '("deg" "grad" "rad" "turn") t) + "?") + "A regular expression matching a CSS angle.") + +(defun css--color-skip-blanks () + "Skip blanks and comments." + (while (forward-comment 1))) + +(cl-defun css--rgb-color () + "Parse a CSS rgb() or rgba() color. +Point should be just after the open paren. +Returns a hex RGB color, or nil if the color could not be recognized. +This recognizes CSS-color-4 extensions." + (let ((result '()) + (iter 0)) + (while (< iter 4) + (css--color-skip-blanks) + (unless (looking-at css--number-or-percent-regexp) + (cl-return-from css--rgb-color nil)) + (let* ((is-percent (match-beginning 1)) + (str (match-string (if is-percent 1 2))) + (number (string-to-number str))) + (when is-percent + (setq number (* 255 (/ number 100.0)))) + ;; Don't push the alpha. + (when (< iter 3) + (push (min (max 0 (truncate number)) 255) result)) + (goto-char (match-end 0)) + (css--color-skip-blanks) + (cl-incf iter) + ;; Accept a superset of the CSS syntax since I'm feeling lazy. + (when (and (= (skip-chars-forward ",/") 0) + (= iter 3)) + ;; The alpha is optional. + (cl-incf iter)) + (css--color-skip-blanks))) + (when (looking-at ")") + (forward-char) + (apply #'format "#%02x%02x%02x" (nreverse result))))) + +(cl-defun css--hsl-color () + "Parse a CSS hsl() or hsla() color. +Point should be just after the open paren. +Returns a hex RGB color, or nil if the color could not be recognized. +This recognizes CSS-color-4 extensions." + (let ((result '())) + ;; First parse the hue. + (css--color-skip-blanks) + (unless (looking-at css--angle-regexp) + (cl-return-from css--hsl-color nil)) + (let ((hue (string-to-number (match-string 1))) + (unit (match-string 2))) + (goto-char (match-end 0)) + ;; Note that here "turn" is just passed through. + (cond + ((or (not unit) (equal unit "deg")) + ;; Degrees. + (setq hue (/ hue 360.0))) + ((equal unit "grad") + (setq hue (/ hue 400.0))) + ((equal unit "rad") + (setq hue (/ hue (* 2 float-pi))))) + (push (mod hue 1.0) result)) + (dotimes (_ 2) + (skip-chars-forward ",") + (css--color-skip-blanks) + (unless (looking-at css--percent-regexp) + (cl-return-from css--hsl-color nil)) + (let ((number (string-to-number (match-string 1)))) + (setq number (/ number 100.0)) + (push (min (max number 0.0) 1.0) result) + (goto-char (match-end 0)) + (css--color-skip-blanks))) + (css--color-skip-blanks) + ;; Accept a superset of the CSS syntax since I'm feeling lazy. + (when (> (skip-chars-forward ",/") 0) + (css--color-skip-blanks) + (unless (looking-at css--number-or-percent-regexp) + (cl-return-from css--hsl-color nil)) + (goto-char (match-end 0)) + (css--color-skip-blanks)) + (when (looking-at ")") + (forward-char) + (apply #'color-rgb-to-hex + (nconc (apply #'color-hsl-to-rgb (nreverse result)) '(2)))))) + +(defconst css--colors-regexp + (concat + ;; Named colors. + (regexp-opt (mapcar #'car css--color-map) 'symbols) + "\\|" + ;; Short hex. css-color-4 adds alpha. + "\\(#[0-9a-fA-F]\\{3,4\\}\\b\\)" + "\\|" + ;; Long hex. css-color-4 adds alpha. + "\\(#\\(?:[0-9a-fA-F][0-9a-fA-F]\\)\\{3,4\\}\\b\\)" + "\\|" + ;; RGB. + "\\(\\_ (length str) 4) + (substring str 0 7) + (substring str 0 4))) + +(defun css--named-color (start-point str) + "Check whether STR, seen at point, is CSS named color. +Returns STR if it is a valid color. Special care is taken +to exclude some SCSS contructs." + (when-let ((color (assoc str css--color-map))) + (save-excursion + (goto-char start-point) + (forward-comment (- (point))) + (skip-chars-backward "@[:alpha:]") + (unless (looking-at-p "@\\(mixin\\|include\\)") + (cdr color))))) + +(defun css--compute-color (start-point match) + "Return the CSS color at point. +Point should be just after the start of a CSS color, as recognized +by `css--colors-regexp'. START-POINT is the start of the color, +and MATCH is the string matched by the regexp. + +This function will either return the color, as a hex RGB string; +or `nil' if no color could be recognized. When this function +returns, point will be at the end of the recognized color." + (cond + ((eq (aref match 0) ?#) + (css--hex-color match)) + ((member match '("rgb(" "rgba(")) + (css--rgb-color)) + ((member match '("hsl(" "hsla(")) + (css--hsl-color)) + ;; Evaluate to the color if the name is found. + ((css--named-color start-point match)))) + +(defun css--contrasty-color (name) + "Return a color that contrasts with NAME. +NAME is of any form accepted by `color-distance'. +The returned color will be usable by Emacs and will contrast +with NAME; in particular so that if NAME is used as a background +color, the returned color can be used as the foreground and still +be readable." + ;; See bug#25525 for a discussion of this. + (if (> (color-distance name "black") 292485) + "black" "white")) + +(defcustom css-fontify-colors t + "Whether CSS colors should be fontified using the color as the background. +When non-`nil', a text representing CSS color will be fontified +such that its background is the color itself. E.g., #ff0000 will +be fontified with a red background." + :version "26.1" + :group 'css + :type 'boolean + :safe 'booleanp) + +(defun css--fontify-region (start end &optional loudly) + "Fontify a CSS buffer between START and END. +START and END are buffer positions." + (let ((extended-region (font-lock-default-fontify-region start end loudly))) + (when css-fontify-colors + (when (and (consp extended-region) + (eq (car extended-region) 'jit-lock-bounds)) + (setq start (cadr extended-region)) + (setq end (cddr extended-region))) + (save-excursion + (let ((case-fold-search t)) + (goto-char start) + (while (re-search-forward css--colors-regexp end t) + ;; Skip comments and strings. + (unless (nth 8 (syntax-ppss)) + (let* ((start (match-beginning 0)) + (color (css--compute-color start (match-string 0)))) + (when color + (with-silent-modifications + ;; Use the color as the background, to make it more + ;; clear. Use a contrasting color as the foreground, + ;; to make it readable. Finally, have a small box + ;; using the existing foreground color, to make sure + ;; it stands out a bit from any other text; in + ;; particular this is nice when the color matches the + ;; buffer's background color. + (add-text-properties + start (point) + (list 'face (list :background color + :foreground (css--contrasty-color color) + :box '(:line-width -1)))))))))))) + extended-region)) + (defcustom css-indent-offset 4 "Basic size of one indentation step." :version "22.2" @@ -1048,6 +1393,7 @@ pseudo-elements, pseudo-classes, at-rules, and bang-rules." :backward-token #'css-smie--backward-token) (setq-local electric-indent-chars (append css-electric-keys electric-indent-chars)) + (setq-local font-lock-fontify-region-function #'css--fontify-region) (add-hook 'completion-at-point-functions #'css-completion-at-point nil 'local)) @@ -1160,7 +1506,8 @@ pseudo-elements, pseudo-classes, at-rules, and bang-rules." (modify-syntax-entry ?/ ". 124" st) (modify-syntax-entry ?\n ">" st) ;; Variable names are prefixed by $. - (modify-syntax-entry ?$ "'" st) + (modify-syntax-entry ?$ "_" st) + (modify-syntax-entry ?% "_" st) st)) (defun scss-font-lock-keywords () diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index d601f43002..b4666ae72d 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -58,7 +58,7 @@ ;; Check that the `color' property doesn't cause infinite recursion ;; because it refers to the value class of the same name. - (should (= (length (css--property-values "color")) 147))) + (should (= (length (css--property-values "color")) 152))) (ert-deftest css-test-property-value-cache () "Test that `css--property-value-cache' is in use." @@ -234,5 +234,49 @@ (save-excursion (insert (nth 1 item))) (should (equal (nth 2 item) (css--mdn-find-symbol)))))) +(ert-deftest css-test-rgb-parser () + (with-temp-buffer + (css-mode) + (dolist (input '("255, 0, 127" + "255, /* comment */ 0, 127" + "255 0 127" + "255, 0, 127, 0.75" + "255 0 127 / 0.75" + "100%, 0%, 50%" + "100%, 0%, 50%, 0.115" + "100% 0% 50%" + "100% 0% 50% / 0.115")) + (erase-buffer) + (save-excursion + (insert input ")")) + (should (equal (css--rgb-color) "#ff007f"))))) + +(ert-deftest css-test-hsl-parser () + (with-temp-buffer + (css-mode) + (dolist (input '("0, 100%, 50%" + "0 100% 50%" + "0 /* two */ /* comments */100% 50%" + "0, 100%, 50%, 0.75" + "0 100% 50% / 0.75" + "0deg 100% 50%" + "360deg 100% 50%" + "0rad, 100%, 50%, 0.115" + "0grad, 100%, 50%, 0.115" + "1turn 100% 50% / 0.115")) + (erase-buffer) + (save-excursion + (insert input ")")) + (should (equal (css--hsl-color) "#ff0000"))))) + +(ert-deftest css-test-named-color () + (dolist (text '("@mixin black" "@include black")) + (with-temp-buffer + (insert text) + (should-not (css--named-color (save-excursion + (backward-word) + (point)) + "black"))))) + (provide 'css-mode-tests) ;;; css-mode-tests.el ends here commit a26e33a1a776affcbf8cdd012297d48999ba8e80 Author: Michael Albinus Date: Wed May 3 21:49:32 2017 +0200 Fix Bug#26763 * lisp/files.el (delete-directory): Call file name handler with `trash' argument. * lisp/net/ange-ftp.el (ange-ftp-delete-directory): * lisp/net/tramp-sh.el (tramp-sh-handle-delete-directory): Add TRASH arg. Implement it. (Bug#26763) (tramp-get-remote-trash): Check for `delete-by-moving-to-trash'. * lisp/net/tramp-adb.el (tramp-adb-handle-delete-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory): Add _TRASH arg. diff --git a/lisp/files.el b/lisp/files.el index 0978fa254f..d193749bb8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5477,7 +5477,7 @@ RECURSIVE if DIRECTORY is nonempty." (let ((handler (find-file-name-handler directory 'delete-directory))) (cond (handler - (funcall handler 'delete-directory directory recursive)) + (funcall handler 'delete-directory directory recursive trash)) ((and delete-by-moving-to-trash trash) ;; Only move non-empty dir to trash if recursive deletion was ;; requested. This mimics the non-`delete-by-moving-to-trash' diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index cd0ae8d420..7b8b3fc880 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4128,15 +4128,15 @@ directory, so that Emacs will know its current contents." (ange-ftp-add-file-entry dir t)) (ange-ftp-real-make-directory dir))))) -(defun ange-ftp-delete-directory (dir &optional recursive) +(defun ange-ftp-delete-directory (dir &optional recursive trash) (if (file-directory-p dir) (let ((parsed (ange-ftp-ftp-name dir))) (if recursive (mapc (lambda (file) (if (file-directory-p file) - (ange-ftp-delete-directory file recursive) - (delete-file file))) + (ange-ftp-delete-directory file recursive trash) + (delete-file file trash))) ;; We do not want to delete "." and "..". (directory-files dir 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) @@ -4170,7 +4170,7 @@ directory, so that Emacs will know its current contents." dir (cdr result)))) (ange-ftp-delete-file-entry dir t)) - (ange-ftp-real-delete-directory dir recursive))) + (ange-ftp-real-delete-directory dir recursive trash))) (error "Not a directory: %s" dir))) ;; Make a local copy of FILE and return its name. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 240e017279..a80bc0bdb2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -521,7 +521,7 @@ Emacs dired can't find files." (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-directory-property v localname))) -(defun tramp-adb-handle-delete-directory (directory &optional recursive) +(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash) "Like `delete-directory' for Tramp files." (setq directory (expand-file-name directory)) (with-parsed-tramp-file-name (file-truename directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 475f2b9a5d..71afb9aeb7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2566,7 +2566,7 @@ The method used must be an out-of-band method." (tramp-shell-quote-argument localname)) "Couldn't make directory %s" dir)))) -(defun tramp-sh-handle-delete-directory (directory &optional recursive) +(defun tramp-sh-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." (setq directory (expand-file-name directory)) (with-parsed-tramp-file-name directory nil @@ -2574,7 +2574,8 @@ The method used must be an out-of-band method." (tramp-flush-directory-property v localname) (tramp-barf-unless-okay v (format "cd / && %s %s" - (if recursive "rm -rf" "rmdir") + (or (and trash (tramp-get-remote-trash v)) + (if recursive "rm -rf" "rmdir")) (tramp-shell-quote-argument localname)) "Couldn't delete %s" directory))) @@ -5394,10 +5395,12 @@ Nonexistent directories are removed from spec." result)))) (defun tramp-get-remote-trash (vec) - "Determine remote `trash' command." - (with-tramp-connection-property vec "trash" - (tramp-message vec 5 "Finding a suitable `trash' command") - (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) + "Determine remote `trash' command. +This command is returned only if `delete-by-moving-to-trash' is non-nil." + (and delete-by-moving-to-trash + (with-tramp-connection-property vec "trash" + (tramp-message vec 5 "Finding a suitable `trash' command") + (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))) (defun tramp-get-remote-touch (vec) "Determine remote `touch' command." diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4205376d65..014e1e8601 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -617,7 +617,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-compat-file-attribute-modification-time (file-attributes filename)))))) -(defun tramp-smb-handle-delete-directory (directory &optional recursive) +(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash) "Like `delete-directory' for Tramp files." (setq directory (directory-file-name (expand-file-name directory))) (when (file-exists-p directory)