From c3df816585c6b8953fd4075cff894ec2d9ce0596 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Sep 2017 22:17:55 +0300 Subject: [PATCH 01/81] Fix compilation warning in etags.c * lib-src/etags.c (etags_mktmp) [DOS_NT]: Don't dereference a NULL pointer. Reported by Richard Copley . --- lib-src/etags.c | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lib-src/etags.c b/lib-src/etags.c index 4000f47a414..009cba528d7 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -7068,14 +7068,16 @@ etags_mktmp (void) errno = temp_errno; templt = NULL; } - #if defined (DOS_NT) - /* The file name will be used in shell redirection, so it needs to have - DOS-style backslashes, or else the Windows shell will barf. */ - char *p; - for (p = templt; *p; p++) - if (*p == '/') - *p = '\\'; + else + { + /* The file name will be used in shell redirection, so it needs to have + DOS-style backslashes, or else the Windows shell will barf. */ + char *p; + for (p = templt; *p; p++) + if (*p == '/') + *p = '\\'; + } #endif return templt; From 96aaeaaffac8a93d9c8126ba77ad217a3f323fce Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Sep 2017 22:25:13 +0300 Subject: [PATCH 02/81] ; * src/lcms.c: Minor stylistic changes in comments. --- src/lcms.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lcms.c b/src/lcms.c index cdfbc0ecf99..f543a030399 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -102,7 +102,7 @@ DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 5, 0, Each color is a list of L*a*b* coordinates, where the L* channel ranges from 0 to 100, and the a* and b* channels range from -128 to 128. Optional arguments KL, KC, KH are weighting parameters for lightness, -chroma, and hue, respectively. The parameters each default to 1. */) +chroma, and hue, respectively. The parameters each default to 1. */) (Lisp_Object color1, Lisp_Object color2, Lisp_Object kL, Lisp_Object kC, Lisp_Object kH) { @@ -163,7 +163,7 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. Each color is a list of XYZ coordinates, with Y scaled about unity. -Optional argument is the XYZ white point, which defaults to illuminant D65. */) +Optional argument is the XYZ white point, which defaults to illuminant D65. */) (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) { cmsViewingConditions vc; @@ -239,7 +239,7 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K. -Valid range of TEMPERATURE is from 4000K to 25000K. */) +Valid range of TEMPERATURE is from 4000K to 25000K. */) (Lisp_Object temperature) { cmsFloat64Number tempK; @@ -292,7 +292,7 @@ void syms_of_lcms2 (void) { DEFVAR_LISP ("lcms-d65-xyz", Vlcms_d65_xyz, - doc: /* D65 illuminant as a CIE XYZ triple. */); + doc: /* D65 illuminant as a CIE XYZ triple. */); Vlcms_d65_xyz = list3 (make_float (0.950455), make_float (1.0), make_float (1.088753)); From 546413e1ac5106113812d749178c73ed693331f2 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 16 Sep 2017 13:27:25 -0700 Subject: [PATCH 03/81] * test/src/lcms-tests.el (lcms-whitepoint): Skip if lcms2 not present. (cherry picked from commit 8081df26911c63aadfce4ee8f6a7223d814baeaf) --- test/src/lcms-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index e176cff2dc6..962902eb100 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -1,6 +1,6 @@ ;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -67,6 +67,7 @@ B is considered the exact value." (ert-deftest lcms-whitepoint () "Test use of `lcms-temp->white-point'." + (skip-unless (featurep 'lcms2)) (should-error (lcms-temp->white-point 3999)) (should-error (lcms-temp->white-point 25001)) ;; D55 From a726e09a9a89f85c78b65a96601110bca1a9983b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 16 Sep 2017 13:56:44 -0700 Subject: [PATCH 04/81] * test/src/lcms-tests.el (lcms-cri-cam02-ucs): Skip if lcms2 not present. --- test/src/lcms-tests.el | 1 + 1 file changed, 1 insertion(+) diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 962902eb100..3d0942c8d15 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -51,6 +51,7 @@ B is considered the exact value." (ert-deftest lcms-cri-cam02-ucs () "Test use of `lcms-cam02-ucs'." + (skip-unless (featurep 'lcms2)) (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error")) (should-error (lcms-cam02-ucs '(0 0 0) 'error)) (should-not From 1d599df5e0fbbc52e8592c0aff1d23e978c29b67 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 16 Sep 2017 20:10:31 -0400 Subject: [PATCH 05/81] Fix last change to textmodes/page-ext.el * lisp/textmodes/page-ext.el (pages-directory): Make buffer writable while we build it (bug#28431). --- lisp/textmodes/page-ext.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index d744bd2cf01..94b68decfb7 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -583,6 +583,7 @@ directory for only the accessible portion of the buffer." (with-output-to-temp-buffer pages-directory-buffer (with-current-buffer standard-output (pages-directory-mode) + (setq buffer-read-only nil) (insert "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n) (setq pages-buffer pages-target-buffer) @@ -631,6 +632,7 @@ directory for only the accessible portion of the buffer." ))))) (set-buffer standard-output) + (setq buffer-read-only t) ;; Put positions in increasing order to go with buffer. (setq pages-pos-list (nreverse pages-pos-list)) (if (called-interactively-p 'interactive) From 13aba24adde7e46382daa1e4f0aad194e5232b83 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 16 Sep 2017 12:30:36 -0600 Subject: [PATCH 06/81] Call vc-setup-buffer in vc-git-log-{in,out}going Bug#28427: * lisp/vc/vc-git.el (vc-git-log-incoming, vc-git-log-outgoing): Call vc-setup-buffer. --- lisp/vc/vc-git.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 095f184ddf1..9d7a4d49b8b 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1035,6 +1035,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-git-log-outgoing (buffer remote-location) (interactive) + (vc-setup-buffer buffer) (vc-git-command buffer 'async nil "log" @@ -1048,6 +1049,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-git-log-incoming (buffer remote-location) (interactive) + (vc-setup-buffer buffer) (vc-git-command nil 0 nil "fetch") (vc-git-command buffer 'async nil From 9d101376b42e51007e7f83b646e172c52251ae1e Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 9 Sep 2017 17:20:43 -0600 Subject: [PATCH 07/81] Allow smerge-keep-current to work for empty hunks Bug#25555 * lisp/vc/smerge-mode.el (smerge-get-current): Allow point to be at match-end. * test/lisp/vc/smerge-mode-tests.el: New file. --- lisp/vc/smerge-mode.el | 2 +- test/lisp/vc/smerge-mode-tests.el | 34 +++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 1 deletion(-) create mode 100644 test/lisp/vc/smerge-mode-tests.el diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 112a9bc5247..91be89b5dc1 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -725,7 +725,7 @@ this keeps \"UUU\"." (let ((i 3)) (while (or (not (match-end i)) (< (point) (match-beginning i)) - (>= (point) (match-end i))) + (> (point) (match-end i))) (cl-decf i)) i)) diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el new file mode 100644 index 00000000000..204a4b93ab5 --- /dev/null +++ b/test/lisp/vc/smerge-mode-tests.el @@ -0,0 +1,34 @@ +;; Copyright (C) 2017 Free Software Foundation, Inc + +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'smerge-mode) + +(ert-deftest smerge-mode-test-empty-hunk () + "Regression test for bug #25555" + (with-temp-buffer + (insert "<<<<<<< one\n") + (save-excursion + (insert "=======\nLLL\n>>>>>>> end\n")) + (smerge-mode) + (smerge-keep-current) + (should (equal (buffer-substring (point-min) (point-max)) "")))) + +(provide 'smerge-mode-tests) From 48d39c39e822a792f7c20254c3d9f94aa298be31 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 16 Sep 2017 21:46:17 -0600 Subject: [PATCH 08/81] Search for Syntax section when viewing MDN * lisp/textmodes/css-mode.el (css--mdn-after-render): Also search for "Syntax" section. --- lisp/textmodes/css-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index dde9e6a8d91..ce9bbf47e77 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1578,7 +1578,7 @@ to look up will be substituted there." (goto-char (point-min)) (let ((window (get-buffer-window (current-buffer) 'visible))) (when window - (when (re-search-forward "^Summary" nil 'move) + (when (re-search-forward "^\\(Summary\\|Syntax\\)" nil 'move) (beginning-of-line) (set-window-start window (point)))))) From 3003ac046900f9e7fdaa3161b99dbb1cc8f37b32 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 17 Sep 2017 10:03:18 +0200 Subject: [PATCH 09/81] Adapt Tramp version. Do not merge * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.3.26.1". (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 26.1. --- doc/misc/trampver.texi | 2 +- lisp/net/trampver.el | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 5d9dcc5635d..5151ed5354c 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.3-pre +@set trampver 2.3.3.26.1 @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 91222bd7817..318e3351237 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.3-pre +;; Version: 2.3.3.26.1 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.3-pre" +(defconst tramp-version "2.3.3.26.1" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.3-pre is not fit for %s" + (format "Tramp 2.3.3.26.1 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) @@ -69,7 +69,8 @@ ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") - ("2.2.13.25.2" . "25.3"))) + ("2.2.13.25.2" . "25.3") + ("2.3.3.26.1" . "26.1"))) (add-hook 'tramp-unload-hook (lambda () From 34a6774daa31872629c03505f75d737e0df9eacb Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Sun, 17 Sep 2017 08:27:57 -0400 Subject: [PATCH 10/81] ; Partially revert c3445aed5194 The pdf-view-mode entry had been added recently and should not have been removed. * lisp/net/mailcap.el: Restore pdf-view-mode entry from the pdf-tools package. --- lisp/net/mailcap.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index ed35c220ec5..031d8e1ff05 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -164,6 +164,10 @@ is consulted." (non-viewer . t) (type . "application/zip") ("copiousoutput")) + ("pdf" + (viewer . pdf-view-mode) + (type . "application/pdf") + (test . (eq window-system 'x))) ("pdf" (viewer . doc-view-mode) (type . "application/pdf") From 411bec82c427b238dc67a69637834d2b64566670 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 17 Sep 2017 19:50:43 +0300 Subject: [PATCH 11/81] Avoid GCC 7 compilation warning in eval.c * src/eval.c (push_handler_nosignal): Use CACHEABLE to work around GCC compilation warning. Suggested by Paul Eggert in http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00492.html. --- src/eval.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/eval.c b/src/eval.c index 62e219631db..39d78364d5f 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1428,7 +1428,7 @@ push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype) struct handler * push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) { - struct handler *c = handlerlist->nextfree; + struct handler *CACHEABLE c = handlerlist->nextfree; if (!c) { c = malloc (sizeof *c); From 57249fb297237bb942ead1f7a0af0ac20811a9cf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 17 Sep 2017 19:16:59 +0200 Subject: [PATCH 12/81] Fix compatibility problem in Tramp * lisp/net/tramp.el (tramp-interrupt-process): Better error handling. * lisp/net/tramp-compat.el (default-toplevel-value): Move up. (top): Do not call `tramp-change-syntax' anymore. (tramp-compat-directory-name-p): New defalias. * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file): Use it. * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process): Modify test. --- lisp/net/tramp-adb.el | 2 +- lisp/net/tramp-compat.el | 33 ++++++++++++++++++++------------- lisp/net/tramp-sh.el | 2 +- lisp/net/tramp-smb.el | 4 ++-- lisp/net/tramp.el | 21 +++++++++++---------- test/lisp/net/tramp-tests.el | 7 ++----- 6 files changed, 37 insertions(+), 32 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c22869d2cc2..760d020f672 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Remote newname. (when (and (file-directory-p newname) - (directory-name-p newname)) + (tramp-compat-directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 5d9a1fd1967..214ad040a17 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,8 +23,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 26. This -;; package provides compatibility functions for Emacs 24 and Emacs 25. +;; Tramp's main Emacs version for development is Emacs 27. This +;; package provides compatibility functions for Emacs 24, Emacs 25 and +;; Emacs 26. ;;; Code: @@ -104,6 +105,10 @@ Add the extension of F, if existing." 'tramp-error vec-or-proc (if (fboundp 'user-error) 'user-error 'error) format args)) +;; `default-toplevel-value' has been declared in Emacs 24.4. +(unless (fboundp 'default-toplevel-value) + (defalias 'default-toplevel-value 'symbol-value)) + ;; `file-attribute-*' are introduced in Emacs 25.1. (if (fboundp 'file-attribute-type) @@ -163,14 +168,23 @@ This is a floating point number if the size is too large for an integer." This is a string of ten letters or dashes as in ls -l." (nth 8 attributes))) -;; `default-toplevel-value' has been declared in Emacs 24.4. -(unless (fboundp 'default-toplevel-value) - (defalias 'default-toplevel-value 'symbol-value)) - ;; `format-message' is new in Emacs 25.1. (unless (fboundp 'format-message) (defalias 'format-message 'format)) +;; `directory-name-p' is new in Emacs 25.1. +(if (fboundp 'directory-name-p) + (defalias 'tramp-compat-directory-name-p 'directory-name-p) + (defsubst tramp-compat-directory-name-p (name) + "Return non-nil if NAME ends with a directory separator character." + (let ((len (length name)) + (lastc ?.)) + (if (> len 0) + (setq lastc (aref name (1- len)))) + (or (= lastc ?/) + (and (memq system-type '(windows-nt ms-dos)) + (= lastc ?\\)))))) + ;; `file-missing' is introduced in Emacs 26.1. (defconst tramp-file-missing (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) @@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is unquoted." ((eq tramp-syntax 'sep) 'separate) (t tramp-syntax))) -;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'. -(eval-after-load 'tramp - '(unless - (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values))) - (tramp-compat-funcall - (quote tramp-change-syntax) (tramp-compat-tramp-syntax)))) - (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7df5aa3b7b0..5f145d4fae1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1985,7 +1985,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" ;; scp or rsync DTRT. (progn (when (and (file-directory-p newname) - (not (directory-name-p newname))) + (not (tramp-compat-directory-name-p newname))) (tramp-error v 'file-already-exists newname)) (setq dirname (directory-file-name (expand-file-name dirname)) newname (directory-file-name (expand-file-name newname))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 49695666707..ee6baaab121 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -415,7 +415,7 @@ pass to the OPERATION." (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) (when (and (file-directory-p newname) - (not (directory-name-p newname))) + (not (tramp-compat-directory-name-p newname))) (tramp-error v 'file-already-exists newname)) (cond ;; We must use a local temporary directory. @@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Remote newname. (when (and (file-directory-p newname) - (directory-name-p newname)) + (tramp-compat-directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 45776078be3..07c06808bb2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4547,16 +4547,17 @@ Only works for Bourne-like shells." (t process))) pid) ;; If it's a Tramp process, send the INT signal remotely. - (when (and (processp proc) (process-live-p proc) - (setq pid (process-get proc 'remote-pid))) - (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) - ;; This is for tramp-sh.el. Other backends do not support this (yet). - (tramp-compat-funcall - 'tramp-send-command - (tramp-get-connection-property proc "vector" nil) - (format "kill -2 %d" pid)) - ;; Report success. - proc))) + (when (and (processp proc) (setq pid (process-get proc 'remote-pid))) + (if (not (process-live-p proc)) + (tramp-error proc 'error "Process %s is not active" proc) + (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) + ;; This is for tramp-sh.el. Other backends do not support this (yet). + (tramp-compat-funcall + 'tramp-send-command + (tramp-get-connection-property proc "vector" nil) + (format "kill -2 %d" pid)) + ;; Report success. + proc)))) ;; `interrupt-process-functions' exists since Emacs 26.1. (when (boundp 'interrupt-process-functions) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e8515302c00..88e97092ed7 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3193,15 +3193,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (processp proc)) (should (process-live-p proc)) (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) (should (interrupt-process proc)) ;; Let the process accept the interrupt. (accept-process-output proc 1 nil 0) (should-not (process-live-p proc)) - (should (equal (process-status proc) 'signal)) ;; An interrupted process cannot be interrupted, again. - ;; Does not work reliable. - ;; (should-error (interrupt-process proc) :type 'error)) - ) + (should-error (interrupt-process proc) :type 'error)) ;; Cleanup. (ignore-errors (delete-process proc))))) @@ -3477,7 +3475,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; TODO: This test fails. (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (let* ((default-directory tramp-test-temporary-file-directory) (tmp-name1 (tramp--test-make-temp-name nil quoted)) From 6bbbc38b3421723521f7cdd4fd617a4fc889aceb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 12:56:00 -0700 Subject: [PATCH 13/81] Merge from Gnulib This incorporates: 2017-09-16 manywarnings: port to GCC on 64-bit MS-Windows 2017-09-13 all: Replace many more http URLs by https URLs * build-aux/config.guess, build-aux/config.sub: * build-aux/gitlog-to-changelog, doc/misc/texinfo.tex: * lib/allocator.h, lib/count-leading-zeros.h: * lib/count-trailing-zeros.h, lib/dup2.c, lib/filevercmp.c: * lib/fstatat.c, lib/fsync.c, lib/ftoastr.c, lib/ftoastr.h: * lib/intprops.h, lib/signal.in.h, lib/stdio-impl.h, lib/stdio.in.h: * lib/unistd.in.h, lib/utimens.c, m4/alloca.m4, m4/extern-inline.m4: * m4/fstatat.m4, m4/gnulib-common.m4, m4/manywarnings.m4: * m4/std-gnu11.m4, m4/sys_types_h.m4, m4/vararrays.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. --- build-aux/config.guess | 38 +++++------------------------------ build-aux/config.sub | 20 +++++++++--------- build-aux/gitlog-to-changelog | 2 +- doc/misc/texinfo.tex | 14 ++++++------- lib/allocator.h | 2 +- lib/count-leading-zeros.h | 3 ++- lib/count-trailing-zeros.h | 3 ++- lib/dup2.c | 2 +- lib/filevercmp.c | 2 +- lib/fstatat.c | 2 +- lib/fsync.c | 4 ++-- lib/ftoastr.c | 2 +- lib/ftoastr.h | 2 +- lib/gnulib.mk.in | 1 + lib/intprops.h | 6 +++--- lib/signal.in.h | 2 +- lib/stdio-impl.h | 10 ++++----- lib/stdio.in.h | 4 ++-- lib/unistd.in.h | 4 ++-- lib/utimens.c | 10 ++++----- m4/alloca.m4 | 4 ++-- m4/extern-inline.m4 | 8 ++++---- m4/fstatat.m4 | 2 +- m4/gnulib-common.m4 | 6 +++--- m4/manywarnings.m4 | 17 ++++++++++------ m4/std-gnu11.m4 | 4 ++-- m4/sys_types_h.m4 | 2 +- m4/vararrays.m4 | 2 +- 28 files changed, 79 insertions(+), 99 deletions(-) diff --git a/build-aux/config.guess b/build-aux/config.guess index a7448442748..8bd1095f112 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-08-08' +timestamp='2017-09-16' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -15,7 +15,7 @@ timestamp='2017-08-08' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, see . +# along with this program; if not, see . # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a @@ -27,7 +27,7 @@ timestamp='2017-08-08' # Originally written by Per Bothner; maintained since 2000 by Ben Elliston. # # You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess +# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess # # Please send patches to . @@ -318,15 +318,6 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in exitcode=$? trap '' 0 exit $exitcode ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; @@ -858,10 +849,6 @@ EOF *:MSYS*:*) echo ${UNAME_MACHINE}-pc-msys exit ;; - i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 - exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; @@ -877,27 +864,12 @@ EOF echo ia64-unknown-interix${UNAME_RELEASE} exit ;; esac ;; - [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) - echo i${UNAME_MACHINE}-pc-mks - exit ;; - 8664:Windows_NT:*) - echo x86_64-pc-mks - exit ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i586-pc-interix - exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; @@ -1435,9 +1407,9 @@ This script (version $timestamp), has failed to recognize the operating system you are using. If your script is old, overwrite *all* copies of config.guess and config.sub with the latest versions from: - http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess + https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess and - http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub + https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub If $0 has already been updated, send the following data and any information you think might be pertinent to config-patches@gnu.org to diff --git a/build-aux/config.sub b/build-aux/config.sub index 40ea5dfe115..95dc3d07248 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-04-02' +timestamp='2017-09-16' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -15,7 +15,7 @@ timestamp='2017-04-02' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, see . +# along with this program; if not, see . # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a @@ -33,7 +33,7 @@ timestamp='2017-04-02' # Otherwise, we print the canonical config type on stdout and succeed. # You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub +# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases @@ -229,9 +229,6 @@ case $os in -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; -psos*) os=-psos ;; @@ -1259,6 +1256,9 @@ case $basic_machine in basic_machine=hppa1.1-winbond os=-proelf ;; + x64) + basic_machine=x86_64-pc + ;; xbox) basic_machine=i686-pc os=-mingw32 @@ -1366,8 +1366,8 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases that might get confused + # with valid system types. # -solaris* is a basic system type, with this one exception. -auroraux) os=-auroraux @@ -1387,9 +1387,9 @@ case $os in -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; - # First accept the basic system types. + # Now accept the basic system types. # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. + # Each alternative MUST end in a * to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index ec5ab9e141c..3c94bd56a0b 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -33,7 +33,7 @@ use POSIX qw(strftime); (my $ME = $0) =~ s|.*/||; -# use File::Coda; # http://meyering.net/code/Coda/ +# use File::Coda; # https://meyering.net/code/Coda/ END { defined fileno STDOUT or return; close STDOUT and return; diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index a774790c511..9bd75b91e46 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2017-08-23.19} +\def\texinfoversion{2017-09-16.10} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -21,7 +21,7 @@ % General Public License for more details. % % You should have received a copy of the GNU General Public License -% along with this program. If not, see . +% along with this program. If not, see . % % As a special exception, when this file is read by TeX when processing % a Texinfo source document, you may use the result without @@ -30,9 +30,9 @@ % % Please try the latest version of texinfo.tex before submitting bug % reports; you can get the latest version from: -% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or -% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or -% http://www.gnu.org/software/texinfo/ (the Texinfo home page) +% https://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or +% https://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or +% https://www.gnu.org/software/texinfo/ (the Texinfo home page) % The texinfo.tex in any given distribution could well be out % of date, so if that's what you're using, please check. % @@ -56,7 +56,7 @@ % extent. You can get the existing language-specific files from the % full Texinfo distribution. % -% The GNU Texinfo home page is http://www.gnu.org/software/texinfo. +% The GNU Texinfo home page is https://www.gnu.org/software/texinfo. \message{Loading texinfo [version \texinfoversion]:} @@ -9446,7 +9446,7 @@ end \newif\ifwarnednoepsf \newhelp\noepsfhelp{epsf.tex must be installed for images to work. It is also included in the Texinfo distribution, or you can get - it from ftp://tug.org/tex/epsf.tex.} + it from https://ctan.org/texarchive/macros/texinfo/texinfo/doc/epsf.tex.} % \def\image#1{% \ifx\epsfbox\thisisundefined diff --git a/lib/allocator.h b/lib/allocator.h index 2ecbf1a3795..8f79d7435c3 100644 --- a/lib/allocator.h +++ b/lib/allocator.h @@ -29,7 +29,7 @@ struct allocator /* Do not use GCC attributes such as __attribute__ ((malloc)) with the function types pointed at by these members, because these attributes do not work with pointers to functions. See - . */ + . */ /* Call ALLOCATE to allocate memory, like 'malloc'. On failure ALLOCATE should return NULL, though not necessarily set errno. When given diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 1b60e28e7ff..c8b3dc05110 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -70,7 +70,8 @@ _GL_INLINE_HEADER_BEGIN COUNT_LEADING_ZEROS_INLINE int count_leading_zeros_32 (unsigned int x) { - /* http://graphics.stanford.edu/~seander/bithacks.html */ + /* + */ static const char de_Bruijn_lookup[32] = { 31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1, 23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0 diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index be7131429c1..9f9f07f5a0d 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -68,7 +68,8 @@ _GL_INLINE_HEADER_BEGIN COUNT_TRAILING_ZEROS_INLINE int count_trailing_zeros_32 (unsigned int x) { - /* http://graphics.stanford.edu/~seander/bithacks.html */ + /* + */ static const char de_Bruijn_lookup[32] = { 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 diff --git a/lib/dup2.c b/lib/dup2.c index b89f83732fe..85c1a44401a 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -88,7 +88,7 @@ ms_windows_dup2 (int fd, int desired_fd) } /* Wine 1.0.1 return 0 when desired_fd is negative but not -1: - http://bugs.winehq.org/show_bug.cgi?id=21289 */ + https://bugs.winehq.org/show_bug.cgi?id=21289 */ if (desired_fd < 0) { errno = EBADF; diff --git a/lib/filevercmp.c b/lib/filevercmp.c index 56c9821e364..4026097b38e 100644 --- a/lib/filevercmp.c +++ b/lib/filevercmp.c @@ -79,7 +79,7 @@ order (unsigned char c) specification can be found in the Debian Policy Manual in the section on the 'Version' control field. This version of the code implements that from s5.6.12 of Debian Policy v3.8.0.1 - http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */ + https://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */ static int _GL_ATTRIBUTE_PURE verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len) { diff --git a/lib/fstatat.c b/lib/fstatat.c index d09add037fa..67e48d95d71 100644 --- a/lib/fstatat.c +++ b/lib/fstatat.c @@ -111,7 +111,7 @@ stat_func (char const *name, struct stat *st) # endif /* Replacement for Solaris' function by the same name. - + First, try to simulate it via l?stat ("/proc/self/fd/FD/FILE"). Failing that, simulate it via save_cwd/fchdir/(stat|lstat)/restore_cwd. If either the save_cwd or the restore_cwd fails (relatively unlikely), diff --git a/lib/fsync.c b/lib/fsync.c index a52e6642f91..c25f1db6575 100644 --- a/lib/fsync.c +++ b/lib/fsync.c @@ -2,8 +2,8 @@ cross-compilers like MinGW. This is derived from sqlite3 sources. - http://www.sqlite.org/cvstrac/rlog?f=sqlite/src/os_win.c - http://www.sqlite.org/copyright.html + https://www.sqlite.org/src/finfo?name=src/os_win.c + https://www.sqlite.org/copyright.html Written by Richard W.M. Jones diff --git a/lib/ftoastr.c b/lib/ftoastr.c index 029e797b796..bcc79f03673 100644 --- a/lib/ftoastr.c +++ b/lib/ftoastr.c @@ -108,7 +108,7 @@ FTOASTR (char *buf, size_t bufsize, int flags, int width, FLOAT x) Andrysco M, Jhala R, Lerner S. Printing floating-point numbers: a faster, always correct method. ACM SIGPLAN notices - POPL '16. 2016;51(1):555-67 ; draft at - . */ + . */ PROMOTED_FLOAT promoted_x = x; char format[sizeof "%-+ 0*.*Lg"]; diff --git a/lib/ftoastr.h b/lib/ftoastr.h index 3ee05a30335..f73712c9415 100644 --- a/lib/ftoastr.h +++ b/lib/ftoastr.h @@ -96,7 +96,7 @@ enum DIG digits. For why the "+ 1" is needed, see "Binary to Decimal Conversion" in David Goldberg's paper "What Every Computer Scientist Should Know About Floating-Point Arithmetic" - . */ + . */ # define _GL_FLOAT_PREC_BOUND(dig) \ (INT_BITS_STRLEN_BOUND ((dig) * _GL_FLOAT_DIG_BITS_BOUND) + 1) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 9500871b162..d8afec40bc6 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -558,6 +558,7 @@ LIBGPM = @LIBGPM@ LIBHESIOD = @LIBHESIOD@ LIBINTL = @LIBINTL@ LIBJPEG = @LIBJPEG@ +LIBLCMS2 = @LIBLCMS2@ LIBMODULES = @LIBMODULES@ LIBOBJS = @LIBOBJS@ LIBOTF_CFLAGS = @LIBOTF_CFLAGS@ diff --git a/lib/intprops.h b/lib/intprops.h index 400ba5b9123..a34e81c7b5e 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -26,7 +26,7 @@ #define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) /* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see - . */ + . */ #define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v)) /* The extra casts in the following macros work around compiler bugs, @@ -179,7 +179,7 @@ /* Return 1 if A * B would overflow in [MIN,MAX] arithmetic. See above for restrictions. Avoid && and || as they tickle bugs in Sun C 5.11 2010/08/13 and other compilers; see - . */ + . */ #define INT_MULTIPLY_RANGE_OVERFLOW(a, b, min, max) \ ((b) < 0 \ ? ((a) < 0 \ @@ -443,7 +443,7 @@ implementation-defined result or signal for values outside T's range. However, code that works around this theoretical problem runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: - http://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html + https://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html As the compiler bug is real, don't try to work around the theoretical problem. */ diff --git a/lib/signal.in.h b/lib/signal.in.h index 1d8ebfa57e7..9c32b14962f 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -200,7 +200,7 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1]; /* When also using extern inline, suppress the use of static inline in standard headers of problematic Apple configurations, as Libc at least through Libc-825.26 (2013-04-09) mishandles it; see, e.g., - . + . Perhaps Apple will fix this some day. */ #if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \ && (defined __i386__ || defined __x86_64__)) diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 0d606c19c84..8960333687e 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -32,7 +32,7 @@ /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin, Minix 3, Android */ # if defined __DragonFly__ /* DragonFly */ - /* See . */ + /* See . */ # define fp_ ((struct { struct __FILE_public pub; \ struct { unsigned char *_base; int _size; } _bf; \ void *cookie; \ @@ -49,7 +49,7 @@ fpos_t _offset; \ /* More fields, not relevant here. */ \ } *) fp) - /* See . */ + /* See . */ # define _p pub._p # define _flags pub._flags # define _r pub._r @@ -60,7 +60,7 @@ # if (defined __NetBSD__ && __NetBSD_Version__ >= 105270000) || defined __OpenBSD__ || defined __minix || defined __ANDROID__ /* NetBSD >= 1.5ZA, OpenBSD, Minix 3, Android */ /* See - and */ + and */ struct __sfileext { struct __sbuf _ub; /* ungetc buffer */ @@ -81,7 +81,7 @@ #ifdef __TANDEM /* NonStop Kernel */ # ifndef _IOERR /* These values were determined by the program 'stdioext-flags' at - . */ + . */ # define _IOERR 0x40 # define _IOREAD 0x80 # define _IOWRT 0x4 @@ -132,7 +132,7 @@ struct _gl_real_FILE # define fp_ ((struct _gl_real_FILE *) fp) /* These values were determined by a program similar to the one at - . */ + . */ # define _IOREAD 0x1 # define _IOWRT 0x2 # define _IORW 0x4 diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 5cf31319d9f..066e08eba9a 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -152,7 +152,7 @@ /* When also using extern inline, suppress the use of static inline in standard headers of problematic Apple configurations, as Libc at least through Libc-825.26 (2013-04-09) mishandles it; see, e.g., - . + . Perhaps Apple will fix this some day. */ #if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \ && defined __GNUC__ && defined __STDC__) @@ -610,7 +610,7 @@ _GL_CXXALIAS_SYS (fwrite, size_t, (const void *ptr, size_t s, size_t n, FILE *stream)); /* Work around bug 11959 when fortifying glibc 2.4 through 2.15 - , + , which sometimes causes an unwanted diagnostic for fwrite calls. This affects only function declaration attributes under certain versions of gcc and clang, and is not needed for C++. */ diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 8a383b3d016..c1dd07ff8cd 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -379,7 +379,7 @@ _GL_WARN_ON_USE (dup2, "dup2 is unportable - " Close NEWFD first if it is open. Return newfd if successful, otherwise -1 and errno set. See the Linux man page at - . */ + . */ # if @HAVE_DUP3@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define dup3 rpl_dup3 @@ -1149,7 +1149,7 @@ _GL_WARN_ON_USE (pipe, "pipe is unportable - " Store the read-end as fd[0] and the write-end as fd[1]. Return 0 upon success, or -1 with errno set upon failure. See also the Linux man page at - . */ + . */ # if @HAVE_PIPE2@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define pipe2 rpl_pipe2 diff --git a/lib/utimens.c b/lib/utimens.c index a5716ac8105..55545e8ce9b 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -196,7 +196,7 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) /* Some Linux-based NFS clients are buggy, and mishandle timestamps of files in NFS file systems in some cases. We have no configure-time test for this, but please see - for references to + for references to some of the problems with Linux 2.6.16. If this affects you, compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to help in some cases, albeit at a cost in performance. But you @@ -250,8 +250,8 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) result = utimensat (AT_FDCWD, file, ts, 0); # ifdef __linux__ /* Work around a kernel bug: - http://bugzilla.redhat.com/442352 - http://bugzilla.redhat.com/449910 + https://bugzilla.redhat.com/show_bug.cgi?id=442352 + https://bugzilla.redhat.com/show_bug.cgi?id=449910 It appears that utimensat can mistakenly return 280 rather than -1 upon ENOSYS failure. FIXME: remove in 2010 or whenever the offending kernels @@ -566,8 +566,8 @@ lutimens (char const *file, struct timespec const timespec[2]) result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW); # ifdef __linux__ /* Work around a kernel bug: - http://bugzilla.redhat.com/442352 - http://bugzilla.redhat.com/449910 + https://bugzilla.redhat.com/show_bug.cgi?id=442352 + https://bugzilla.redhat.com/show_bug.cgi?id=449910 It appears that utimensat can mistakenly return 280 rather than -1 upon ENOSYS failure. FIXME: remove in 2010 or whenever the offending kernels diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 7f0604cbdac..d1224316498 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -44,12 +44,12 @@ AC_DEFUN([gl_FUNC_ALLOCA], AC_DEFUN([gl_PREREQ_ALLOCA], [:]) # This works around a bug in autoconf <= 2.68. -# See . +# See . m4_version_prereq([2.69], [] ,[ # This is taken from the following Autoconf patch: -# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 +# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497 # _AC_LIBOBJ_ALLOCA # ----------------- diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 index 00f960968b0..c08af18af68 100644 --- a/m4/extern-inline.m4 +++ b/m4/extern-inline.m4 @@ -11,7 +11,7 @@ AC_DEFUN([gl_EXTERN_INLINE], [/* Please see the Gnulib manual for how to use these macros. Suppress extern inline with HP-UX cc, as it appears to be broken; see - . + . Suppress extern inline with Sun C in standards-conformance mode, as it mishandles inline functions that call each other. E.g., for 'inline void f @@ -28,16 +28,16 @@ AC_DEFUN([gl_EXTERN_INLINE], from calling static functions. This bug is known to occur on: OS X 10.8 and earlier; see: - http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html + https://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html DragonFly; see http://muscles.dragonflybsd.org/bulk/bleeding-edge-potential/latest-per-pkg/ah-tty-0.3.12.log FreeBSD; see: - http://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html + https://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and - for clang but remains for g++; see . + for clang but remains for g++; see . Assume DragonFly and FreeBSD will be similar. */ #if (((defined __APPLE__ && defined __MACH__) \ || defined __DragonFly__ || defined __FreeBSD__) \ diff --git a/m4/fstatat.m4 b/m4/fstatat.m4 index 75cf0110401..b29ec9258e9 100644 --- a/m4/fstatat.m4 +++ b/m4/fstatat.m4 @@ -20,7 +20,7 @@ AC_DEFUN([gl_FUNC_FSTATAT], HAVE_FSTATAT=0 else dnl Test for an AIX 7.1 bug; see - dnl . + dnl . AC_CACHE_CHECK([whether fstatat (..., 0) works], [gl_cv_func_fstatat_zero_flag], [AC_RUN_IFELSE( diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 36f2acc5539..36da841287d 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -228,13 +228,13 @@ m4_ifndef([AS_VAR_IF], # This is like AC_PROG_CC_C99, except that # - AC_PROG_CC_C99 did not exist in Autoconf versions < 2.60, # - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC -# , +# , # but many more packages use AC_PROG_CC_STDC than AC_PROG_CC_C99 -# . +# . # Remaining problems: # - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options # to CC twice -# . +# . # - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard. AC_DEFUN([gl_PROG_CC_C99], [ diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index eb89325519c..d10bcd08a0e 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 12 +# manywarnings.m4 serial 13 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -267,18 +267,23 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], # gcc --help=warnings outputs an unusual form for these options; list # them here so that the above 'comm' command doesn't report a false match. - # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal - # and AC_COMPUTE_INT requires it to fit in a long: + # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal. + # Also, AC_COMPUTE_INT requires it to fit in a long; it is 2**63 on + # the only platforms where it does not fit in a long, so make that + # a special case. AC_MSG_CHECKING([max safe object size]) AC_COMPUTE_INT([gl_alloc_max], - [(LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) < (size_t) -1 - ? (LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) - : (size_t) -1], + [LONG_MAX < (PTRDIFF_MAX < (size_t) -1 ? PTRDIFF_MAX : (size_t) -1) + ? -1 + : PTRDIFF_MAX < (size_t) -1 ? (long) PTRDIFF_MAX : (long) (size_t) -1], [[#include #include #include ]], [gl_alloc_max=2147483647]) + case $gl_alloc_max in + -1) gl_alloc_max=9223372036854775807;; + esac AC_MSG_RESULT([$gl_alloc_max]) gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max" gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2" diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4 index bd34aa1a268..3c2f26f4666 100644 --- a/m4/std-gnu11.m4 +++ b/m4/std-gnu11.m4 @@ -369,7 +369,7 @@ dnl just the module. Instead, define the (private) symbol dnl _STDC_C99, which suppresses a bogus failure in . dnl The resulting compiler passes the test case here, and that's dnl good enough. For more, please see the thread starting at: -dnl http://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html +dnl https://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html dnl Tru64 -c99 dnl with extended modes being tried first. [[-std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99]], [$1], [$2])[]dnl @@ -458,7 +458,7 @@ dnl preferably extc11. # -------------- # Do not use AU_ALIAS here and in AC_PROG_CC_C99 and AC_PROG_CC_STDC, # as that'd be incompatible with how Automake redefines AC_PROG_CC. See -# . +# . AU_DEFUN([AC_PROG_CC_C89], [AC_REQUIRE([AC_PROG_CC])], [$0 is obsolete; use AC_PROG_CC] diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4 index 34224d7705d..06268cfb2db 100644 --- a/m4/sys_types_h.m4 +++ b/m4/sys_types_h.m4 @@ -40,7 +40,7 @@ AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS], m4_version_prereq([2.70], [], [ # This is taken from the following Autoconf patch: -# https://git.sv.gnu.org/cgit/autoconf.git/commit/?id=e17a30e98 +# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=e17a30e987d7ee695fb4294a82d987ec3dc9b974 m4_undefine([AC_HEADER_MAJOR]) AC_DEFUN([AC_HEADER_MAJOR], diff --git a/m4/vararrays.m4 b/m4/vararrays.m4 index 8391121ad3f..38a3ed23542 100644 --- a/m4/vararrays.m4 +++ b/m4/vararrays.m4 @@ -27,7 +27,7 @@ AC_DEFUN([AC_C_VARARRAYS], [[/* Test for VLA support. This test is partly inspired from examples in the C standard. Use at least two VLA functions to detect the GCC 3.4.3 bug described in: - http://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html + https://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html */ #ifdef __STDC_NO_VLA__ syntax error; From 37b5e661d298cbfe51422cd515b6696a1cdaa868 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 12:56:00 -0700 Subject: [PATCH 14/81] Fix recently-introduced copy-directory bug Problem reported by Andrew Christianson (Bug#28451): * lisp/files.el (copy-directory): If COPY-CONTENTS, make the destination directory if it does not exist, even if it is a directory name. Simplify, and omit unnecessary test for an already-existing non-directory target, since make-directory diagnoses that for us now. * test/lisp/files-tests.el (files-tests--copy-directory): Test for this bug. --- lisp/files.el | 20 +++++++++----------- test/lisp/files-tests.el | 11 +++++++++++ 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index c55c8097c16..133fed90c34 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5372,7 +5372,7 @@ raised." (while (progn (setq parent (directory-file-name (file-name-directory dir))) - (condition-case err + (condition-case () (files--ensure-directory dir) (file-missing ;; Do not loop if root does not exist (Bug#2309). @@ -5544,16 +5544,14 @@ into NEWNAME instead." ;; If NEWNAME is not a directory name, create it; ;; that is where we will copy the files of DIRECTORY. (make-directory newname parents)) - ;; If NEWNAME is a directory name and COPY-CONTENTS - ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. - ((not copy-contents) - (setq newname (concat newname - (file-name-nondirectory directory))) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t))) + ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil, + ;; create NEWNAME if it is not already a directory; + ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME]. + ((if copy-contents + (or parents (not (file-directory-p newname))) + (setq newname (concat newname + (file-name-nondirectory directory)))) + (make-directory (directory-file-name newname) parents))) ;; Copy recursively. (dolist (file diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index ef216c3f34a..3117ea697ec 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -393,5 +393,16 @@ name (Bug#28412)." (should (null (save-buffer))) (should (eq (buffer-size) 1)))))) +(ert-deftest files-tests--copy-directory () + (let* ((dir (make-temp-file "files-mkdir-test" t)) + (dirname (file-name-as-directory dir)) + (source (concat dirname "source")) + (dest (concat dirname "dest/new/directory/")) + (file (concat (file-name-as-directory source) "file"))) + (make-directory source) + (write-region "" nil file) + (copy-directory source dest t t t) + (should (file-exists-p (concat dest "file"))))) + (provide 'files-tests) ;;; files-tests.el ends here From 5f28f0db73c03b98b27e04a458ebb209b5d9acde Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 15:25:44 -0700 Subject: [PATCH 15/81] Fix bug with min and max and NaNs * src/data.c (minmax_driver): Fix bug with (min 0 NaN), which mistakenly yielded 0. Also, pacify GCC in a better way. * test/src/data-tests.el (data-tests-min): Test for the bug. --- src/data.c | 12 ++++++------ test/src/data-tests.el | 6 +++++- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/data.c b/src/data.c index 95bf06e5102..e070be6c208 100644 --- a/src/data.c +++ b/src/data.c @@ -3010,16 +3010,16 @@ static Lisp_Object minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { - eassume (0 < nargs); - Lisp_Object accum = args[0]; /* pacify GCC */ - for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) + Lisp_Object accum = args[0]; + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (accum); + for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { Lisp_Object val = args[argnum]; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); - if (argnum == 0 || !NILP (arithcompare (val, accum, comparison))) + if (!NILP (arithcompare (val, accum, comparison))) accum = val; - else if (FLOATP (accum) && isnan (XFLOAT_DATA (accum))) - return accum; + else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) + return val; } return accum; } diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 5dc26348a6f..8de8c145d40 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -101,7 +101,11 @@ (should (= 3 (apply #'min '(3 8 3)))) (should-error (min 9 8 'foo)) (should-error (min (make-marker))) - (should (eql 1 (min (point-min-marker) 1)))) + (should (eql 1 (min (point-min-marker) 1))) + (should (isnan (min 0.0e+NaN))) + (should (isnan (min 0.0e+NaN 1 2))) + (should (isnan (min 1.0 0.0e+NaN))) + (should (isnan (min 1.0 0.0e+NaN 1.1)))) ;; Bool vector tests. Compactly represent bool vectors as hex ;; strings. From 4e8888d4383bf6fd87af6d45b6855494edf87a2d Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Sun, 17 Sep 2017 19:37:08 -0400 Subject: [PATCH 16/81] Use doc-view or pdf-tools on any window-system * lisp/net/mailcap.el (mailcap-mime-data): Simply check for window-system. --- lisp/net/mailcap.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 031d8e1ff05..86587466ef5 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -167,11 +167,11 @@ is consulted." ("pdf" (viewer . pdf-view-mode) (type . "application/pdf") - (test . (eq window-system 'x))) + (test . window-system)) ("pdf" (viewer . doc-view-mode) (type . "application/pdf") - (test . (eq window-system 'x))) + (test . window-system)) ("pdf" (viewer . "gv -safer %s") (type . "application/pdf") From 679e05eeb97eae5a32fc67f4673b019c873ebcca Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 17:46:18 -0700 Subject: [PATCH 17/81] message-citation-line-format %Z is now tz name * etc/NEWS: * lisp/gnus/message.el (message-citation-line-format): Fix doc to match new behavior (Bug#28476). --- etc/NEWS | 6 ++++++ lisp/gnus/message.el | 1 - 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index a042ce92aff..5aa57a77765 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -701,6 +701,12 @@ method is an NNTP select method. *** A new command for sorting articles by readedness marks has been added: 'C-c C-s C-m C-m'. ++++ + +*** In message-citation-line-format the %Z format is now the time zone name +instead of the numeric form. The %z format continues to be the +numeric form. The new behavior is compatible with format-time-string. + ** Ibuffer --- diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 690dd28c8a4..a9e66cede16 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -991,7 +991,6 @@ are replaced: %F The first name if present, e.g.: \"John\", else fall back to the mail address. %L The last name if present, e.g.: \"Doe\". - %Z, %z The time zone in the numeric form, e.g.:\"+0000\". All other format specifiers are passed to `format-time-string' which is called using the date from the article your replying to, but From 541006c53623cb5fb7dfae475baae5d64fc6e9d0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 20:38:12 -0700 Subject: [PATCH 18/81] Fix format-time-string %Z bug with negative tz * src/editfns.c (tzlookup): Fix sign error in %Z when a purely numeric zone is negative (Bug#28746). * test/src/editfns-tests.el (format-time-string-with-zone): Add test for this bug. --- src/editfns.c | 3 ++- test/src/editfns-tests.el | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/editfns.c b/src/editfns.c index b03eb947dec..2f8b075817a 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -187,7 +187,8 @@ tzlookup (Lisp_Object zone, bool settz) if (sec != 0) prec += 2, numzone = 100 * numzone + sec; } - sprintf (tzbuf, tzbuf_format, prec, numzone, + sprintf (tzbuf, tzbuf_format, prec, + XINT (zone) < 0 ? -numzone : numzone, &"-"[XINT (zone) < 0], hour, min, sec); zone_string = tzbuf; } diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 1c3fde888f6..f910afaf711 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -166,6 +166,10 @@ (should (string-equal (format-time-string format look '(-28800 "PST")) "1972-06-30 15:59:59.999 -0800 (PST)")) + ;; Negative UTC offset, as a Lisp integer. + (should (string-equal + (format-time-string format look -28800) + "1972-06-30 15:59:59.999 -0800 (-08)")) ;; Positive UTC offset that is not an hour multiple, as a string. (should (string-equal (format-time-string format look "IST-5:30") From 059184e645037c947528ef4d8d512f6997613be2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 22:01:56 -0700 Subject: [PATCH 19/81] Avoid crash with C-g C-g in GC Problem reported by Richard Stallman (Bug#17406). Based on fix suggested by Eli Zaretskii (Bug#28279#16). * src/term.c (tty_send_additional_strings): Use only safe accessors, to avoid crash when C-g C-g in GC. --- src/term.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/term.c b/src/term.c index a2ae8c2c6f0..065bce45d3c 100644 --- a/src/term.c +++ b/src/term.c @@ -155,12 +155,16 @@ tty_ring_bell (struct frame *f) static void tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym) { - Lisp_Object lisp_terminal; - Lisp_Object extra_codes; + /* Use only accessors like CDR_SAFE and assq_no_quit to avoid any + form of quitting or signaling an error, since this function can + run as part of the "emergency escape" procedure invoked in the + middle of GC, where quitting means crashing (Bug#17406). */ + if (! terminal->name) + return; struct tty_display_info *tty = terminal->display_info.tty; - XSETTERMINAL (lisp_terminal, terminal); - for (extra_codes = Fterminal_parameter (lisp_terminal, sym); + for (Lisp_Object extra_codes + = CDR_SAFE (assq_no_quit (sym, terminal->param_alist)); CONSP (extra_codes); extra_codes = XCDR (extra_codes)) { From 6359fe630ad06052ee0543b30466a74cd32b69c9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 17 Sep 2017 22:32:31 -0700 Subject: [PATCH 20/81] Remove old cl-assert calls in 'newline' * lisp/simple.el (newline): Remove cl-assert calls that didn't seem to be helping us debug Bug#18913, and that caused problems as reported in Bug#28280. Suggested by Glenn Morris (Bug#28280#8). --- lisp/simple.el | 39 ++++++++++++++++----------------------- 1 file changed, 16 insertions(+), 23 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 1ffe1810672..4e42fd52415 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -434,10 +434,6 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." ;; Do the rest in post-self-insert-hook, because we want to do it ;; *before* other functions on that hook. (lambda () - ;; We are not going to insert any newlines if arg is - ;; non-positive. - (or (and (numberp arg) (<= arg 0)) - (cl-assert (eq ?\n (char-before)))) ;; Mark the newline(s) `hard'. (if use-hard-newlines (set-hard-newline-properties @@ -456,25 +452,22 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." ;; starts a page. (or was-page-start (move-to-left-margin nil t))))) - (unwind-protect - (if (not interactive) - ;; FIXME: For non-interactive uses, many calls actually - ;; just want (insert "\n"), so maybe we should do just - ;; that, so as to avoid the risk of filling or running - ;; abbrevs unexpectedly. - (let ((post-self-insert-hook (list postproc))) - (self-insert-command arg)) - (unwind-protect - (progn - (add-hook 'post-self-insert-hook postproc nil t) - (self-insert-command arg)) - ;; We first used let-binding to protect the hook, but that - ;; was naive since add-hook affects the symbol-default - ;; value of the variable, whereas the let-binding might - ;; only protect the buffer-local value. - (remove-hook 'post-self-insert-hook postproc t))) - (cl-assert (not (member postproc post-self-insert-hook))) - (cl-assert (not (member postproc (default-value 'post-self-insert-hook)))))) + (if (not interactive) + ;; FIXME: For non-interactive uses, many calls actually + ;; just want (insert "\n"), so maybe we should do just + ;; that, so as to avoid the risk of filling or running + ;; abbrevs unexpectedly. + (let ((post-self-insert-hook (list postproc))) + (self-insert-command arg)) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc nil t) + (self-insert-command arg)) + ;; We first used let-binding to protect the hook, but that + ;; was naive since add-hook affects the symbol-default + ;; value of the variable, whereas the let-binding might + ;; only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc t)))) nil) (defun set-hard-newline-properties (from to) From 466df76f7df06a03760545fe03d71bc0dc7fe98f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 18 Sep 2017 10:00:17 +0200 Subject: [PATCH 21/81] Cleanup in files-tests.el * test/lisp/files-tests.el (files-tests--make-directory) (files-tests--copy-directory): Cleanup temporary directories. --- test/lisp/files-tests.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 3117ea697ec..f2a9a321808 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -363,7 +363,8 @@ be invoked with the right arguments." (should-not (make-directory subdir1)) (should-not (make-directory subdir2 t)) (should-error (make-directory a/b)) - (should-not (make-directory a/b t)))) + (should-not (make-directory a/b t)) + (delete-directory dir 'recursive))) (ert-deftest files-test-no-file-write-contents () "Test that `write-contents-functions' permits saving a file. @@ -402,7 +403,8 @@ name (Bug#28412)." (make-directory source) (write-region "" nil file) (copy-directory source dest t t t) - (should (file-exists-p (concat dest "file"))))) + (should (file-exists-p (concat dest "file"))) + (delete-directory dir 'recursive))) (provide 'files-tests) ;;; files-tests.el ends here From 331d0e520ff5a3599cc9958108a6b6b8cb277ce3 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Mon, 18 Sep 2017 09:00:45 -0400 Subject: [PATCH 22/81] Fix gensym * lisp/subr.el (gensym): Actually implement the default prefix. * test/lisp/subr-tests.el (subr-tests--gensym): New test. --- lisp/subr.el | 2 +- test/lisp/subr-tests.el | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index 79ae1f4830d..96b1ac19b4b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -289,7 +289,7 @@ The name is made by appending `gensym-counter' to PREFIX. PREFIX is a string, and defaults to \"g\"." (let ((num (prog1 gensym-counter (setq gensym-counter (1+ gensym-counter))))) - (make-symbol (format "%s%d" prefix num)))) + (make-symbol (format "%s%d" (or prefix "g") num)))) (defun ignore (&rest _ignore) "Do nothing and return nil. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ac9e2df603c..a68688eba7a 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -300,6 +300,12 @@ cf. Bug#25477." (setq res (read-passwd "pass: " 'confirm (mapconcat #'string default ""))) (should (string= default res))))) +(ert-deftest subr-tests--gensym () + "Test `gensym' behavior." + (should (equal (symbol-name (let ((gensym-counter 0)) (gensym))) + "g0")) + (should (eq (string-to-char (symbol-name (gensym))) ?g)) + (should (eq (string-to-char (symbol-name (gensym "X"))) ?X))) (provide 'subr-tests) ;;; subr-tests.el ends here From 8d4223e61b5e4661ececb6ab84c665fe761d0438 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 18 Sep 2017 18:00:07 +0200 Subject: [PATCH 23/81] Minor Tramp doc update * doc/misc/tramp.texi (Frequently Asked Questions): Mention `vc-handled-backends'. --- doc/misc/tramp.texi | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7e8ce75f2de..6478479c38d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3043,6 +3043,14 @@ Disable version control to avoid delays: @end group @end lisp +If this is too radical, because you want to use version control +remotely, trim @code{vc-handled-backends} to just those you care +about, for example: + +@lisp +(setq vc-handled-backends '(SVN Git)) +@end lisp + Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, default being 3. Increase trace levels temporarily when hunting for bugs. From 9e1b5bd92ce26291c71ddb33a6291225e6ec1152 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 18 Sep 2017 18:00:27 +0200 Subject: [PATCH 24/81] Improve tramp-interrupt-process robustness * lisp/net/tramp.el (tramp-interrupt-process): Wait, until the process has disappeared. --- lisp/net/tramp.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 07c06808bb2..abcd5282d3a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4556,6 +4556,12 @@ Only works for Bourne-like shells." 'tramp-send-command (tramp-get-connection-property proc "vector" nil) (format "kill -2 %d" pid)) + ;; Wait, until the process has disappeared. + (with-timeout + (1 (tramp-error proc 'error "Process %s did not interrupt" proc)) + (while (process-live-p proc) + ;; We cannot run `tramp-accept-process-output', it blocks timers. + (accept-process-output proc 0.1))) ;; Report success. proc)))) From ee512e9a825a6dbdf438a432b75b7e18d9a983c7 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Mon, 18 Sep 2017 13:29:44 -0700 Subject: [PATCH 25/81] Ignore buffers whose name begins with a space in save-some-buffers * lisp/files.el (save-some-buffers): Consider these buffers "internal", and don't prompt the user to save them. * doc/lispref/files.texi: Document. --- doc/lispref/files.texi | 9 ++++++--- lisp/files.el | 1 + 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 6be998f0b2e..b1b858a6b4b 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -332,7 +332,9 @@ in the list @code{find-file-hook}. that is visiting that file---that is, the contents of the file are copied into the buffer and the copy is what you edit. Changes to the buffer do not change the file until you @dfn{save} the buffer, which -means copying the contents of the buffer into the file. +means copying the contents of the buffer into the file. Buffers which +are not visiting a file can still be ``saved'', in a sense, using +functions in the buffer-local @code{write-contents-functions} hook. @deffn Command save-buffer &optional backup-option This function saves the contents of the current buffer in its visited @@ -365,8 +367,9 @@ With an argument of 0, unconditionally do @emph{not} make any backup file. @anchor{Definition of save-some-buffers} This command saves some modified file-visiting buffers. Normally it asks the user about each buffer. But if @var{save-silently-p} is -non-@code{nil}, it saves all the file-visiting buffers without querying -the user. +non-@code{nil}, it saves all the file-visiting buffers without +querying the user. Additionally, buffers whose name begins with a +space (``internal'' buffers) will not be offered for save. @vindex save-some-buffers-default-predicate The optional @var{pred} argument provides a predicate that controls diff --git a/lisp/files.el b/lisp/files.el index 133fed90c34..ff0ab706338 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5188,6 +5188,7 @@ change the additional actions you can take on files." (and (buffer-live-p buffer) (buffer-modified-p buffer) (not (buffer-base-buffer buffer)) + (not (eq (aref (buffer-name buffer) 0) ?\s)) (or (buffer-file-name buffer) (and pred From 3f006b56cdd9dff313ea88fcedad122968fe1e6b Mon Sep 17 00:00:00 2001 From: Ken Brown Date: Mon, 18 Sep 2017 17:22:52 -0400 Subject: [PATCH 26/81] Adapt fileio-tests--symlink-failure to Cygwin * test/src/fileio-tests.el (fileio-tests--symlink-failure) [CYGWIN]: Skip the case of a symlink target starting with '\'; this is treated specially on Cygwin. --- test/src/fileio-tests.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index a56fb4474d6..01c280d2752 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -35,6 +35,8 @@ (char 0)) (while (and (not failure) (< char 127)) (setq char (1+ char)) + (when (and (eq system-type 'cygwin) (eq char 92)) + (setq char (1+ char))) (setq failure (try-link (string char) link))) (or failure (try-link "/:" link))) From 066efb86660542238854a400c3c20b5cb526a3cd Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 18 Sep 2017 20:02:01 -0600 Subject: [PATCH 27/81] Fix log-view-diff-common when point is after last entry Bug#28466 * lisp/vc/log-view.el (log-view-diff-common): If point is after last entry, look at the previous revision. --- lisp/vc/log-view.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 52f56ed990f..d6963d0a1b9 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -608,10 +608,16 @@ considered file(s)." (log-view-diff-common beg end t))) (defun log-view-diff-common (beg end &optional whole-changeset) - (let ((to (log-view-current-tag beg)) - (fr (log-view-current-tag end))) - (when (string-equal fr to) - ;; TO and FR are the same, look at the previous revision. + (let* ((to (log-view-current-tag beg)) + (fr-entry (log-view-current-entry end)) + (fr (cadr fr-entry))) + ;; When TO and FR are the same, or when point is on a line after + ;; the last entry, look at the previous revision. + (when (or (string-equal fr to) + (>= (point) + (save-excursion + (goto-char (car fr-entry)) + (forward-line)))) (setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr))) (vc-diff-internal t (list log-view-vc-backend From 1a01423b3c75bf08c255b3bd39f44d91e509a318 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 19 Sep 2017 01:47:39 -0700 Subject: [PATCH 28/81] Fix bug with make-directory on MS-Windows root * lisp/files.el (files--ensure-directory): Treat any error, not just file-already-exists, as an opportunity to check whether DIR is already a directory (Bug#28508). --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index ff0ab706338..0c30d40c13b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5337,7 +5337,7 @@ instance of such commands." "Make directory DIR if it is not already a directory. Return nil." (condition-case err (make-directory-internal dir) - (file-already-exists + (error (unless (file-directory-p dir) (signal (car err) (cdr err)))))) From 40fdbb01d0017e9e164a24aeb760056778975e65 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 19 Sep 2017 18:12:35 +0200 Subject: [PATCH 29/81] Work on Tramp's file-truename * lisp/net/tramp-sh.el (tramp-perl-file-truename): Check also for symlinks. (tramp-sh-handle-file-truename): Move check for a symlink cycle to the end. Do not blame symlinks which look like a remote file name. * lisp/net/tramp.el (tramp-handle-file-truename): Expand result. --- lisp/net/tramp-sh.el | 26 +++++++++----------------- lisp/net/tramp.el | 6 +++--- 2 files changed, 12 insertions(+), 20 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5f145d4fae1..a744a53ca42 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -613,7 +613,7 @@ use Cwd \"realpath\"; sub myrealpath { my ($file) = @_; - return realpath($file) if -e $file; + return realpath($file) if (-e $file || -l $file); } sub recursive { @@ -1139,12 +1139,7 @@ component is used as the target of the symlink." (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (setq result (buffer-substring (point-min) (point-at-eol)))) - (when (and (file-symlink-p filename) - (string-equal result localname)) - (tramp-error - v 'file-error - "Apparent cycle of symbolic links for %s" filename))) + (setq result (buffer-substring (point-min) (point-at-eol))))) ;; Use Perl implementation. ((and (tramp-get-remote-perl v) @@ -1198,16 +1193,6 @@ component is used as the target of the symlink." (setq numchase (1+ numchase)) (when (file-name-absolute-p symlink-target) (setq result nil)) - ;; If the symlink was absolute, we'll get a - ;; string like "/user@host:/some/target"; - ;; extract the "/some/target" part from it. - (when (tramp-tramp-file-p symlink-target) - (unless (tramp-equal-remote filename symlink-target) - (tramp-error - v 'file-error - "Symlink target `%s' on wrong host" - symlink-target)) - (setq symlink-target localname)) (setq steps (append (split-string symlink-target "/" 'omit) steps))) @@ -1226,6 +1211,13 @@ component is used as the target of the symlink." "/")) (when (string= "" result) (setq result "/"))))) + + ;; Detect cycle. + (when (and (file-symlink-p filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" filename)) ;; If the resulting localname looks remote, we must quote it ;; for security reasons. (when (or quoted (file-remote-p result)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index abcd5282d3a..3573eeb7d49 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3169,7 +3169,7 @@ User is always nil." (defun tramp-handle-file-truename (filename) "Like `file-truename' for Tramp files." - (let ((result filename) + (let ((result (expand-file-name filename)) (numchase 0) ;; Don't make the following value larger than ;; necessary. People expect an error message in a @@ -3180,7 +3180,7 @@ User is always nil." symlink-target) (format "%s%s" - (with-parsed-tramp-file-name (expand-file-name result) v1 + (with-parsed-tramp-file-name result v1 (with-tramp-file-property v1 v1-localname "file-truename" (while (and (setq symlink-target (file-symlink-p result)) (< numchase numchase-limit)) @@ -3850,7 +3850,7 @@ Erase echoed commands if exists." (min (+ (point-min) tramp-echo-mark-marker-length) (point-max)))))) ;; No echo to be handled, now we can look for the regexp. - ;; Sometimes, lines are much to long, and we run into a "Stack + ;; Sometimes, lines are much too long, and we run into a "Stack ;; overflow in regexp matcher". For example, //DIRED// lines of ;; directory listings with some thousand files. Therefore, we ;; look from the end. From 74d7bb94988055a49ac8f1cbc5af43ac31255581 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Sep 2017 19:32:09 +0300 Subject: [PATCH 30/81] Fix errors in flyspell-post-command-hook * lisp/textmodes/ispell.el (ispell-get-decoded-string): Handle the case of a nil Nth element of the language dictionary slot. This avoids errors in 'flyspell-post-command-hook' when switching dictionaries with some spell-checkers. (Bug#28501) --- lisp/textmodes/ispell.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 0c0a51e7df0..6a169622f52 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1492,8 +1492,10 @@ This is passed to the Ispell process using the `-p' switch.") (assoc ispell-current-dictionary ispell-local-dictionary-alist) (assoc ispell-current-dictionary ispell-dictionary-alist) (error "No data for dictionary \"%s\" in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'" - ispell-current-dictionary)))) - (decode-coding-string (nth n slot) (ispell-get-coding-system) t))) + ispell-current-dictionary))) + (str (nth n slot))) + (if (stringp str) + (decode-coding-string str (ispell-get-coding-system) t)))) (defun ispell-get-casechars () (ispell-get-decoded-string 1)) From 68452822000fff0e44c40e966fb516fa01d219e7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Sep 2017 19:48:27 +0300 Subject: [PATCH 31/81] Fix a minor inaccuracy in the Emacs manual * doc/emacs/cmdargs.texi (Action Arguments): Don't mention 'find-file', as the implementation has changed. Reported by Everton J. Carpes in http://lists.gnu.org/archive/html/help-gnu-emacs/2017-09/msg00146.html. --- doc/emacs/cmdargs.texi | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 819459e0af0..618a05d451b 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -92,7 +92,7 @@ arguments.) @itemx --visit=@var{file} @cindex visiting files, command-line argument @vindex inhibit-startup-buffer-menu -Visit @var{file} using @code{find-file}. @xref{Visiting}. +Visit the specified @var{file}. @xref{Visiting}. When Emacs starts up, it displays the startup buffer in one window, and the buffer visiting @var{file} in another window @@ -111,12 +111,12 @@ Buffer Menu for this, change the variable @item +@var{linenum} @var{file} @opindex +@var{linenum} -Visit @var{file} using @code{find-file}, then go to line number -@var{linenum} in it. +Visit the specified @var{file}, then go to line number @var{linenum} +in it. @item +@var{linenum}:@var{columnnum} @var{file} -Visit @var{file} using @code{find-file}, then go to line number -@var{linenum} and put point at column number @var{columnnum}. +Visit the specified @var{file}, then go to line number @var{linenum} +and put point at column number @var{columnnum}. @item -l @var{file} @opindex -l From 7f3d5f929d4e25cd2c0b89a13f4741eb02ce3e64 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Sep 2017 19:52:50 +0300 Subject: [PATCH 32/81] * src/emacs.c (usage_message): Don't mention 'find-file'. --- src/emacs.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 1ad8af70a74..0fe7d9113b4 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -252,7 +252,7 @@ Initialization options:\n\ "\ Action options:\n\ \n\ -FILE visit FILE using find-file\n\ +FILE visit FILE\n\ +LINE go to line LINE in next FILE\n\ +LINE:COLUMN go to line LINE, column COLUMN, in next FILE\n\ --directory, -L DIR prepend DIR to load-path (with :DIR, append DIR)\n\ @@ -260,13 +260,13 @@ FILE visit FILE using find-file\n\ --execute EXPR evaluate Emacs Lisp expression EXPR\n\ ", "\ ---file FILE visit FILE using find-file\n\ ---find-file FILE visit FILE using find-file\n\ +--file FILE visit FILE\n\ +--find-file FILE visit FILE\n\ --funcall, -f FUNC call Emacs Lisp function FUNC with no arguments\n\ --insert FILE insert contents of FILE into current buffer\n\ --kill exit without asking for confirmation\n\ --load, -l FILE load Emacs Lisp FILE using the load function\n\ ---visit FILE visit FILE using find-file\n\ +--visit FILE visit FILE\n\ \n\ ", "\ From c83d0c5fdfd374d5c2e1547d05f02ab3b47a4a5a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Sep 2017 20:11:42 +0300 Subject: [PATCH 33/81] Fix crashes in 'move-point-visually' in minibuffer windows * src/xdisp.c (Fmove_point_visually): Fix off-by-one error in comparing against the last valid glyph_row of a window glyph matrix. (Bug#28505) --- src/xdisp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index dc5dbb05762..141275f15a0 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -22395,8 +22395,8 @@ Value is the new character position of point. */) row += dir; else row -= dir; - if (row < MATRIX_FIRST_TEXT_ROW (w->current_matrix) - || row > MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)) + if (!(MATRIX_FIRST_TEXT_ROW (w->current_matrix) <= row + && row < MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w))) goto simulate_display; if (dir > 0) From 7b3d1c6beb54ef6c423a93df88aebfd6fecbe2c2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 19 Sep 2017 20:31:02 +0300 Subject: [PATCH 34/81] Fix MinGW64 build broken by recent MinGW64 import libraries * configure.ac (W32_LIBS): Put -lusp10 before -lgdi32, as latest MinGW64 import libraries require that. (Bug#28493) * src/Makefile.in: Adjust commentary to the new order of w32 libraries. --- configure.ac | 8 ++++---- src/Makefile.in | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index 6452038d1b9..0b0bb5e144b 100644 --- a/configure.ac +++ b/configure.ac @@ -2077,15 +2077,15 @@ if test "${HAVE_W32}" = "yes"; then AC_SUBST(comma_space_version) AC_CONFIG_FILES([nt/emacs.rc nt/emacsclient.rc]) if test "${opsys}" = "cygwin"; then - W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32" - W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool" + W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lusp10 -lgdi32" + W32_LIBS="$W32_LIBS -lole32 -lcomdlg32 -lcomctl32 -lwinspool" # Tell the linker that emacs.res is an object (which we compile from # the rc file), not a linker script. W32_RES_LINK="-Wl,emacs.res" else W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o" - W32_LIBS="$W32_LIBS -lwinmm -lgdi32 -lcomdlg32" - W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32 -lusp10" + W32_LIBS="$W32_LIBS -lwinmm -lusp10 -lgdi32 -lcomdlg32" + W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32" W32_RES_LINK="\$(EMACSRES)" CLIENTRES="emacsclient.res" CLIENTW="emacsclientw\$(EXEEXT)" diff --git a/src/Makefile.in b/src/Makefile.in index 0e55ad4bb29..9a8c9c85f04 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -280,7 +280,7 @@ GNU_OBJC_CFLAGS=$(patsubst -specs=%-hardened-cc1,,@GNU_OBJC_CFLAGS@) ## w32xfns.o w32select.o image.o w32uniscribe.o if HAVE_W32, else ## empty. W32_OBJ=@W32_OBJ@ -## -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32 lusp10 -lcomctl32 +## -lkernel32 -luser32 -lusp10 -lgdi32 -lole32 -lcomdlg32 -lcomctl32 ## --lwinspool if HAVE_W32, else empty. W32_LIBS=@W32_LIBS@ From a5fec62b519ae8c0a6528366ac8b71cd0c7ac52e Mon Sep 17 00:00:00 2001 From: Alan Third Date: Fri, 8 Sep 2017 19:26:47 +0100 Subject: [PATCH 35/81] Provide native touchpad scrolling on macOS * etc/NEWS: Describe changes. * lisp/term/ns-win.el (mouse-wheel-scroll-amount, mouse-wheel-progressive-speed): Set to smarter values for macOS touchpads. * src/nsterm.m (emacsView::mouseDown): Use precise scrolling deltas to calculate scrolling for touchpads and mouse wheels. (syms_of_nsterm): Add variables 'ns-use-system-mwheel-acceleration', 'ns-touchpad-scroll-line-height' and 'ns-touchpad-use-momentum'. * src/keyboard.c (make_lispy_event): Pass on .arg when relevant. * src/termhooks.h (event_kind): Update comments re. WHEEL_EVENT. * lisp/mwheel.el (mwheel-scroll): Use line count. * lisp/subr.el (event-line-count): New function. --- etc/NEWS | 6 ++ lisp/mwheel.el | 1 + lisp/subr.el | 5 ++ lisp/term/ns-win.el | 19 ++++++ src/keyboard.c | 5 +- src/nsterm.m | 158 ++++++++++++++++++++++++++++++++++++++++---- src/termhooks.h | 4 +- 7 files changed, 184 insertions(+), 14 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5aa57a77765..a814c3ec20d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1882,6 +1882,12 @@ of frame decorations on macOS 10.9+. --- ** 'process-attributes' on Darwin systems now returns more information. +--- +** Mousewheel and trackpad scrolling on macOS 10.7+ now behaves more +like the macOS default. The new variables +'ns-use-system-mwheel-acceleration', 'ns-touchpad-scroll-line-height' +and 'ns-touchpad-use-momentum' can be used to customise the behavior. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 2956ba55162..0c0dcb3beb1 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -232,6 +232,7 @@ non-Windows systems." ;; When the double-mouse-N comes in, a mouse-N has been executed already, ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...). (setq amt (* amt (event-click-count event)))) + (when (numberp amt) (setq amt (* amt (event-line-count event)))) (unwind-protect (let ((button (mwheel-event-button event))) (cond ((eq button mouse-wheel-down-event) diff --git a/lisp/subr.el b/lisp/subr.el index 96b1ac19b4b..cf15ec287ff 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1270,6 +1270,11 @@ See `event-start' for a description of the value returned." "Return the multi-click count of EVENT, a click or drag event. The return value is a positive integer." (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1)) + +(defsubst event-line-count (event) + "Return the line count of EVENT, a mousewheel event. +The return value is a positive integer." + (if (and (consp event) (integerp (nth 3 event))) (nth 3 event) 1)) ;;;; Extracting fields of the positions in an event. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 68b659bf751..bc211ea9589 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -736,6 +736,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (global-unset-key [horizontal-scroll-bar drag-mouse-1]) +;;;; macOS-like defaults for trackpad and mouse wheel scrolling on +;;;; macOS 10.7+. + +;; FIXME: This doesn't look right. Is there a better way to do this +;; that keeps customize happy? +(let ((appkit-version (progn + (string-match "^appkit-\\([^\s-]*\\)" ns-version-string) + (string-to-number (match-string 1 ns-version-string))))) + ;; Appkit 1138 ~= macOS 10.7. + (when (and (featurep 'cocoa) (>= appkit-version 1138)) + (setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control)))) + (put 'mouse-wheel-scroll-amount 'customized-value + (list (custom-quote (symbol-value 'mouse-wheel-scroll-amount)))) + + (setq mouse-wheel-progressive-speed nil) + (put 'mouse-wheel-progressive-speed 'customized-value + (list (custom-quote (symbol-value 'mouse-wheel-progressive-speed)))))) + + ;;;; Color support. ;; Functions for color panel + drag diff --git a/src/keyboard.c b/src/keyboard.c index 4db50be855c..e8701b88708 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5925,7 +5925,10 @@ make_lispy_event (struct input_event *event) ASIZE (wheel_syms)); } - if (event->modifiers & (double_modifier | triple_modifier)) + if (NUMBERP (event->arg)) + return list4 (head, position, make_number (double_click_count), + event->arg); + else if (event->modifiers & (double_modifier | triple_modifier)) return list3 (head, position, make_number (double_click_count)); else return list2 (head, position); diff --git a/src/nsterm.m b/src/nsterm.m index 27515335332..776635980e1 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6498,24 +6498,139 @@ not_in_argv (NSString *arg) if ([theEvent type] == NSEventTypeScrollWheel) { - CGFloat delta = [theEvent deltaY]; - /* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */ - if (delta == 0) +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([theEvent respondsToSelector:@selector(hasPreciseScrollingDeltas)]) { - delta = [theEvent deltaX]; - if (delta == 0) +#endif + /* If the input device is a touchpad or similar, use precise + * scrolling deltas. These are measured in pixels, so we + * have to add them up until they exceed one line height, + * then we can send a scroll wheel event. + * + * If the device only has coarse scrolling deltas, like a + * real mousewheel, the deltas represent a ratio of whole + * lines, so round up the number of lines. This means we + * always send one scroll event per click, but can still + * scroll more than one line if the OS tells us to. + */ + bool horizontal; + int lines = 0; + int scrollUp = NO; + + /* FIXME: At the top or bottom of the buffer we should + * ignore momentum-phase events. */ + if (! ns_touchpad_use_momentum + && [theEvent momentumPhase] != NSEventPhaseNone) + return; + + if ([theEvent hasPreciseScrollingDeltas]) { - NSTRACE_MSG ("deltaIsZero"); - return; + static int totalDeltaX, totalDeltaY; + int lineHeight; + + if (NUMBERP (ns_touchpad_scroll_line_height)) + lineHeight = XINT (ns_touchpad_scroll_line_height); + else + { + /* FIXME: Use actual line height instead of the default. */ + lineHeight = default_line_pixel_height + (XWINDOW (FRAME_SELECTED_WINDOW (emacsframe))); + } + + if ([theEvent phase] == NSEventPhaseBegan) + { + totalDeltaX = 0; + totalDeltaY = 0; + } + + totalDeltaX += [theEvent scrollingDeltaX]; + totalDeltaY += [theEvent scrollingDeltaY]; + + /* Calculate the number of lines, if any, to scroll, and + * reset the total delta for the direction we're NOT + * scrolling so that small movements don't add up. */ + if (abs (totalDeltaX) > abs (totalDeltaY) + && abs (totalDeltaX) > lineHeight) + { + horizontal = YES; + scrollUp = totalDeltaX > 0; + + lines = abs (totalDeltaX / lineHeight); + totalDeltaX = totalDeltaX % lineHeight; + totalDeltaY = 0; + } + else if (abs (totalDeltaY) >= abs (totalDeltaX) + && abs (totalDeltaY) > lineHeight) + { + horizontal = NO; + scrollUp = totalDeltaY > 0; + + lines = abs (totalDeltaY / lineHeight); + totalDeltaY = totalDeltaY % lineHeight; + totalDeltaX = 0; + } + + if (lines > 1 && ! ns_use_system_mwheel_acceleration) + lines = 1; } - emacs_event->kind = HORIZ_WHEEL_EVENT; + else + { + CGFloat delta; + + if ([theEvent scrollingDeltaY] == 0) + { + horizontal = YES; + delta = [theEvent scrollingDeltaX]; + } + else + { + horizontal = NO; + delta = [theEvent scrollingDeltaY]; + } + + lines = (ns_use_system_mwheel_acceleration) + ? ceil (fabs (delta)) : 1; + + scrollUp = delta > 0; + } + + if (lines == 0) + return; + + emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT; + emacs_event->arg = (make_number (lines)); + + emacs_event->code = 0; + emacs_event->modifiers = EV_MODIFIERS (theEvent) | + (scrollUp ? up_modifier : down_modifier); +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 } else - emacs_event->kind = WHEEL_EVENT; +#endif +#endif /* defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */ +#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + { + CGFloat delta = [theEvent deltaY]; + /* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */ + if (delta == 0) + { + delta = [theEvent deltaX]; + if (delta == 0) + { + NSTRACE_MSG ("deltaIsZero"); + return; + } + emacs_event->kind = HORIZ_WHEEL_EVENT; + } + else + emacs_event->kind = WHEEL_EVENT; - emacs_event->code = 0; - emacs_event->modifiers = EV_MODIFIERS (theEvent) | - ((delta > 0) ? up_modifier : down_modifier); + emacs_event->code = 0; + emacs_event->modifiers = EV_MODIFIERS (theEvent) | + ((delta > 0) ? up_modifier : down_modifier); + } +#endif } else { @@ -6524,9 +6639,11 @@ not_in_argv (NSString *arg) emacs_event->modifiers = EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent); } + XSETINT (emacs_event->x, lrint (p.x)); XSETINT (emacs_event->y, lrint (p.y)); EV_TRAILER (theEvent); + return; } @@ -9166,6 +9283,23 @@ Note that this does not apply to images. This variable is ignored on Mac OS X < 10.7 and GNUstep. */); ns_use_srgb_colorspace = YES; + DEFVAR_BOOL ("ns-use-system-mwheel-acceleration", + ns_use_system_mwheel_acceleration, + doc: /*Non-nil means use macOS's standard mouse wheel acceleration. +This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); + ns_use_system_mwheel_acceleration = YES; + + DEFVAR_LISP ("ns-touchpad-scroll-line-height", ns_touchpad_scroll_line_height, + doc: /*The number of pixels touchpad scrolling considers a line. +Nil or a non-number means use the default frame line height. +This variable is ignored on macOS < 10.7 and GNUstep. Default is nil. */); + ns_touchpad_scroll_line_height = Qnil; + + DEFVAR_BOOL ("ns-touchpad-use-momentum", ns_touchpad_use_momentum, + doc: /*Non-nil means touchpad scrolling uses momentum. +This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); + ns_touchpad_use_momentum = YES; + /* TODO: move to common code */ DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, doc: /* Which toolkit scroll bars Emacs uses, if any. diff --git a/src/termhooks.h b/src/termhooks.h index 97c128ba4e2..b5171bf1229 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -116,7 +116,9 @@ enum event_kind .frame_or_window gives the frame the wheel event occurred in. .timestamp gives a timestamp (in - milliseconds) for the event. */ + milliseconds) for the event. + .arg may contain the number of + lines to scroll. */ HORIZ_WHEEL_EVENT, /* A wheel event generated by a second horizontal wheel that is present on some mice. See WHEEL_EVENT. */ From 965cffd89cd5727c46a1b0999bef440f8e316742 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Tue, 19 Sep 2017 22:21:37 -0400 Subject: [PATCH 36/81] Rename timer-list to list-timers * doc/emacs/anti.texi (Antinews): * doc/lispref/os.texi (Timers): * etc/NEWS: * lisp/emacs-lisp/timer-list.el: (timer-list-mode): Rename timer-list to list-timers. --- doc/emacs/anti.texi | 2 +- doc/lispref/os.texi | 4 ++-- etc/NEWS | 2 +- lisp/emacs-lisp/timer-list.el | 6 +++--- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi index ffec915cb13..547dbd1b45d 100644 --- a/doc/emacs/anti.texi +++ b/doc/emacs/anti.texi @@ -94,7 +94,7 @@ happen. The variables @code{'attempt-stack-overflow-recovery} and @code{attempt-orderly-shutdown-on-fatal-signal} are therefore removed. @item -The @code{timer-list} command was removed, as we decided timers are +The @code{list-timers} command was removed, as we decided timers are not user-level feature, and therefore users should not be allowed to mess with them. Ask an Emacs Lisp guru near you for help if you have a runaway timer in your session. (Of course, as you move back in diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 441fda5d825..af646ce40f4 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1885,8 +1885,8 @@ one of these functions; the arrival of the specified time will not cause anything special to happen. @end defun -@findex timer-list -The @code{timer-list} command lists all the currently active timers. +@findex list-timers +The @code{list-timers} command lists all the currently active timers. There's only one command available in the buffer displayed: @kbd{c} (@code{timer-list-cancel}) that will cancel the timer on the line under point. diff --git a/etc/NEWS b/etc/NEWS index a814c3ec20d..a685a9fbe92 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -367,7 +367,7 @@ see the node "Connection Local Variables" in the ELisp manual. puny.el library, so that one can visit Web sites with non-ASCII URLs. +++ -** The new 'timer-list' command lists all active timers in a buffer, +** The new 'list-timers' command lists all active timers in a buffer, where you can cancel them with the 'c' command. +++ diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 44a315f9806..69c67419835 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -25,7 +25,7 @@ ;;; Code: ;;;###autoload -(defun timer-list (&optional _ignore-auto _nonconfirm) +(defun list-timers (&optional _ignore-auto _nonconfirm) "List all timers in a buffer." (interactive) (pop-to-buffer-same-window (get-buffer-create "*timer-list*")) @@ -67,7 +67,7 @@ (goto-char (point-min))) ;; This command can be destructive if they don't know what they are ;; doing. Kids, don't try this at home! -;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.") +;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.") (defvar timer-list-mode-map (let ((map (make-sparse-keymap))) @@ -84,7 +84,7 @@ (setq bidi-paragraph-direction 'left-to-right) (setq truncate-lines t) (buffer-disable-undo) - (setq-local revert-buffer-function 'timer-list) + (setq-local revert-buffer-function #'list-timers) (setq buffer-read-only t) (setq header-line-format (format "%4s %10s %8s %s" From f16a8d5dbd3bb8a319c951bdde9a6a75dbdb8c17 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Sep 2017 10:16:11 +0300 Subject: [PATCH 37/81] Fix 2 testsuite tests for MS-Windows * test/lisp/ibuffer-tests.el (test-buffer-list): Don't try to create files with "*" in their names. * test/src/editfns-tests.el (format-time-string-with-zone): Adapt results to MS-Windows build. Reported by Fabrice Popineau . --- test/lisp/ibuffer-tests.el | 51 ++++++++++++++++++++++---------------- test/src/editfns-tests.el | 6 ++++- 2 files changed, 35 insertions(+), 22 deletions(-) diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index d65acf60712..35605ca28dc 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -456,11 +456,14 @@ (funcall create-non-file-buffer "ibuf-test-8a" :mode #'artist-mode)) (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32)) - (bufC (funcall create-file-buffer "ibuf-test8c" :suffix "*" - :size 64)) - (bufD (funcall create-file-buffer "*ibuf-test8d" :size 128)) - (bufE (funcall create-file-buffer "*ibuf-test8e" :suffix "*<2>" - :size 16)) + (bufC (or (memq system-type '(ms-dos windows-nt)) + (funcall create-file-buffer "ibuf-test8c" :suffix "*" + :size 64))) + (bufD (or (memq system-type '(ms-dos windows-nt)) + (funcall create-file-buffer "*ibuf-test8d" :size 128))) + (bufE (or (memq system-type '(ms-dos windows-nt)) + (funcall create-file-buffer "*ibuf-test8e" + :suffix "*<2>" :size 16))) (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*") (funcall create-non-file-buffer "*ibuf-test8f*" :size 8)))) @@ -479,22 +482,28 @@ (name . "test.*8b") (size-gt . 31) (not visiting-file))))) - (should (ibuffer-included-in-filters-p - bufC '((and (not (starred-name)) - (visiting-file) - (name . "8c[^*]*\\*") - (size-lt . 65))))) - (should (ibuffer-included-in-filters-p - bufD '((and (not (starred-name)) - (visiting-file) - (name . "\\`\\*.*test8d") - (size-lt . 129) - (size-gt . 127))))) - (should (ibuffer-included-in-filters-p - bufE '((and (starred-name) - (visiting-file) - (name . "8e.*?\\*<[[:digit:]]+>") - (size-gt . 10))))) + ;; MS-DOS and MS-Windows don't allow "*" in file names. + (or (memq system-type '(ms-dos windows-nt)) + (should (ibuffer-included-in-filters-p + bufC '((and (not (starred-name)) + (visiting-file) + (name . "8c[^*]*\\*") + (size-lt . 65)))))) + ;; MS-DOS and MS-Windows don't allow "*" in file names. + (or (memq system-type '(ms-dos windows-nt)) + (should (ibuffer-included-in-filters-p + bufD '((and (not (starred-name)) + (visiting-file) + (name . "\\`\\*.*test8d") + (size-lt . 129) + (size-gt . 127)))))) + ;; MS-DOS and MS-Windows don't allow "*" in file names. + (or (memq system-type '(ms-dos windows-nt)) + (should (ibuffer-included-in-filters-p + bufE '((and (starred-name) + (visiting-file) + (name . "8e.*?\\*<[[:digit:]]+>") + (size-gt . 10)))))) (should (ibuffer-included-in-filters-p bufF '((and (starred-name) (not (visiting-file)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index f910afaf711..70dc9372fad 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -169,7 +169,11 @@ ;; Negative UTC offset, as a Lisp integer. (should (string-equal (format-time-string format look -28800) - "1972-06-30 15:59:59.999 -0800 (-08)")) + ;; MS-Windows build replaces unrecognizable TZ values, + ;; such as "-08", with "ZZZ". + (if (eq system-type 'windows-nt) + "1972-06-30 15:59:59.999 -0800 (ZZZ)" + "1972-06-30 15:59:59.999 -0800 (-08)"))) ;; Positive UTC offset that is not an hour multiple, as a string. (should (string-equal (format-time-string format look "IST-5:30") From fbd15836af69b1d156f39664f2512f85278fdb08 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 20 Sep 2017 16:40:20 +0300 Subject: [PATCH 38/81] * doc/lispref/strings.texi (Formatting Strings): Improve indexing. --- doc/lispref/strings.texi | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 23961f99efd..219225d412b 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -824,8 +824,9 @@ to the produced string representations of the argument @var{objects}. @end defun @defun format-message string &rest objects -@cindex curved quotes -@cindex curly quotes +@cindex curved quotes, in formatted messages +@cindex curly quotes, in formatted messages +@cindex @code{text-quoting-style}, and formatting messages This function acts like @code{format}, except it also converts any grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per the value of @code{text-quoting-style}. From 047f02f00f602b9aef63ae8938e12f3f0ab481eb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 20 Sep 2017 11:49:12 -0700 Subject: [PATCH 39/81] Fix new copy-directory bug with empty dirs Problem reported by Afdam Plaice (Bug#28520) and by Eli Zaretskii (Bug#28483#34). This is another bug that I introduced in my recent copy-directory changes. * lisp/files.el (copy-directory): Work with empty subdirectories, too. * test/lisp/files-tests.el (files-tests--copy-directory): Test for this bug. --- lisp/files.el | 2 +- test/lisp/files-tests.el | 7 ++++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 0c30d40c13b..f0a1f2380d9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5564,7 +5564,7 @@ into NEWNAME instead." (filetype (car (file-attributes file)))) (cond ((eq filetype t) ; Directory but not a symlink. - (copy-directory file newname keep-time parents)) + (copy-directory file target keep-time parents t)) ((stringp filetype) ; Symbolic link (make-symbolic-link filetype target t)) ((copy-file file target t keep-time))))) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index f2a9a321808..285a884b695 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -399,11 +399,16 @@ name (Bug#28412)." (dirname (file-name-as-directory dir)) (source (concat dirname "source")) (dest (concat dirname "dest/new/directory/")) - (file (concat (file-name-as-directory source) "file"))) + (file (concat (file-name-as-directory source) "file")) + (source2 (concat dirname "source2")) + (dest2 (concat dirname "dest/new2"))) (make-directory source) (write-region "" nil file) (copy-directory source dest t t t) (should (file-exists-p (concat dest "file"))) + (make-directory (concat (file-name-as-directory source2) "a") t) + (copy-directory source2 dest2) + (should (file-directory-p (concat (file-name-as-directory dest2) "a"))) (delete-directory dir 'recursive))) (provide 'files-tests) From 31e1d9ef2f70937cd0f93f67399620201ded300b Mon Sep 17 00:00:00 2001 From: Tak Kunihiro Date: Thu, 21 Sep 2017 11:26:00 +0300 Subject: [PATCH 40/81] Support setting region from secondary selection and vice versa * lisp/mouse.el (secondary-selection-exist-p): New function to allow callers to tell existence of the secondary selection in current buffer. (secondary-selection-to-region): New function to set beginning and end of the region from those of the secondary selection. (secondary-selection-from-region): New function to set beginning and end of the secondary selection from those of the region. (Bug#27530) * etc/NEWS: Mention the new functions. --- etc/NEWS | 7 +++++++ lisp/mouse.el | 28 ++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index a685a9fbe92..280ab64f37c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1819,6 +1819,13 @@ can be replicated simply by setting 'comment-auto-fill-only-comments'. ** New pcase pattern 'rx' to match against a rx-style regular expression. For details, see the doc string of 'rx--pcase-macroexpander'. +--- +** New functions to set region from secondary selection and vice versa. +The new functions 'secondary-selection-to-region' and +'secondary-selection-from-region' let you set the beginning and the +end of the region from those of the secondary selection and vise +versa. + * Changes in Emacs 26.1 on Non-Free Operating Systems diff --git a/lisp/mouse.el b/lisp/mouse.el index 3f448f018a4..4a4fe52c872 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1916,6 +1916,34 @@ CLICK position, kill the secondary selection." (> (length str) 0) (gui-set-selection 'SECONDARY str)))) +(defun secondary-selection-exist-p () + "Return non-nil if there is the secondary selection in current buffer." + (memq mouse-secondary-overlay (overlays-in (point-min) (point-max)))) + +(defun secondary-selection-to-region () + "Set beginning and end of the region to those of the secondary selection. +This puts mark and point at the beginning and the end of the +secondary selection, respectively. This works when the secondary +selection exists and the region does not exist in current buffer; +the secondary selection will be deleted afterward. +If the region is active, or the secondary selection doesn't exist, +this function does nothing." + (when (and (not (region-active-p)) + (secondary-selection-exist-p)) + (let ((beg (overlay-start mouse-secondary-overlay)) + (end (overlay-end mouse-secondary-overlay))) + (push-mark beg t t) + (goto-char end)) + ;; Delete the secondary selection on current buffer. + (delete-overlay mouse-secondary-overlay))) + +(defun secondary-selection-from-region () + "Set beginning and end of the secondary selection to those of the region. +When there is no region, this function does nothing." + (when (region-active-p) ; Create the secondary selection from the region. + (delete-overlay mouse-secondary-overlay) ; Delete the secondary selection even on a different buffer. + (move-overlay mouse-secondary-overlay (region-beginning) (region-end)))) + (defcustom mouse-buffer-menu-maxlen 20 "Number of buffers in one pane (submenu) of the buffer menu. From 28e0c410c972ad8db9bf8a5d32f64921108104d7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 21 Sep 2017 11:29:11 +0300 Subject: [PATCH 41/81] ; * lisp/mouse.el (secondary-selection-exist-p): Doc fix. --- lisp/mouse.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 4a4fe52c872..169d2632f4f 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1917,7 +1917,7 @@ CLICK position, kill the secondary selection." (gui-set-selection 'SECONDARY str)))) (defun secondary-selection-exist-p () - "Return non-nil if there is the secondary selection in current buffer." + "Return non-nil if the secondary selection exists in the current buffer." (memq mouse-secondary-overlay (overlays-in (point-min) (point-max)))) (defun secondary-selection-to-region () From 68baca3ee142b42de0bbe4eba84945780fd157d6 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Thu, 21 Sep 2017 13:35:45 -0700 Subject: [PATCH 42/81] Catch more messages in ert-with-message-capture * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): Capture messages from prin1, princ and print. (ert--make-message-advice): New function. (ert--make-print-advice): New function. --- lisp/emacs-lisp/ert-x.el | 57 +++++++++++++++++++++++++++++++--------- 1 file changed, 45 insertions(+), 12 deletions(-) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 6d9a7d9211a..5af5262e5da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -286,27 +286,60 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (defmacro ert-with-message-capture (var &rest body) - "Execute BODY while collecting anything written with `message' in VAR. + "Execute BODY while collecting messages in VAR. -Capture all messages produced by `message' when it is called from -Lisp, and concatenate them separated by newlines into one string. +Capture messages issued by Lisp code and concatenate them +separated by newlines into one string. This includes messages +written by `message' as well as objects printed by `print', +`prin1' and `princ' to the echo area. Messages issued from C +code using the above mentioned functions will not be captured. This is useful for separating the issuance of messages by the code under test from the behavior of the *Messages* buffer." (declare (debug (symbolp body)) (indent 1)) - (let ((g-advice (gensym))) + (let ((g-message-advice (gensym)) + (g-print-advice (gensym)) + (g-collector (gensym))) `(let* ((,var "") - (,g-advice (lambda (func &rest args) - (if (or (null args) (equal (car args) "")) - (apply func args) - (let ((msg (apply #'format-message args))) - (setq ,var (concat ,var msg "\n")) - (funcall func "%s" msg)))))) - (advice-add 'message :around ,g-advice) + (,g-collector (lambda (msg) (setq ,var (concat ,var msg)))) + (,g-message-advice (ert--make-message-advice ,g-collector)) + (,g-print-advice (ert--make-print-advice ,g-collector))) + (advice-add 'message :around ,g-message-advice) + (advice-add 'prin1 :around ,g-print-advice) + (advice-add 'princ :around ,g-print-advice) + (advice-add 'print :around ,g-print-advice) (unwind-protect (progn ,@body) - (advice-remove 'message ,g-advice))))) + (advice-remove 'print ,g-print-advice) + (advice-remove 'princ ,g-print-advice) + (advice-remove 'prin1 ,g-print-advice) + (advice-remove 'message ,g-message-advice))))) + +(defun ert--make-message-advice (collector) + "Create around advice for `message' for `ert-collect-messages'. +COLLECTOR will be called with the message before it is passed +to the real `message'." + (lambda (func &rest args) + (if (or (null args) (equal (car args) "")) + (apply func args) + (let ((msg (apply #'format-message args))) + (funcall collector (concat msg "\n")) + (funcall func "%s" msg))))) + +(defun ert--make-print-advice (collector) + "Create around advice for print functions for `ert-collect-messsges'. +The created advice function will just call the original function +unless the output is going to the echo area (when PRINTCHARFUN is +t or PRINTCHARFUN is nil and `standard-output' is t). If the +output is destined for the echo area, the advice function will +convert it to a string and pass it to COLLECTOR first." + (lambda (func object &optional printcharfun) + (if (not (eq t (or printcharfun standard-output))) + (funcall func object printcharfun) + (funcall collector (with-output-to-string + (funcall func object))) + (funcall func object printcharfun)))) (provide 'ert-x) From 0bf066d4b25c694cca6b1d24ac0aadc2b9ae05b1 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Thu, 21 Sep 2017 13:36:08 -0700 Subject: [PATCH 43/81] Add tests for Edebug * tests/lisp/emacs-lisp/edeug-tests.el: New file. * tests/lisp/emacs-lisp/edebug-resources/edebug-test-code.el: New file. --- .../edebug-resources/edebug-test-code.el | 130 +++ test/lisp/emacs-lisp/edebug-tests.el | 903 ++++++++++++++++++ 2 files changed, 1033 insertions(+) create mode 100644 test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el create mode 100644 test/lisp/emacs-lisp/edebug-tests.el diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el new file mode 100644 index 00000000000..0cc7b1e8b4e --- /dev/null +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -0,0 +1,130 @@ +;;; edebug-test-code.el --- Sample code for the Edebug test suite + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; This file contains sample code used by edebug-tests.el. +;; Before evaluation, it will be preprocessed by +;; `edebug-tests-setup-code-file' which will remove all tags +;; between !'s and save their positions for use by the tests. + +;;; Code: + +(defun edebug-test-code-fac (n) + !start!(if !step!(< 0 n) + (* n (edebug-test-code-fac (1- n)))!mult! + 1)) + +(defun edebug-test-code-concat (a b flag) + !start!(if flag!flag! + !then-start!(concat a!then-a! b!then-b!)!then-concat! + !else-start!(concat b!else-b! a!else-a!)!else-concat!)!if!) + +(defun edebug-test-code-range (num) + !start!(let ((index 0) + (result nil)) + (while (< index num)!test! + (push index result)!loop! + (cl-incf index))!end-loop! + (nreverse result))) + +(defun edebug-test-code-choices (input) + !start!(cond + ((eq input 0) "zero") + ((eq input 7) 42) + (t !edebug!(edebug)))) + +(defvar edebug-test-code-total nil) + +(defun edebug-test-code-multiply (times value) + !start!(setq edebug-test-code-total 0) + (cl-dotimes (index times) + (setq edebug-test-code-total (+ edebug-test-code-total value))!setq!) + edebug-test-code-total) + +(defun edebug-test-code-format-vector-node (node) + !start!(concat "[" + (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply! + "]")) + +(defun edebug-test-code-format-list-node (node) + !start!(concat "{" + (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply! + "}")) + +(defun edebug-test-code-format-node (node) + !start!(cond + (!vectorp!(vectorp node!vnode!)!vtest! !vbefore!(edebug-test-code-format-vector-node node)) + ((listp node) (edebug-test-code-format-list-node node)) + (t (format "%s" node)))) + +(defvar edebug-test-code-flavor "strawberry") + +(defmacro edebug-test-code-with-flavor (new-flavor &rest body) + (declare (debug (form body)) + (indent 1)) + `(let ((edebug-test-code-flavor ,new-flavor)) + ,@body)) + +(defun edebug-test-code-try-flavors () + (let* (tried) + (push edebug-test-code-flavor tried) + !macro!(edebug-test-code-with-flavor "chocolate" + (push edebug-test-code-flavor tried)) + tried)!end!) + +(unless (featurep 'edebug-tests-nutty)!nutty! + !setq!(setq edebug-test-code-flavor (car (edebug-test-code-try-flavors)))!end-setq!)!end-unless! + +(cl-defgeneric edebug-test-code-emphasize (x)) +(cl-defmethod edebug-test-code-emphasize ((x integer)) + !start!(format "The number is not %s or %s, but %s!" + (1+ x) (1- x) x)) +(cl-defmethod edebug-test-code-emphasize ((x string)) + !start!(format "***%s***" x)) + +(defun edebug-test-code-use-methods () + (list + !number!(edebug-test-code-emphasize 100) + !string!(edebug-test-code-emphasize "yes"))) + +(defun edebug-test-code-make-lambda (n) + (lambda (x) (+ x!x! n))) + +(defun edebug-test-code-use-lambda () + !start!(mapcar (edebug-test-code-make-lambda 10) '(1 2 3))) + +(defun edebug-test-code-circular-read-syntax () + '(#1=a . #1#)) + +(defun edebug-test-code-hash-read-syntax () + !start!(list #("abcd" 1 3 (face italic)) + #x01ff)) + +(defun edebug-test-code-empty-string-list () + !start!(list "")!step!) + +(defun edebug-test-code-current-buffer () + !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*") + !body!(format "current-buffer: %s" (current-buffer)))) + +(provide 'edebug-test-code) +;;; edebug-test-code.el ends here diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el new file mode 100644 index 00000000000..037278e772c --- /dev/null +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -0,0 +1,903 @@ +;;; edebug-tests.el --- Edebug test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; These tests focus on Edebug's user interface for setting +;; breakpoints, stepping through and tracing code, and evaluating +;; values used by the code. In addition there are some tests of +;; Edebug's reader. There are large parts of Edebug's functionality +;; not covered by these tests, including coverage testing, macro +;; specifications, and the eval list buffer. + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'ert-x) +(require 'edebug) +(require 'kmacro) + +;; Use `eval-and-compile' because this is used by the macro +;; `edebug-tests-deftest'. +(eval-and-compile + (defvar edebug-tests-sample-code-file + (expand-file-name + "edebug-resources/edebug-test-code.el" + (file-name-directory (or (bound-and-true-p byte-compile-current-file) + load-file-name + buffer-file-name))) + "Name of file containing code samples for Edebug tests.")) + +(defvar edebug-tests-temp-file nil + "Name of temp file containing sample code stripped of stop point symbols.") +(defvar edebug-tests-stop-points nil + "An alist of alists mapping function symbol -> stop point name -> marker. +Used by the tests to refer to locations in `edebug-tests-temp-file'.") +(defvar edebug-tests-messages nil + "Messages collected during execution of the current test.") + +(defvar edebug-tests-@-result 'no-result + "Return value of `edebug-tests-func', or no-result if there isn't one yet.") + +(defvar edebug-tests-failure-in-post-command nil + "An error trapped in `edebug-tests-post-command'. +Since `should' failures which happen inside `post-command-hook' will +be trapped by the command loop, this preserves them until we get +back to the top level.") + +(defvar edebug-tests-keymap + (let ((map (make-sparse-keymap))) + (define-key map "@" 'edebug-tests-call-instrumented-func) + (define-key map "C-u" 'universal-argument) + (define-key map "C-p" 'previous-line) + (define-key map "C-n" 'next-line) + (define-key map "C-b" 'backward-char) + (define-key map "C-a" 'move-beginning-of-line) + (define-key map "C-e" 'move-end-of-line) + (define-key map "C-k" 'kill-line) + (define-key map "M-x" 'execute-extended-command) + (define-key map "C-M-x" 'eval-defun) + (define-key map "C-x X b" 'edebug-set-breakpoint) + (define-key map "C-x X w" 'edebug-where) + map) + "Keys used by the keyboard macros in Edebug's tests.") + +;;; Macros for defining tests: + +(defmacro edebug-tests-with-default-config (&rest body) + "Create a consistent environment for an Edebug test BODY to run in." + (declare (debug (body))) + `(cl-letf* ( + ;; These defcustoms are set to their original value. + (edebug-setup-hook nil) + (edebug-all-defs nil) + (edebug-all-forms nil) + (edebug-eval-macro-args nil) + (edebug-save-windows t) + (edebug-save-displayed-buffer-points nil) + (edebug-initial-mode 'step) + (edebug-trace nil) + (edebug-test-coverage nil) + (edebug-print-length 50) + (edebug-print-level 50) + (edebug-print-circle t) + (edebug-unwrap-results nil) + (edebug-on-error t) + (edebug-on-quit t) + (edebug-global-break-condition nil) + (edebug-sit-for-seconds 1) + + ;; sit-on interferes with keyboard macros. + (edebug-sit-on-break nil) + (edebug-continue-kbd-macro t)) + ,@body)) + +(defmacro edebug-tests-with-normal-env (&rest body) + "Set up the environment for an Edebug test BODY, run it, and clean up." + (declare (debug (body))) + `(edebug-tests-with-default-config + (let ((edebug-tests-failure-in-post-command nil) + (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el"))) + (edebug-tests-setup-code-file edebug-tests-temp-file) + (ert-with-message-capture + edebug-tests-messages + (unwind-protect + (with-current-buffer (find-file edebug-tests-temp-file) + (read-only-mode) + (setq lexical-binding t) + (eval-buffer) + ,@body + (when edebug-tests-failure-in-post-command + (signal (car edebug-tests-failure-in-post-command) + (cdr edebug-tests-failure-in-post-command)))) + (unload-feature 'edebug-test-code) + (with-current-buffer (find-file-noselect edebug-tests-temp-file) + (set-buffer-modified-p nil)) + (ignore-errors (kill-buffer (find-file-noselect + edebug-tests-temp-file))) + (ignore-errors (delete-file edebug-tests-temp-file))))))) + +;; The following macro and its support functions implement an extension +;; to keyboard macros to allow interleaving of keyboard macro +;; events with evaluation of Lisp expressions. The Lisp expressions +;; are called from within `post-command-hook', which is a strategy +;; inspired by `kmacro-step-edit-macro'. + +;; Some of the details necessary to get this to work with Edebug are: +;; -- ERT's `should' macros raise errors, and errors within +;; `post-command-hook' are trapped by the command loop. The +;; workaround is to trap and save an error inside the hook +;; function and reraise it after the macro exits. +;; -- `edebug-continue-kbd-macro' must be non-nil. +;; -- Edebug calls `exit-recursive-edit' which turns off keyboard +;; macro execution. Solved with an advice wrapper for +;; `exit-recursive-edit' which preserves the keyboard macro state. + +(defmacro edebug-tests-run-kbd-macro (&rest macro) + "Run a MACRO consisting of both keystrokes and test assertions. +MACRO should be a list, where each item is either a keyboard +macro segment (in string or vector form) or a Lisp expression. +Convert the macro segments into keyboard macros and execute them. +After the execution of the last event of each segment, evaluate +the Lisp expressions following the segment." + (let ((prepared (edebug-tests-prepare-macro macro))) + `(edebug-tests-run-macro ,@prepared))) + +;; Make support functions for edebug-tests-run-kbd-macro +;; available at compile time. +(eval-and-compile + (defun edebug-tests-prepare-macro (macro) + "Prepare a MACRO for execution. +MACRO should be a list containing strings, vectors, and Lisp +forms. Convert the strings and vectors to keyboard macros in +vector representation and concatenate them to make a single +keyboard macro. Also build a list of the same length as the +number of events in the keyboard macro. Each item in that list +will contain the code to evaluate after the corresponding event +in the keyboard macro, either nil or a thunk built from the forms +in the original list. Return a list containing the keyboard +macro as the first item, followed by the list of thunks and/or +nils." + (cl-loop + for item = (pop macro) + while item + for segment = (read-kbd-macro item) + for thunk = (edebug-tests-wrap-thunk + (cl-loop + for form in macro + until (or (stringp form) (vectorp form)) + collect form + do (pop macro))) + vconcat segment into segments + append (edebug-tests-pad-thunk-list (length segment) thunk) + into thunk-list + + finally return (cons segments thunk-list))) + + (defun edebug-tests-wrap-thunk (body) + "If BODY is non-nil, wrap it with a lambda form." + (when body + `(lambda () ,@body))) + + (defun edebug-tests-pad-thunk-list (length thunk) + "Return a list with LENGTH elements with THUNK in the last position. +All other elements will be nil." + (let ((thunk-seg (make-list length nil))) + (setf (car (last thunk-seg)) thunk) + thunk-seg))) + +;;; Support for test execution: + +(defvar edebug-tests-thunks nil + "List containing thunks to run after each command in a keyboard macro.") +(defvar edebug-tests-kbd-macro-index nil + "Index into `edebug-tests-run-unpacked-kbd-macro's current keyboard macro.") + +(defun edebug-tests-run-macro (kbdmac &rest thunks) + "Run a keyboard macro and execute a thunk after each command in it. +KBDMAC should be a vector of events and THUNKS a list of the +same length containing thunks and/or nils. Run the macro, and +after the execution of every command in the macro (which may not +be the same as every keystroke) execute the thunk at the same +index." + (let* ((edebug-tests-thunks thunks) + (edebug-tests-kbd-macro-index 0) + saved-local-map) + (with-current-buffer (find-file-noselect edebug-tests-temp-file) + (setq saved-local-map overriding-local-map) + (setq overriding-local-map edebug-tests-keymap) + (add-hook 'post-command-hook 'edebug-tests-post-command)) + (advice-add 'exit-recursive-edit + :around 'edebug-tests-preserve-keyboard-macro-state) + (unwind-protect + (kmacro-call-macro nil nil nil kbdmac) + (advice-remove 'exit-recursive-edit + 'edebug-tests-preserve-keyboard-macro-state) + (with-current-buffer (find-file-noselect edebug-tests-temp-file) + (setq overriding-local-map saved-local-map) + (remove-hook 'post-command-hook 'edebug-tests-post-command))))) + +(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args) + "Call ORIG with ARGS preserving the value of `executing-kbd-macro'. +Useful to prevent `exit-recursive-edit' from stopping the current +keyboard macro." + (let ((executing-kbd-macro executing-kbd-macro)) + (apply orig args))) + +(defun edebug-tests-post-command () + "Run the thunk from `edebug-tests-thunks' matching the keyboard macro index." + (when (and edebug-tests-kbd-macro-index + (> executing-kbd-macro-index edebug-tests-kbd-macro-index)) + (let ((thunk (nth (1- executing-kbd-macro-index) edebug-tests-thunks))) + (when thunk + (condition-case err + (funcall thunk) + (error + (setq edebug-tests-failure-in-post-command err) + (signal (car err) (cdr err))))) + (setq edebug-tests-kbd-macro-index executing-kbd-macro-index)))) + +(defvar edebug-tests-func nil + "Instrumented function used to launch Edebug.") +(defvar edebug-tests-args nil + "Arguments for `edebug-tests-func'.") + +(defun edebug-tests-setup-@ (def-name args edebug-it) + "Set up the binding for @ in `edebug-tests-keymap'. +Find a definition for DEF-NAME in the current buffer and evaluate it. +Set globals so that `edebug-tests-call-instrumented-func' which +is bound to @ for edebug-tests' keyboard macros will call it with +ARGS. EDEBUG-IT is passed through to `eval-defun'." + (edebug-tests-locate-def def-name) + (eval-defun edebug-it) + (let* ((full-name (concat "edebug-test-code-" def-name)) + (sym (intern-soft full-name))) + (should (and sym (fboundp sym))) + (setq edebug-tests-func sym + edebug-tests-args args) + (setq edebug-tests-@-result 'no-result))) + +(defun edebug-tests-call-instrumented-func () + "Call `edebug-tests-func' with `edebug-tests-args' and save the results." + (interactive) + (let ((result (apply edebug-tests-func edebug-tests-args))) + (should (eq edebug-tests-@-result 'no-result)) + (setq edebug-tests-@-result result))) + +(defun edebug-tests-should-be-at (def-name point-name) + "Require that point be at the location in DEF-NAME named POINT-NAME. +DEF-NAME should be the suffix of a definition in the code samples +file (the part after \"edebug-tests\")." + (let ((stop-point (edebug-tests-get-stop-point def-name point-name))) + (should (eq (current-buffer) (find-file-noselect edebug-tests-temp-file))) + (should (eql (point) stop-point)))) + +(defun edebug-tests-get-stop-point (def-name point-name) + "Return the position in DEF-NAME of the stop point named POINT-NAME. +DEF-NAME should be the suffix of a definition in the code samples +file (the part after \"edebug-tests\")." + (let* ((full-name (concat "edebug-test-code-" def-name))(stop-point + (cdr (assoc point-name + (cdr (assoc full-name edebug-tests-stop-points)))))) + (unless stop-point + (ert-fail (format "%s not found in %s" point-name full-name))) + stop-point)) + +(defun edebug-tests-should-match-result-in-messages (value) + "Require that VALUE (a string) match an Edebug result in *Messages*. +Then clear edebug-tests' saved messages." + (should (string-match-p (concat "Result: " (regexp-quote value) "$") + edebug-tests-messages)) + (setq edebug-tests-messages "")) + +(defun edebug-tests-locate-def (def-name) + "Search for a definiton of DEF-NAME from the start of the current buffer. +Place point at the end of DEF-NAME in the buffer." + (goto-char (point-min)) + (re-search-forward (concat "def\\S-+ edebug-test-code-" def-name))) + +(defconst edebug-tests-start-of-next-def-regexp "^(\\S-*def\\S-+ \\(\\S-+\\)" + "Regexp used to match the start of a definition.") +(defconst edebug-tests-stop-point-regexp "!\\(\\S-+?\\)!" + "Regexp used to match a stop point annotation in the sample code.") + +;;; Set up buffer containing code samples: + +(defmacro edebug-tests-deduplicate (name names-and-numbers) + "Return a unique variation on NAME. +NAME should be a string and NAMES-AND-NUMBERS an alist which can +be used by this macro to retain state. If NAME for example is +\"symbol\" then the first and subsequent uses of this macro will +evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc." + (let ((g-name (gensym)) + (g-duplicate (gensym))) + `(let* ((,g-name ,name) + (,g-duplicate (assoc ,g-name ,names-and-numbers))) + (if (null ,g-duplicate) + (progn + (push (cons ,g-name 0) ,names-and-numbers) + ,g-name) + (cl-incf (cdr ,g-duplicate)) + (format "%s-%s" ,g-name (cdr ,g-duplicate)))))) + +(defun edebug-tests-setup-code-file (tmpfile) + "Extract stop points and loadable code from the sample code file. +Write the loadable code to a buffer for TMPFILE, and set +`edebug-tests-stop-points' to a map from defined symbols to stop +point names to positions in the file." + (with-current-buffer (find-file-noselect edebug-tests-sample-code-file) + (let ((marked-up-code (buffer-string))) + (with-temp-file tmpfile + (insert marked-up-code)))) + + (with-current-buffer (find-file-noselect tmpfile) + (let ((stop-points + ;; Delete all the !name! annotations from the code, but remember + ;; their names and where they were in an alist. + (cl-loop + initially (goto-char (point-min)) + while (re-search-forward edebug-tests-stop-point-regexp nil t) + for name = (match-string-no-properties 1) + do (replace-match "") + collect (cons name (point)))) + names-and-numbers) + + ;; Now build an alist mapping definition names to annotation + ;; names and positions. + ;; If duplicate symbols exist in the file, enter them in the + ;; alist as symbol, symbol-1, symbol-2 etc. + (setq edebug-tests-stop-points + (cl-loop + initially (goto-char (point-min)) + while (re-search-forward edebug-tests-start-of-next-def-regexp + nil t) + for name = + (edebug-tests-deduplicate (match-string-no-properties 1) + names-and-numbers) + for end-of-def = + (save-match-data + (save-excursion + (re-search-forward edebug-tests-start-of-next-def-regexp + nil 0) + (point))) + collect (cons name + (cl-loop + while (and stop-points + (< (cdar stop-points) end-of-def)) + collect (pop stop-points)))))))) + +;;; Tests + +(ert-deftest edebug-tests-check-keymap () + "Verify that `edebug-mode-map' is compatible with these tests. +If this test fails, one of two things is true. Either your +customizations modify `edebug-mode-map', in which case starting +Emacs with the -Q flag should fix the problem, or +`edebug-mode-map' has changed in edebug.el, in which case this +test and possibly others should be updated." + ;; The reason verify-keybinding is a macro instead of a function is + ;; that in the event of a failure, it makes the keybinding that + ;; failed show up in ERT's output. + (cl-macrolet ((verify-keybinding (key binding) + `(should (eq (lookup-key edebug-mode-map ,key) + ,binding)))) + (verify-keybinding " " 'edebug-step-mode) + (verify-keybinding "n" 'edebug-next-mode) + (verify-keybinding "g" 'edebug-go-mode) + (verify-keybinding "G" 'edebug-Go-nonstop-mode) + (verify-keybinding "t" 'edebug-trace-mode) + (verify-keybinding "T" 'edebug-Trace-fast-mode) + (verify-keybinding "c" 'edebug-continue-mode) + (verify-keybinding "C" 'edebug-Continue-fast-mode) + (verify-keybinding "f" 'edebug-forward-sexp) + (verify-keybinding "h" 'edebug-goto-here) + (verify-keybinding "I" 'edebug-instrument-callee) + (verify-keybinding "i" 'edebug-step-in) + (verify-keybinding "o" 'edebug-step-out) + (verify-keybinding "q" 'top-level) + (verify-keybinding "Q" 'edebug-top-level-nonstop) + (verify-keybinding "a" 'abort-recursive-edit) + (verify-keybinding "S" 'edebug-stop) + (verify-keybinding "b" 'edebug-set-breakpoint) + (verify-keybinding "u" 'edebug-unset-breakpoint) + (verify-keybinding "B" 'edebug-next-breakpoint) + (verify-keybinding "x" 'edebug-set-conditional-breakpoint) + (verify-keybinding "X" 'edebug-set-global-break-condition) + (verify-keybinding "r" 'edebug-previous-result) + (verify-keybinding "e" 'edebug-eval-expression) + (verify-keybinding "\C-x\C-e" 'edebug-eval-last-sexp) + (verify-keybinding "E" 'edebug-visit-eval-list) + (verify-keybinding "w" 'edebug-where) + (verify-keybinding "v" 'edebug-view-outside) ;; maybe obsolete?? + (verify-keybinding "p" 'edebug-bounce-point) + (verify-keybinding "P" 'edebug-view-outside) ;; same as v + (verify-keybinding "W" 'edebug-toggle-save-windows) + (verify-keybinding "?" 'edebug-help) + (verify-keybinding "d" 'edebug-backtrace) + (verify-keybinding "-" 'negative-argument) + (verify-keybinding "=" 'edebug-temp-display-freq-count))) + +(ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function () + "Edebug stops at the beginning of an instrumented function." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "fac" '(0) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "start") + "SPC" (edebug-tests-should-be-at "fac" "step") + "g" (should (equal edebug-tests-@-result 1))))) + +(ert-deftest edebug-tests-step-showing-evaluation-results () + "Edebug prints expression evaluation results to the echo area." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "concat" '("x" "y" nil) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "concat" "start") + "SPC" (edebug-tests-should-be-at "concat" "flag") + (edebug-tests-should-match-result-in-messages "nil") + "SPC" (edebug-tests-should-be-at "concat" "else-start") + "SPC" (edebug-tests-should-be-at "concat" "else-b") + (edebug-tests-should-match-result-in-messages "\"y\"") + "SPC" (edebug-tests-should-be-at "concat" "else-a") + (edebug-tests-should-match-result-in-messages "\"x\"") + "SPC" (edebug-tests-should-be-at "concat" "else-concat") + (edebug-tests-should-match-result-in-messages "\"yx\"") + "SPC" (edebug-tests-should-be-at "concat" "if") + (edebug-tests-should-match-result-in-messages "\"yx\"") + "SPC" (should (equal edebug-tests-@-result "yx"))))) + +(ert-deftest edebug-tests-set-breakpoint-at-point () + "Edebug can set a breakpoint at point." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "concat" '("x" "y" t) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "concat" "start") + "C-n C-e b C-n" ; Move down, set a breakpoint and move away. + "g" (edebug-tests-should-be-at "concat" "then-concat") + (edebug-tests-should-match-result-in-messages "\"xy\"") + "g" (should (equal edebug-tests-@-result "xy"))))) + +(ert-deftest edebug-tests-set-temporary-breakpoint-at-point () + "Edebug can set a temporary breakpoint at point." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(3) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "range" "start") + "C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop. + "C-u b" ; Set a temporary breakpoint. + "C-n" ; Move away. + "g" (edebug-tests-should-be-at "range" "loop") + (edebug-tests-should-match-result-in-messages "(0)") + "g" (should (equal edebug-tests-@-result '(0 1 2)))))) + +(ert-deftest edebug-tests-clear-breakpoint () + "Edebug can clear a breakpoint." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(3) t) + (edebug-tests-run-kbd-macro + "@" + (message "after @") + (edebug-tests-should-be-at "range" "start") + "C-n C-n C-n C-e b C-n" ; Move down, set a breakpoint and move away. + "g" (edebug-tests-should-be-at "range" "loop") + (edebug-tests-should-match-result-in-messages "(0)") + "g" (edebug-tests-should-be-at "range" "loop") + (edebug-tests-should-match-result-in-messages "(1 0)") + "u" ; Unset the breakpoint. + "g" (should (equal edebug-tests-@-result '(0 1 2)))))) + +(ert-deftest edebug-tests-move-point-to-next-breakpoint () + "Edebug can move point to the next breakpoint." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "concat" '("a" "b" nil) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "concat" "start") + "C-n C-e b" ; Move down, set a breakpoint. + "C-n b" ; Set another breakpoint on the next line. + "C-p C-p C-p" ; Move back up. + "B" (edebug-tests-should-be-at "concat" "then-concat") + "B" (edebug-tests-should-be-at "concat" "else-concat") + "G" (should (equal edebug-tests-@-result "ba"))))) + +(ert-deftest edebug-tests-move-point-back-to-stop-point () + "Edebug can move point back to a stop point." + (edebug-tests-with-normal-env + (let ((test-buffer (get-buffer-create "edebug-tests-temp"))) + (edebug-tests-setup-@ "fac" '(4) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "start") + "C-n w" (edebug-tests-should-be-at "fac" "start") + (pop-to-buffer test-buffer) + "C-x X w" (edebug-tests-should-be-at "fac" "start") + "g" (should (equal edebug-tests-@-result 24))) + (ignore-errors (kill-buffer test-buffer))))) + +(ert-deftest edebug-tests-jump-to-point () + "Edebug can stop at a temporary breakpoint at point." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(3) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "range" "start") + "C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop. + "h" (edebug-tests-should-be-at "range" "loop") + (edebug-tests-should-match-result-in-messages "(0)") + "g" (should (equal edebug-tests-@-result '(0 1 2)))))) + +(ert-deftest edebug-tests-jump-forward-one-sexp () + "Edebug can run the program for one expression." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(3) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "range" "start") + "SPC SPC f" (edebug-tests-should-be-at "range" "test") + "g" (should (equal edebug-tests-@-result '(0 1 2)))))) + +(ert-deftest edebug-tests-run-out-of-containing-sexp () + "Edebug can run the program until the end of the containing sexp." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(3) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "range" "start") + "SPC SPC f" (edebug-tests-should-be-at "range" "test") + "o" (edebug-tests-should-be-at "range" "end-loop") + (edebug-tests-should-match-result-in-messages "nil") + "g" (should (equal edebug-tests-@-result '(0 1 2)))))) + +(ert-deftest edebug-tests-observe-breakpoint-in-source () + "Edebug will stop at a breakpoint embedded in source code." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "choices" '(8) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "choices" "start") + "g" (edebug-tests-should-be-at "choices" "edebug") + "g" (should (equal edebug-tests-@-result nil))))) + +(ert-deftest edebug-tests-set-conditional-breakpoint () + "Edebug can set and observe a conditional breakpoint." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "fac" '(5) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "start") + ;; Set conditional breakpoint at end of next line. + "C-n C-e x (eql SPC n SPC 3) RET" + "g" (edebug-tests-should-be-at "fac" "mult") + (edebug-tests-should-match-result-in-messages "6 (#o6, #x6, ?\\C-f)") + "g" (should (equal edebug-tests-@-result 120))))) + +(ert-deftest edebug-tests-error-trying-to-set-breakpoint-in-uninstrumented-code + () + "Edebug refuses to set a breakpoint in uninsented code." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "fac" '(5) t) + (let* ((debug-on-error nil) + (edebug-on-error nil) + error-message + (command-error-function (lambda (&rest args) + (setq error-message (cadar args))))) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "start") + "C-u 10 C-n" ; Move down and out of instrumented function. + "b" (should (string-match-p "Not inside instrumented form" + error-message)) + ;; The error stopped the keyboard macro. Start it again. + (should-not executing-kbd-macro) + (setq executing-kbd-macro t) + "g")))) + +(ert-deftest edebug-tests-set-and-break-on-global-condition () + "Edebug can break when a global condition becomes true." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "multiply" '(5 3) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "multiply" "start") + "X (> SPC edebug-test-code-total SPC 10) RET" + (should edebug-global-break-condition) + "g" (edebug-tests-should-be-at "multiply" "setq") + (should (eql (symbol-value 'edebug-test-code-total) 12)) + "X C-a C-k nil RET" ; Remove suggestion before entering nil. + "g" (should (equal edebug-tests-@-result 15))))) + +(ert-deftest edebug-tests-trace-showing-results-at-stop-points () + "Edebug can trace execution, showing results at stop points." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "concat" '("x" "y" nil) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "concat" "start") + "T" (should (string-match-p + (concat "Result: nil\n.*?" + "Result: \"y\"\n.*?" + "Result: \"x\"\n.*?" + "Result: \"yx\"\n.*?" + "Result: \"yx\"\n") + edebug-tests-messages)) + (should (equal edebug-tests-@-result "yx"))))) + +(ert-deftest edebug-tests-trace-showing-results-at-breakpoints () + "Edebug can trace execution, showing results at breakpoints." + (edebug-tests-with-normal-env + (edebug-tests-locate-def "format-vector-node") + (edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b") + (edebug-tests-locate-def "format-list-node") + (edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b") + (edebug-tests-setup-@ "format-node" '(([a b] [c d])) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "format-node" "start") + "C" (should (string-match-p + (concat "Result: \"ab\"\n.*?" + "Result: \"cd\"\n.*?" + "Result: \"\\[ab]\\[cd]\"\n") + edebug-tests-messages)) + (should (equal edebug-tests-@-result "{[ab][cd]}"))))) + +(ert-deftest edebug-tests-trace-function-call-and-return () + "Edebug can create a trace of function calls and returns." + (edebug-tests-with-normal-env + (edebug-tests-locate-def "format-vector-node") + (eval-defun t) + (edebug-tests-locate-def "format-list-node") + (eval-defun t) + (edebug-tests-setup-@ "format-node" '((a [b])) t) + (let ((edebug-trace t) + (trace-start (with-current-buffer + (get-buffer-create edebug-trace-buffer) (point-max)))) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "format-node" "start") + "g" (should (equal edebug-tests-@-result "{a[b]}"))) + (with-current-buffer edebug-trace-buffer + (should (string= + "{ edebug-test-code-format-node args: ((a [b])) +:{ edebug-test-code-format-list-node args: ((a [b])) +::{ edebug-test-code-format-node args: (a) +::} edebug-test-code-format-node result: a +::{ edebug-test-code-format-node args: ([b]) +:::{ edebug-test-code-format-vector-node args: ([b]) +::::{ edebug-test-code-format-node args: (b) +::::} edebug-test-code-format-node result: b +:::} edebug-test-code-format-vector-node result: [b] +::} edebug-test-code-format-node result: [b] +:} edebug-test-code-format-list-node result: {a[b]} +} edebug-test-code-format-node result: {a[b]} +" (buffer-substring trace-start (point-max)))))))) + +(ert-deftest edebug-tests-evaluate-expressions () + "Edebug can evaluate an expression in the context outside of itself." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "range" '(2) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "range" "start") + "SPC SPC f" (edebug-tests-should-be-at "range" "test") + (edebug-tests-should-match-result-in-messages "t") + "e (- SPC num SPC index) RET" + ;; Edebug just prints the result without "Result:" + (should (string-match-p + (regexp-quote "2 (#o2, #x2, ?\\C-b)") + edebug-tests-messages)) + "g" (should (equal edebug-tests-@-result '(0 1)))) + + ;; Do it again with lexical-binding turned off. + (setq lexical-binding nil) + (eval-buffer) + (should-not lexical-binding) + (edebug-tests-setup-@ "range" '(2) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "range" "start") + "SPC SPC f" (edebug-tests-should-be-at "range" "test") + (edebug-tests-should-match-result-in-messages "t") + "e (- SPC num SPC index) RET" + ;; Edebug just prints the result without "Result:" + (should (string-match-p + (regexp-quote "2 (#o2, #x2, ?\\C-b)") + edebug-tests-messages)) + "g" (should (equal edebug-tests-@-result '(0 1)))))) + +(ert-deftest edebug-tests-step-into-function () + "Edebug can step into a function." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "format-node" '([b]) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "format-node" "start") + "SPC SPC SPC SPC" + (edebug-tests-should-be-at "format-node" "vbefore") + "i" (edebug-tests-should-be-at "format-vector-node" "start") + "g" (should (equal edebug-tests-@-result "[b]"))))) + +(ert-deftest edebug-tests-error-stepping-into-subr () + "Edebug refuses to step into a C function." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "format-node" '([b]) t) + (let* ((debug-on-error nil) + (edebug-on-error nil) + error-message + (command-error-function (lambda (&rest args) + (setq error-message (cl-cadar args))))) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "format-node" "start") + "SPC" (edebug-tests-should-be-at "format-node" "vectorp") + "i" (should (string-match-p "vectorp is a built-in function" + error-message)) + ;; The error stopped the keyboard macro. Start it again. + (should-not executing-kbd-macro) + (setq executing-kbd-macro t) + "g" (should (equal edebug-tests-@-result "[b]")))))) + +(ert-deftest edebug-tests-step-into-macro-error () + "Edebug gives an error on trying to step into a macro (Bug#26847)." + :expected-result :failed + (ert-fail "Forcing failure because letting this test run aborts the others.") + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "try-flavors" nil t) + (let* ((debug-on-error nil) + (edebug-on-error nil) + (error-message "") + (command-error-function (lambda (&rest args) + (setq error-message (cl-cadar args))))) + (edebug-tests-run-kbd-macro + "@ SPC SPC SPC SPC SPC" + (edebug-tests-should-be-at "try-flavors" "macro") + "i" (should (string-match-p "edebug-test-code-try-flavors is a macro" + error-message)) + ;; The error stopped the keyboard macro. Start it again. + (should-not executing-kbd-macro) + (setq executing-kbd-macro t) + "g" (should (equal edebug-tests-@-result + '("chocolate" "strawberry"))))))) + +(ert-deftest edebug-tests-step-into-generic-method () + "Edebug can step into a generic method (Bug#22294)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "use-methods" nil t) + (edebug-tests-run-kbd-macro + "@ SPC" (edebug-tests-should-be-at "use-methods" "number") + "i" (edebug-tests-should-be-at "emphasize-1" "start") + "gg" (should (equal edebug-tests-@-result + '("The number is not 101 or 99, but 100!" + "***yes***")))))) + +(ert-deftest edebug-tests-break-in-lambda-out-of-defining-context () + "Edebug observes a breakpoint in a lambda executed out of defining context." + (edebug-tests-with-normal-env + (edebug-tests-locate-def "make-lambda") + (eval-defun t) + (goto-char (edebug-tests-get-stop-point "make-lambda" "x")) + (edebug-set-breakpoint t) + (edebug-tests-setup-@ "use-lambda" nil t) + (edebug-tests-run-kbd-macro + "@g" (edebug-tests-should-be-at "make-lambda" "x") + (edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)") + "g" (should (equal edebug-tests-@-result '(11 12 13)))))) + +(ert-deftest edebug-tests-respects-initial-mode () + "Edebug can stop first at breakpoint instead of first instrumented function." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "fac" '(4) t) + (goto-char (edebug-tests-get-stop-point "fac" "mult")) + (edebug-set-breakpoint t) + (setq edebug-initial-mode 'go) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "mult") + (edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)") + "G" (should (equal edebug-tests-@-result 24))))) + +(ert-deftest edebug-tests-step-through-non-definition () + "Edebug can step through a non-defining form." + (edebug-tests-with-normal-env + (goto-char (edebug-tests-get-stop-point "try-flavors" "end-unless")) + (edebug-tests-run-kbd-macro + "C-u C-M-x" + "SPC SPC" (edebug-tests-should-be-at "try-flavors" "nutty") + (edebug-tests-should-match-result-in-messages "nil") + "SPC" (edebug-tests-should-be-at "try-flavors" "setq") + "f" (edebug-tests-should-be-at "try-flavors" "end-setq") + (edebug-tests-should-match-result-in-messages "\"chocolate\"") + "g"))) + +(ert-deftest edebug-tests-conditional-breakpoints-can-use-lexical-variables () + "Edebug can set a conditional breakpoint using a lexical variable. Bug#12685" + (edebug-tests-with-normal-env + (should lexical-binding) + (edebug-tests-setup-@ "fac" '(5) t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at "fac" "start") + ;; Set conditional breakpoint at end of next line. + "C-n C-e x (eql SPC n SPC 3) RET" + "g" (edebug-tests-should-be-at "fac" "mult") + (edebug-tests-should-match-result-in-messages + "6 (#o6, #x6, ?\\C-f)")))) + +(ert-deftest edebug-tests-writable-buffer-state-is-preserved () + "On Edebug exit writable buffers are still writable (Bug#14144)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "choices" '(0) t) + (read-only-mode -1) + (edebug-tests-run-kbd-macro + "@g" (should (equal edebug-tests-@-result "zero"))) + (barf-if-buffer-read-only))) + +(ert-deftest edebug-tests-list-containing-empty-string-result-printing () + "Edebug correctly prints a list containing only an empty string (Bug#17934)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "empty-string-list" nil t) + (edebug-tests-run-kbd-macro + "@ SPC" (edebug-tests-should-be-at + "empty-string-list" "step") + (edebug-tests-should-match-result-in-messages "(\"\")") + "g"))) + +(ert-deftest edebug-tests-evaluation-of-current-buffer-bug-19611 () + "Edebug can evaluate `current-buffer' in correct context. (Bug#19611)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "current-buffer" nil t) + (edebug-tests-run-kbd-macro + "@" (edebug-tests-should-be-at + "current-buffer" "start") + "SPC SPC SPC" (edebug-tests-should-be-at + "current-buffer" "body") + "e (current-buffer) RET" + ;; Edebug just prints the result without "Result:" + (should (string-match-p + (regexp-quote "*edebug-test-code-buffer*") + edebug-tests-messages)) + "g" (should (equal edebug-tests-@-result + "current-buffer: *edebug-test-code-buffer*"))))) + +(ert-deftest edebug-tests-trivial-backquote () + "Edebug can instrument a trivial backquote expression (Bug#23651)." + (edebug-tests-with-normal-env + (read-only-mode -1) + (delete-region (point-min) (point-max)) + (insert "`1") + (read-only-mode) + (edebug-eval-defun nil) + (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)") + edebug-tests-messages)) + (setq edebug-tests-messages "") + + (setq edebug-initial-mode 'go) + ;; In Bug#23651 Edebug would hang reading `1. + (edebug-eval-defun t))) + +(ert-deftest edebug-tests-trivial-comma () + "Edebug can read a trivial comma expression (Bug#23651)." + (edebug-tests-with-normal-env + (read-only-mode -1) + (delete-region (point-min) (point-max)) + (insert ",1") + (read-only-mode) + (should-error (edebug-eval-defun t)))) + +(ert-deftest edebug-tests-circular-read-syntax () + "Edebug can instrument code using circular read object syntax (Bug#23660)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "circular-read-syntax" nil t) + (edebug-tests-run-kbd-macro + "@" (should (eql (car edebug-tests-@-result) + (cdr edebug-tests-@-result)))))) + +(ert-deftest edebug-tests-hash-read-syntax () + "Edebug can instrument code which uses # read syntax (Bug#25068)." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "hash-read-syntax" nil t) + (edebug-tests-run-kbd-macro + "@g" (should (equal edebug-tests-@-result + '(#("abcd" 1 3 (face italic)) 511)))))) + +(provide 'edebug-tests) +;;; edebug-tests.el ends here From a81d5a3d3fcb76f6b074c2c721b80b1802135d41 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Thu, 21 Sep 2017 21:53:30 +0100 Subject: [PATCH 44/81] Revert "Set frame size to actual requested size (bug#18215)" This reverts commit d31cd79b40dbd5459b16505a4ee4340210499277. See bug#28536. I misunderstood bug#18215. It wasn't a bug. --- src/nsterm.m | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index 776635980e1..a41d6be2045 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1820,8 +1820,8 @@ x_set_window_size (struct frame *f, if (pixelwise) { - pixelwidth = width; - pixelheight = height; + pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width); + pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height); } else { From d24ec5854098841388dfecf2c668e7f48f348af0 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Thu, 21 Sep 2017 22:47:24 -0400 Subject: [PATCH 45/81] Expose viewing conditions in CAM02-UCS metric Also add tests from the colorspacious library. Finally, catch an errant calculation, where degrees were not being converted to radians. * src/lcms.c (deg2rad, default_viewing_conditions): (parse_viewing_conditions): New functions. (lcms-cam02-ucs): Add comments pointing to references used. Expand the docstring and explain viewing conditions. JCh hue is given in degrees and needs to be converted to radians. (lcms-d65-xyz): Remove. No need to duplicate this in Lisp or make the API needlessly impure. * test/src/lcms-tests.el: Reword commentary. (lcms-rgb255->xyz): New function. (lcms-cri-cam02-ucs): Fix let-binding. (lcms-dE-cam02-ucs-silver): New test, assimilated from colorspacious. --- src/lcms.c | 107 ++++++++++++++++++++++++++++++++--------- test/src/lcms-tests.el | 37 ++++++++++++-- 2 files changed, 116 insertions(+), 28 deletions(-) diff --git a/src/lcms.c b/src/lcms.c index f543a030399..a5e527911ef 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -139,6 +139,26 @@ chroma, and hue, respectively. The parameters each default to 1. */) return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh)); } +static double +deg2rad (double degrees) +{ + return M_PI * degrees / 180.0; +} + +static cmsCIEXYZ illuminant_d65 = { .X = 95.0455, .Y = 100.0, .Z = 108.8753 }; + +static void +default_viewing_conditions (const cmsCIEXYZ *wp, cmsViewingConditions *vc) +{ + vc->whitePoint.X = wp->X; + vc->whitePoint.Y = wp->Y; + vc->whitePoint.Z = wp->Z; + vc->Yb = 20; + vc->La = 100; + vc->surround = AVG_SURROUND; + vc->D_value = 1.0; +} + /* FIXME: code duplication */ static bool @@ -160,11 +180,62 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) return true; } -DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, +static bool +parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, + cmsViewingConditions *vc) +{ +#define PARSE_VIEW_CONDITION_FLOAT(field) \ + if (CONSP (view) && NUMBERP (XCAR (view))) \ + { \ + vc->field = XFLOATINT (XCAR (view)); \ + view = XCDR (view); \ + } \ + else \ + return false; +#define PARSE_VIEW_CONDITION_INT(field) \ + if (CONSP (view) && NATNUMP (XCAR (view))) \ + { \ + CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \ + vc->field = XINT (XCAR (view)); \ + view = XCDR (view); \ + } \ + else \ + return false; + + PARSE_VIEW_CONDITION_FLOAT (Yb); + PARSE_VIEW_CONDITION_FLOAT (La); + PARSE_VIEW_CONDITION_INT (surround); + PARSE_VIEW_CONDITION_FLOAT (D_value); + + if (! NILP (view)) + return false; + + vc->whitePoint.X = wp->X; + vc->whitePoint.Y = wp->Y; + vc->whitePoint.Z = wp->Z; + return true; +} + +/* References: + Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research + and application, 37 No.3, 2012. + Luo et al. "Uniform colour spaces based on CIECAM02 colour appearance + model." COLOR research and application, 31 No.4, 2006. */ + +DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 4, 0, doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. -Each color is a list of XYZ coordinates, with Y scaled about unity. -Optional argument is the XYZ white point, which defaults to illuminant D65. */) - (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) +Each color is a list of XYZ tristimulus values, with Y scaled about unity. +Optional argument WHITEPOINT is the XYZ white point, which defaults to +illuminant D65. +Optional argument VIEW is a list containing the viewing conditions, and +is of the form (YB LA SURROUND DVALUE) where SURROUND corresponds to + 1 AVG_SURROUND + 2 DIM_SURROUND + 3 DARK_SURROUND + 4 CUTSHEET_SURROUND +The default viewing conditions are (20 100 1 1). */) + (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint, + Lisp_Object view) { cmsViewingConditions vc; cmsJCh jch1, jch2; @@ -188,17 +259,13 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2))) signal_error ("Invalid color", color2); if (NILP (whitepoint)) - parse_xyz_list (Vlcms_d65_xyz, &xyzw); + xyzw = illuminant_d65; else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) signal_error ("Invalid white point", whitepoint); - - vc.whitePoint.X = xyzw.X; - vc.whitePoint.Y = xyzw.Y; - vc.whitePoint.Z = xyzw.Z; - vc.Yb = 20; - vc.La = 100; - vc.surround = AVG_SURROUND; - vc.D_value = 1.0; + if (NILP (view)) + default_viewing_conditions (&xyzw, &vc); + else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc))) + signal_error ("Invalid view conditions", view); h1 = cmsCIECAM02Init (0, &vc); h2 = cmsCIECAM02Init (0, &vc); @@ -227,10 +294,10 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) Mp2 = 43.86 * log (1.0 + 0.0228 * (jch2.C * sqrt (sqrt (FL)))); Jp1 = 1.7 * jch1.J / (1.0 + (0.007 * jch1.J)); Jp2 = 1.7 * jch2.J / (1.0 + (0.007 * jch2.J)); - ap1 = Mp1 * cos (jch1.h); - ap2 = Mp2 * cos (jch2.h); - bp1 = Mp1 * sin (jch1.h); - bp2 = Mp2 * sin (jch2.h); + ap1 = Mp1 * cos (deg2rad (jch1.h)); + ap2 = Mp2 * cos (deg2rad (jch2.h)); + bp1 = Mp1 * sin (deg2rad (jch1.h)); + bp2 = Mp2 * sin (deg2rad (jch2.h)); return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) + (ap2 - ap1) * (ap2 - ap1) + @@ -291,12 +358,6 @@ DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0, void syms_of_lcms2 (void) { - DEFVAR_LISP ("lcms-d65-xyz", Vlcms_d65_xyz, - doc: /* D65 illuminant as a CIE XYZ triple. */); - Vlcms_d65_xyz = list3 (make_float (0.950455), - make_float (1.0), - make_float (1.088753)); - defsubr (&Slcms_cie_de2000); defsubr (&Slcms_cam02_ucs); defsubr (&Slcms2_available_p); diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 3d0942c8d15..d6d1d16b9ad 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -21,9 +21,11 @@ ;;; Commentary: -;; Some "exact" values computed using the colorspacious python library -;; written by Nathaniel J. Smith. See -;; https://colorspacious.readthedocs.io/en/v1.1.0/ +;; Some reference values computed using the colorspacious python +;; library, assimilated from its test suite, or adopted from its +;; aggregation of gold values. +;; See https://colorspacious.readthedocs.io/en/v1.1.0/ and +;; https://github.com/njsmith/colorspacious ;; Other references: ;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf @@ -49,6 +51,11 @@ B is considered the exact value." (lcms-approx-p a2 b2 delta) (lcms-approx-p a3 b3 delta)))) +(defun lcms-rgb255->xyz (rgb) + "Return XYZ tristimulus values corresponding to RGB." + (let ((rgb1 (mapcar (lambda (x) (/ x 255.0)) rgb))) + (apply #'color-srgb-to-xyz rgb1))) + (ert-deftest lcms-cri-cam02-ucs () "Test use of `lcms-cam02-ucs'." (skip-unless (featurep 'lcms2)) @@ -56,8 +63,8 @@ B is considered the exact value." (should-error (lcms-cam02-ucs '(0 0 0) 'error)) (should-not (lcms-approx-p - (let ((lcms-d65-xyz '(0.44757 1.0 0.40745))) - (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))) + (let ((wp '(0.44757 1.0 0.40745))) + (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0) wp)) (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0)))) (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5)))) (should @@ -87,4 +94,24 @@ B is considered the exact value." (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504)) '(0.29902 0.31485 1.0)))) +(ert-deftest lcms-dE-cam02-ucs-silver () + "Test CRI-CAM02-UCS deltaE metric values from colorspacious." + (skip-unless (featurep 'lcms2)) + (should + (lcms-approx-p + (lcms-cam02-ucs (lcms-rgb255->xyz '(173 52 52)) + (lcms-rgb255->xyz '(59 120 51)) + lcms-colorspacious-d65 + (list 20 (/ 64 float-pi 5) 1 1)) + 44.698469808449964 + 0.03)) + (should + (lcms-approx-p + (lcms-cam02-ucs (lcms-rgb255->xyz '(69 100 52)) + (lcms-rgb255->xyz '(59 120 51)) + lcms-colorspacious-d65 + (list 20 (/ 64 float-pi 5) 1 1)) + 8.503323264883667 + 0.04))) + ;;; lcms-tests.el ends here From 0273916618f33ffd56b861cea187e9df337b8e2d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Sep 2017 12:41:00 +0300 Subject: [PATCH 46/81] Document the 'list-FOO' convention * doc/lispref/tips.texi (Coding Conventions): Document the list-FOO convention. --- doc/lispref/tips.texi | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index bed3bed95bd..17fd4a1027e 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -68,10 +68,13 @@ costs.}. Use two hyphens to separate prefix and name if the symbol is not meant to be used by other packages. Occasionally, for a command name intended for users to use, it is more -convenient if some words come before the package's name prefix. And -constructs that define functions, variables, etc., work better if they -start with @samp{defun} or @samp{defvar}, so put the name prefix later -on in the name. +convenient if some words come before the package's name prefix. For +example, it is our convention to have commands that list objects named +as @samp{list-@var{something}}, e.g., a package called @samp{frob} +could have a command @samp{list-frobs}, when its other global symbols +begin with @samp{frob-}. Also, constructs that define functions, +variables, etc., work better if they start with @samp{defun} or +@samp{defvar}, so put the name prefix later on in the name. This recommendation applies even to names for traditional Lisp primitives that are not primitives in Emacs Lisp---such as From 51cbd85454f6febb635b806dd759c4d054a43552 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Sep 2017 16:40:59 +0300 Subject: [PATCH 47/81] Improve syntax highlighting in bat-mode * lisp/progmodes/bat-mode.el (bat-font-lock-keywords): Improve font-locking of environment variables. Suggested by Achim Gratz . (Bug#28311) (Bug#18405) --- lisp/progmodes/bat-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index f4852fe5b6b..e06b8e830b9 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -84,11 +84,11 @@ . 'bat-label-face) ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" (2 font-lock-variable-name-face)) - ("%\\(\\(\\sw\\|\\s_\\)+\\)%" + ("%\\([^% \n]+\\)%?" (1 font-lock-variable-name-face)) - ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable! + ("!\\([^!% \n]+\\)!?" ; delayed-expansion !variable! (1 font-lock-variable-name-face)) - ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)" + ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\|_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)" (1 font-lock-variable-name-face nil t) ; PATH expansion (2 font-lock-variable-name-face)) ; iteration variable or positional parameter ("[ =][-/]+\\(\\w+\\)" From 908af46abdb2c19ff3c72543e4fadf8e0ed82d2b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Sep 2017 17:52:47 +0300 Subject: [PATCH 48/81] Fix restoring in GUI sessions desktop saved in TTY sessions * lisp/frameset.el (frameset-filter-font-param): New function. (frameset-persistent-filter-alist): Use it for processing the 'font' frame parameter. (Bug#17352) --- lisp/frameset.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/frameset.el b/lisp/frameset.el index 661f0aee273..593451a4d75 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -447,7 +447,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (buffer-predicate . :never) (buried-buffer-list . :never) (delete-before . :never) - (font . frameset-filter-shelve-param) + (font . frameset-filter-font-param) (foreground-color . frameset-filter-sanitize-color) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) @@ -631,6 +631,17 @@ see `frameset-filter-alist'." (setcdr found val) nil)))) +(defun frameset-filter-font-param (current filtered parameters saving + &optional prefix) + "When switching from a tty frame to a GUI frame, remove the FONT param. + +When switching from a GUI frame to a tty frame, behave +as `frameset-filter-shelve-param' does." + (or saving + (if (frameset-switch-to-gui-p parameters) + (frameset-filter-shelve-param current filtered parameters saving + prefix)))) + (defun frameset-filter-iconified (_current _filtered parameters saving) "Remove CURRENT when saving an iconified frame. This is used for positional parameters `left' and `top', which are From d64da52d57b068da630ba5eb606cae9421de19e9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 22 Sep 2017 20:41:10 +0300 Subject: [PATCH 49/81] Fix last change in bat-mode.el * lisp/progmodes/bat-mode.el (bat-font-lock-keywords): Fix last change. (Bug#28311) --- lisp/progmodes/bat-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index e06b8e830b9..102c3186200 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -84,9 +84,9 @@ . 'bat-label-face) ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" (2 font-lock-variable-name-face)) - ("%\\([^% \n]+\\)%?" + ("%\\([^%~ \n]+\\)%?" (1 font-lock-variable-name-face)) - ("!\\([^!% \n]+\\)!?" ; delayed-expansion !variable! + ("!\\([^!%~ \n]+\\)!?" ; delayed-expansion !variable! (1 font-lock-variable-name-face)) ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\|_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)" (1 font-lock-variable-name-face nil t) ; PATH expansion From f656ccdb4384564001ae181c66f2a242bc31a849 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Fri, 22 Sep 2017 16:34:31 -0400 Subject: [PATCH 50/81] ; Fix typo * lisp/emacs-lisp/subr-x.el: Nix extra parenthesis. --- lisp/emacs-lisp/subr-x.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 077ad22c75d..edba6550fa2 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -128,7 +128,7 @@ binding value is nil. If all are non-nil, the value of THEN is returned, or the last form in ELSE is returned. Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds -SYMBOL to the value of VALUEFORM). An element can additionally +SYMBOL to the value of VALUEFORM. An element can additionally be of the form (VALUEFORM), which is evaluated and checked for nil; i.e. SYMBOL can be omitted if only the test result is of interest." From 0e143b1fc5d716cbc4509b416a1067b417df2676 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Sep 2017 10:07:11 +0300 Subject: [PATCH 51/81] Documentation improvements for 'display-line-numbers' * doc/emacs/display.texi (Display Custom): Document a few more options for display-line-numbers. (Bug#28533) Fix a typo. --- doc/emacs/display.texi | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2aa79e1161a..f074e989bc0 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1756,7 +1756,7 @@ Any other non-@code{nil} value is treated as @code{t}. @vindex display-line-numbers-type A convenient way of turning on display of line numbers is @w{@kbd{M-x display-line-numbers-mode @key{RET}}}. This mode has a globalized -variant, @code{global-display-line0numbers-mode}. The user option +variant, @code{global-display-line-numbers-mode}. The user option @code{display-line-numbers-type} controls which sub-mode of line-number display, described above, will these modes activate. @@ -1778,6 +1778,17 @@ the variable @code{display-line-numbers-widen} to a non-@code{nil} value, line numbers will disregard any narrowing and will start at the first character of the buffer. +@vindex display-line-numbers-width-start +@vindex display-line-numbers-grow-only +@vindex display-line-numbers-width +In selective display mode (@pxref{Selective Display}), and other modes +that hide many lines from display (such as Outline and Org modes), you +may wish to customize the variables +@code{display-line-numbers-width-start} and +@code{display-line-numbers-grow-only}, or set +@code{display-line-numbers-width} to a large enough value, to avoid +occasional miscalculations of space reserved for the line numbers. + @cindex line-number face The line numbers are displayed in a special face @code{line-number}. The current line number is displayed in a different face, From f2b2201594b59ff758347644a84cdc8f6b046ec9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 23 Sep 2017 00:34:01 -0700 Subject: [PATCH 52/81] ; Spelling and URL fixes --- ChangeLog.2 | 4 ++-- ChangeLog.3 | 8 ++++---- etc/NEWS | 2 +- lisp/calendar/cal-tex.el | 2 +- lisp/emacs-lisp/ert-x.el | 2 +- lisp/org/ChangeLog.1 | 4 ++-- test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el | 2 +- test/lisp/emacs-lisp/edebug-tests.el | 6 +++--- test/lisp/vc/smerge-mode-tests.el | 2 +- 9 files changed, 16 insertions(+), 16 deletions(-) diff --git a/ChangeLog.2 b/ChangeLog.2 index bd1800b3307..e789722a4d6 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -4808,7 +4808,7 @@ Link from (emacs)Exiting to (lisp)Killing Emacs * doc/emacs/entering.texi (Exiting): Link to the lispref - manual for further customisations (bug#15445). + manual for further customizations (bug#15445). (cherry picked from commit bc5f27aa099cdde02ca66e71501b89300685ab28) @@ -7845,7 +7845,7 @@ 2016-02-20 Lars Ingebrigtsen - Allow customising the article mode cursor behavior + Allow customizing the article mode cursor behavior * doc/misc/gnus.texi (HTML): Mention gnus-article-show-cursor. diff --git a/ChangeLog.3 b/ChangeLog.3 index 9f43511991c..9e622cef90f 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -12949,7 +12949,7 @@ Link from (emacs)Exiting to (lisp)Killing Emacs * doc/emacs/entering.texi (Exiting): Link to the lispref - manual for further customisations (bug#15445). + manual for further customizations (bug#15445). 2016-04-29 Lars Ingebrigtsen @@ -13159,7 +13159,7 @@ Move the diff command to "Operate" in ibuffer * lisp/ibuffer.el (ibuffer-mode-operate-map): Move the diff - command to the "Operate" menu, and remove the customisation + command to the "Operate" menu, and remove the customization entry to make the "View" menu more logical (bug#1150). 2016-04-27 Lars Ingebrigtsen @@ -16589,7 +16589,7 @@ really changed. (save_window_save): Set the pixel_height_before_size_change and pixel_width_before_size_change fields. - (Vwindow_size_change_functions): Move here definiton from xdisp.c. + (Vwindow_size_change_functions): Move here definition from xdisp.c. * src/xdisp.c (prepare_menu_bars, redisplay_internal): Call run_window_size_change_functions. (Vwindow_size_change_functions): Move definition to window.c. @@ -16842,7 +16842,7 @@ 5d17ae7 Improve file-notify-test08-watched-file-in-watched-dir 1cb1268 Fix todo-mode item date editing bugs 1e996cf Fix "[:upper:]" for non-ASCII characters - 896f993 Allow customising the article mode cursor behavior + 896f993 Allow customizing the article mode cursor behavior 24c1c1d Use pop-to-buffer-same-window in woman.el 2a75f64 New filenotify test for bug#22736 c9bccf7 Report critical battery errors diff --git a/etc/NEWS b/etc/NEWS index 280ab64f37c..34561acae56 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1893,7 +1893,7 @@ of frame decorations on macOS 10.9+. ** Mousewheel and trackpad scrolling on macOS 10.7+ now behaves more like the macOS default. The new variables 'ns-use-system-mwheel-acceleration', 'ns-touchpad-scroll-line-height' -and 'ns-touchpad-use-momentum' can be used to customise the behavior. +and 'ns-touchpad-use-momentum' can be used to customize the behavior. ---------------------------------------------------------------------- diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 72db03e5e60..1d295606f23 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -266,7 +266,7 @@ specified in ARGS. When ARGS is omitted, by default the option \"12pt,a4paper\" is passed. When ARGS has any other value, then no option is passed to the class. -Insert the \"\\usepacakge{geometry}\" directive when ARGS +Insert the \"\\usepackage{geometry}\" directive when ARGS contains the \"landscape\" string." (set-buffer (generate-new-buffer cal-tex-buffer)) (save-match-data diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 5af5262e5da..71d46c11077 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -328,7 +328,7 @@ to the real `message'." (funcall func "%s" msg))))) (defun ert--make-print-advice (collector) - "Create around advice for print functions for `ert-collect-messsges'. + "Create around advice for print functions for `ert-collect-messages'. The created advice function will just call the original function unless the output is going to the echo area (when PRINTCHARFUN is t or PRINTCHARFUN is nil and `standard-output' is t). If the diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index 366a3ee9fcd..ee50f6fb040 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -5015,10 +5015,10 @@ * ox-latex.el (org-latex-listings): Update docstring. * org-pcomplete.el (pcomplete/org-mode/file-option/options): - Apply changes to export back-end definiton. + Apply changes to export back-end definition. * org.el (org-get-export-keywords): Apply changes to export - back-end definiton. + back-end definition. * ox-html.el (org-html--format-toc-headline): Make use of anonymous back-ends. diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index 0cc7b1e8b4e..f52a2b1896c 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -17,7 +17,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 037278e772c..02f4d1c5abe 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -17,7 +17,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see . ;;; Commentary: @@ -310,7 +310,7 @@ Then clear edebug-tests' saved messages." (setq edebug-tests-messages "")) (defun edebug-tests-locate-def (def-name) - "Search for a definiton of DEF-NAME from the start of the current buffer. + "Search for a definition of DEF-NAME from the start of the current buffer. Place point at the end of DEF-NAME in the buffer." (goto-char (point-min)) (re-search-forward (concat "def\\S-+ edebug-test-code-" def-name))) @@ -584,7 +584,7 @@ test and possibly others should be updated." (ert-deftest edebug-tests-error-trying-to-set-breakpoint-in-uninstrumented-code () - "Edebug refuses to set a breakpoint in uninsented code." + "Edebug refuses to set a breakpoint in uninstrumented code." (edebug-tests-with-normal-env (edebug-tests-setup-@ "fac" '(5) t) (let* ((debug-on-error nil) diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el index 204a4b93ab5..10d090632da 100644 --- a/test/lisp/vc/smerge-mode-tests.el +++ b/test/lisp/vc/smerge-mode-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . +;; along with GNU Emacs. If not, see . ;;; Code: From 820739bbb572b30b6ce45756c9960e48dca859af Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Sep 2017 10:45:46 +0300 Subject: [PATCH 53/81] ; * doc/emacs/display.texi (Display Custom): Fix wording. --- doc/emacs/display.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index f074e989bc0..6afd8366b25 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1745,7 +1745,7 @@ invisible parts of text), and lines which wrap to consume more than one screen line will be numbered that many times. The displayed numbers are relative, as with @code{relative} value above. This is handy in modes that fold text, such as Outline mode (@pxref{Outline -Mode}), and need to move by exact number of screen lines. +Mode}), and when you need to move by exact number of screen lines. @item anything else Any other non-@code{nil} value is treated as @code{t}. From 00e4e3e9d273a193620c3a4bb4914e555cb8e343 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 23 Sep 2017 19:43:58 +0100 Subject: [PATCH 54/81] Fix undecorated frame resizing issues on NS (bug#28512) * src/nsterm.m (EmacsView::updateFrameSize): Don't wait for the toolbar on undecorated frames. (EmacsView::initFrameFromEmacs): Group window flags correctly. --- src/nsterm.m | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index a41d6be2045..fb3ebc963e7 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6824,9 +6824,10 @@ not_in_argv (NSString *arg) if (wait_for_tool_bar) { - /* The toolbar height is always 0 in fullscreen, so don't wait - for it to become available. */ + /* The toolbar height is always 0 in fullscreen and undecorated + frames, so don't wait for it to become available. */ if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0 + && FRAME_UNDECORATED (emacsframe) == false && ! [self isFullscreen]) { NSTRACE_MSG ("Waiting for toolbar"); @@ -7207,9 +7208,9 @@ not_in_argv (NSString *arg) win = [[EmacsWindow alloc] initWithContentRect: r - styleMask: (FRAME_UNDECORATED (f) - ? FRAME_UNDECORATED_FLAGS - : FRAME_DECORATED_FLAGS + styleMask: ((FRAME_UNDECORATED (f) + ? FRAME_UNDECORATED_FLAGS + : FRAME_DECORATED_FLAGS) #ifdef NS_IMPL_COCOA | NSWindowStyleMaskResizable | NSWindowStyleMaskMiniaturizable From d93301242f38d3d9aaa55899c07496f0bdecf391 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 24 Sep 2017 19:32:16 +0200 Subject: [PATCH 55/81] Document 'replace-buffer-contents' in the manual. * doc/lispref/text.texi (Replacing): New node. --- doc/lispref/text.texi | 24 ++++++++++++++++++++++++ etc/NEWS | 1 - 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index a7d10797cd0..baa3c708e90 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -54,6 +54,8 @@ the character after point. * Registers:: How registers are implemented. Accessing the text or position stored in a register. * Transposition:: Swapping two portions of a buffer. +* Replacing:: Replacing the text of one buffer with the text + of another buffer. * Decompression:: Dealing with compressed data. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. @@ -4328,6 +4330,28 @@ is non-@code{nil}, @code{transpose-regions} does not do this---it leaves all markers unrelocated. @end defun +@node Replacing +@section Replacing Buffer Text + + You can use the following function to replace the text of one buffer +with the text of another buffer: + +@deffn Command replace-buffer-contents source +This function replaces the accessible portion of the current buffer +with the accessible portion of the buffer @var{source}. @var{source} +may either be a buffer object or the name of a buffer. When +@code{replace-buffer-contents} succeeds, the text of the accessible +portion of the current buffer will be equal to the text of the +accessible portion of the @var{source} buffer. This function attempts +to keep point, markers, text properties, and overlays in the current +buffer intact. One potential case where this behavior is useful is +external code formatting programs: they typically write the +reformatted text into a temporary buffer or file, and using +@code{delete-region} and @code{insert-buffer-substring} would destroy +these properties. However, the latter combination is typically +faster. @xref{Deletion}, and @ref{Insertion}. +@end deffn + @node Decompression @section Dealing With Compressed Data diff --git a/etc/NEWS b/etc/NEWS index 34561acae56..fc4531f0e85 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -578,7 +578,6 @@ Negative prefix arg flips the direction of selection. Also, defun are selected unless they are separated from the defun by a blank line. ---- ** New command 'replace-buffer-contents'. This command replaces the contents of the accessible portion of the current buffer with the contents of the accessible portion of a From 638f64c40a678c26d78a7d7279e6356e6e92f3fd Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sun, 24 Sep 2017 22:35:21 +0100 Subject: [PATCH 56/81] Improve new NS scrolling variable names * src/nsterm.m (ns-use-system-mwheel-acceleration): Replace with 'ns-use-mwheel-acceleration'. (ns-touchpad-scroll-line-height): Replace with 'ns-mwheel-line-height'. (ns-touchpad-use-momentum): Replace with 'ns-use-mwheel-momentum'. * etc/NEWS: Change variable names. --- etc/NEWS | 6 +++--- src/nsterm.m | 28 ++++++++++++++-------------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index fc4531f0e85..19a68933c0b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1890,9 +1890,9 @@ of frame decorations on macOS 10.9+. --- ** Mousewheel and trackpad scrolling on macOS 10.7+ now behaves more -like the macOS default. The new variables -'ns-use-system-mwheel-acceleration', 'ns-touchpad-scroll-line-height' -and 'ns-touchpad-use-momentum' can be used to customize the behavior. +like the macOS default. The new variables 'ns-mwheel-line-height', +'ns-use-mwheel-acceleration' and 'ns-use-mwheel-momentum' can be used +to customize the behavior. ---------------------------------------------------------------------- diff --git a/src/nsterm.m b/src/nsterm.m index fb3ebc963e7..f0b6a70dae3 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6520,7 +6520,7 @@ not_in_argv (NSString *arg) /* FIXME: At the top or bottom of the buffer we should * ignore momentum-phase events. */ - if (! ns_touchpad_use_momentum + if (! ns_use_mwheel_momentum && [theEvent momentumPhase] != NSEventPhaseNone) return; @@ -6529,8 +6529,8 @@ not_in_argv (NSString *arg) static int totalDeltaX, totalDeltaY; int lineHeight; - if (NUMBERP (ns_touchpad_scroll_line_height)) - lineHeight = XINT (ns_touchpad_scroll_line_height); + if (NUMBERP (ns_mwheel_line_height)) + lineHeight = XINT (ns_mwheel_line_height); else { /* FIXME: Use actual line height instead of the default. */ @@ -6571,7 +6571,7 @@ not_in_argv (NSString *arg) totalDeltaX = 0; } - if (lines > 1 && ! ns_use_system_mwheel_acceleration) + if (lines > 1 && ! ns_use_mwheel_acceleration) lines = 1; } else @@ -6589,7 +6589,7 @@ not_in_argv (NSString *arg) delta = [theEvent scrollingDeltaY]; } - lines = (ns_use_system_mwheel_acceleration) + lines = (ns_use_mwheel_acceleration) ? ceil (fabs (delta)) : 1; scrollUp = delta > 0; @@ -9284,22 +9284,22 @@ Note that this does not apply to images. This variable is ignored on Mac OS X < 10.7 and GNUstep. */); ns_use_srgb_colorspace = YES; - DEFVAR_BOOL ("ns-use-system-mwheel-acceleration", - ns_use_system_mwheel_acceleration, + DEFVAR_BOOL ("ns-use-mwheel-acceleration", + ns_use_mwheel_acceleration, doc: /*Non-nil means use macOS's standard mouse wheel acceleration. This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); - ns_use_system_mwheel_acceleration = YES; + ns_use_mwheel_acceleration = YES; - DEFVAR_LISP ("ns-touchpad-scroll-line-height", ns_touchpad_scroll_line_height, - doc: /*The number of pixels touchpad scrolling considers a line. + DEFVAR_LISP ("ns-mwheel-line-height", ns_mwheel_line_height, + doc: /*The number of pixels touchpad scrolling considers one line. Nil or a non-number means use the default frame line height. This variable is ignored on macOS < 10.7 and GNUstep. Default is nil. */); - ns_touchpad_scroll_line_height = Qnil; + ns_mwheel_line_height = Qnil; - DEFVAR_BOOL ("ns-touchpad-use-momentum", ns_touchpad_use_momentum, - doc: /*Non-nil means touchpad scrolling uses momentum. + DEFVAR_BOOL ("ns-use-mwheel-momentum", ns_use_mwheel_momentum, + doc: /*Non-nil means mouse wheel scrolling uses momentum. This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); - ns_touchpad_use_momentum = YES; + ns_use_mwheel_momentum = YES; /* TODO: move to common code */ DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, From 3d3778d82a87139ef50a24146f5bad2a57a82094 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 24 Sep 2017 14:01:21 -0700 Subject: [PATCH 57/81] Accept new `always' value for option `buffer-offer-save' Also revert ee512e9a82 * lisp/files.el (buffer-offer-save): In addition to nil and t, now allows a third symbol value, `always'. A buffer where this option is set to `always' will always be offered for save by `save-some-buffers'. (save-some-buffers): Check the exact value of this buffer-local variable. No longer check the buffer name, or the value of `write-contents-functions'. * doc/lispref/buffers.texi (Killing Buffers): Note change in manual. * doc/lispref/files.texi (Saving Buffers): Remove note about buffer names. * etc/NEWS: Mention in NEWS. --- doc/lispref/buffers.texi | 15 +++++++++------ doc/lispref/files.texi | 3 +-- etc/NEWS | 8 ++++++-- lisp/files.el | 19 ++++++++++--------- 4 files changed, 26 insertions(+), 19 deletions(-) diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index cf24a730ba6..0d02cb3d3e9 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -1089,12 +1089,15 @@ is not cleared by changing major modes. @defopt buffer-offer-save This variable, if non-@code{nil} in a particular buffer, tells -@code{save-buffers-kill-emacs} and @code{save-some-buffers} (if the -second optional argument to that function is @code{t}) to offer to -save that buffer, just as they offer to save file-visiting buffers. -@xref{Definition of save-some-buffers}. The variable -@code{buffer-offer-save} automatically becomes buffer-local when set -for any reason. @xref{Buffer-Local Variables}. +@code{save-buffers-kill-emacs} to offer to save that buffer, just as +it offers to save file-visiting buffers. If @code{save-some-buffers} +is called with the second optional argument set to @code{t}, it will +also offer to save the buffer. Lastly, if this variable is set to the +symbol @code{always}, both @code{save-buffers-kill-emacs} and +@code{save-some-buffers} will always offer to save. @xref{Definition +of save-some-buffers}. The variable @code{buffer-offer-save} +automatically becomes buffer-local when set for any reason. +@xref{Buffer-Local Variables}. @end defopt @defvar buffer-save-without-query diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index b1b858a6b4b..f49b02de97c 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -368,8 +368,7 @@ With an argument of 0, unconditionally do @emph{not} make any backup file. This command saves some modified file-visiting buffers. Normally it asks the user about each buffer. But if @var{save-silently-p} is non-@code{nil}, it saves all the file-visiting buffers without -querying the user. Additionally, buffers whose name begins with a -space (``internal'' buffers) will not be offered for save. +querying the user. @vindex save-some-buffers-default-predicate The optional @var{pred} argument provides a predicate that controls diff --git a/etc/NEWS b/etc/NEWS index 19a68933c0b..040d265f75b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -117,6 +117,11 @@ The effect is similar to that of "toolBar" resource on the tool bar. * Changes in Emacs 26.1 ++++ +** Option 'buffer-offer-save' can be set to new value, 'always'. When + set to 'always', the command `save-some-buffers' will always offer + this buffer for saving. + ** Security vulnerability related to Enriched Text mode is removed. +++ @@ -144,8 +149,7 @@ init file: 'save-buffer' process. Previously, saving a buffer that was not visiting a file would always prompt for a file name. Now it only does so if 'write-contents-functions' is nil (or all its functions return -nil). A non-nil buffer-local value for this variable is sufficient -for 'save-some-buffers' to consider the buffer for saving. +nil). --- ** New variable 'executable-prefix-env' for inserting magic signatures. diff --git a/lisp/files.el b/lisp/files.el index f0a1f2380d9..211457ac7d7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -150,8 +150,13 @@ Called with an absolute file name as argument, it returns t to enable backup.") (defcustom buffer-offer-save nil "Non-nil in a buffer means always offer to save buffer on exit. Do so even if the buffer is not visiting a file. -Automatically local in all buffers." - :type 'boolean +Automatically local in all buffers. + +Set to the symbol `always' to offer to save buffer whenever +`save-some-buffers' is called." + :type '(choice (const :tag "Never" nil) + (const :tag "On Emacs exit" t) + (const :tag "Whenever save-some-buffers is called" always)) :group 'backup) (make-variable-buffer-local 'buffer-offer-save) (put 'buffer-offer-save 'permanent-local t) @@ -5188,15 +5193,11 @@ change the additional actions you can take on files." (and (buffer-live-p buffer) (buffer-modified-p buffer) (not (buffer-base-buffer buffer)) - (not (eq (aref (buffer-name buffer) 0) ?\s)) (or (buffer-file-name buffer) - (and pred - (progn - (set-buffer buffer) - (and buffer-offer-save (> (buffer-size) 0)))) - (buffer-local-value - 'write-contents-functions buffer)) + (with-current-buffer buffer + (or (eq buffer-offer-save 'always) + (and pred buffer-offer-save (> (buffer-size) 0))))) (or (not (functionp pred)) (with-current-buffer buffer (funcall pred))) (if arg From dc6b3560e56c83b3e3191a3d95d31fe288181742 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 25 Sep 2017 10:09:32 +0200 Subject: [PATCH 58/81] Fix documentation of `make-frame' and related variables and hooks * lisp/frame.el (before-make-frame-hook) (after-make-frame-functions, frame-inherited-parameters) (make-frame): Fix doc-strings. * doc/lispref/frames.texi (Creating Frames): Fix description of `make-frame' and related variables and hooks. --- doc/lispref/frames.texi | 56 ++++++++++++++++++++++++----------------- lisp/frame.el | 20 +++++++-------- 2 files changed, 42 insertions(+), 34 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 6431bbdedb9..f66ecee8e8e 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -112,37 +112,39 @@ window of another Emacs frame. @xref{Child Frames}. * Display Feature Testing:: Determining the features of a terminal. @end menu + @node Creating Frames @section Creating Frames @cindex frame creation To create a new frame, call the function @code{make-frame}. -@deffn Command make-frame &optional alist +@deffn Command make-frame &optional parameters This function creates and returns a new frame, displaying the current buffer. -The @var{alist} argument is an alist that specifies frame parameters -for the new frame. @xref{Frame Parameters}. If you specify the -@code{terminal} parameter in @var{alist}, the new frame is created on -that terminal. Otherwise, if you specify the @code{window-system} -frame parameter in @var{alist}, that determines whether the frame -should be displayed on a text terminal or a graphical terminal. -@xref{Window Systems}. If neither is specified, the new frame is -created in the same terminal as the selected frame. +The @var{parameters} argument is an alist that specifies frame +parameters for the new frame. @xref{Frame Parameters}. If you specify +the @code{terminal} parameter in @var{parameters}, the new frame is +created on that terminal. Otherwise, if you specify the +@code{window-system} frame parameter in @var{parameters}, that +determines whether the frame should be displayed on a text terminal or a +graphical terminal. @xref{Window Systems}. If neither is specified, +the new frame is created in the same terminal as the selected frame. -Any parameters not mentioned in @var{alist} default to the values in -the alist @code{default-frame-alist} (@pxref{Initial Parameters}); +Any parameters not mentioned in @var{parameters} default to the values +in the alist @code{default-frame-alist} (@pxref{Initial Parameters}); parameters not specified there default from the X resources or its equivalent on your operating system (@pxref{X Resources,, X Resources, -emacs, The GNU Emacs Manual}). After the frame is created, Emacs -applies any parameters listed in @code{frame-inherited-parameters} -(see below) and not present in the argument, taking the values from -the frame that was selected when @code{make-frame} was called. +emacs, The GNU Emacs Manual}). After the frame is created, this +function applies any parameters specified in +@code{frame-inherited-parameters} (see below) it has no assigned yet, +taking the values from the frame that was selected when +@code{make-frame} was called. Note that on multi-monitor displays (@pxref{Multiple Terminals}), the window manager might position the frame differently than specified by -the positional parameters in @var{alist} (@pxref{Position +the positional parameters in @var{parameters} (@pxref{Position Parameters}). For example, some window managers have a policy of displaying the frame on the monitor that contains the largest part of the window (a.k.a.@: the @dfn{dominating} monitor). @@ -158,20 +160,28 @@ A normal hook run by @code{make-frame} before it creates the frame. @end defvar @defvar after-make-frame-functions -An abnormal hook run by @code{make-frame} after it creates the frame. -Each function in @code{after-make-frame-functions} receives one argument, the -frame just created. +An abnormal hook run by @code{make-frame} after it created the frame. +Each function in @code{after-make-frame-functions} receives one +argument, the frame just created. @end defvar +Note that any functions added to these hooks by your initial file are +usually not run for the initial frame, since Emacs reads the initial +file only after creating that frame. However, if the initial frame is +specified to use a separate minibuffer frame (@pxref{Minibuffers and +Frames}), the functions will be run for both, the minibuffer-less and +the minibuffer frame. + @defvar frame-inherited-parameters This variable specifies the list of frame parameters that a newly created frame inherits from the currently selected frame. For each -parameter (a symbol) that is an element in the list and is not present -in the argument to @code{make-frame}, the function sets the value of -that parameter in the created frame to its value in the selected -frame. +parameter (a symbol) that is an element in this list and has not been +assigned earlier when processing @code{make-frame}, the function sets +the value of that parameter in the created frame to its value in the +selected frame. @end defvar + @node Multiple Terminals @section Multiple Terminals @cindex multiple terminals diff --git a/lisp/frame.el b/lisp/frame.el index 5f0e97d5b07..76c1842455c 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -604,11 +604,12 @@ new frame." (select-frame (make-frame)))) (defvar before-make-frame-hook nil - "Functions to run before a frame is created.") + "Functions to run before `make-frame' creates a new frame.") (defvar after-make-frame-functions nil - "Functions to run after a frame is created. -The functions are run with one arg, the newly created frame.") + "Functions to run after `make-frame' created a new frame. +The functions are run with one argument, the newly created +frame.") (defvar after-setting-font-hook nil "Functions to run after a frame's font has been changed.") @@ -617,7 +618,7 @@ The functions are run with one arg, the newly created frame.") (define-obsolete-function-alias 'new-frame 'make-frame "22.1") (defvar frame-inherited-parameters '() - "Parameters `make-frame' copies from the `selected-frame' to the new frame.") + "Parameters `make-frame' copies from the selected to the new frame.") (defvar x-display-name) @@ -632,9 +633,6 @@ form (NAME . VALUE), for example: (width . NUMBER) The frame should be NUMBER characters in width. (height . NUMBER) The frame should be NUMBER text lines high. -You cannot specify either `width' or `height', you must specify -neither or both. - (minibuffer . t) The frame should have a minibuffer. (minibuffer . nil) The frame should have no minibuffer. (minibuffer . only) The frame should contain only a minibuffer. @@ -650,10 +648,10 @@ neither or both. In addition, any parameter specified in `default-frame-alist', but not present in PARAMETERS, is applied. -Before creating the frame (via `frame-creation-function-alist'), -this function runs the hook `before-make-frame-hook'. After -creating the frame, it runs the hook `after-make-frame-functions' -with one arg, the newly created frame. +Before creating the frame (via `frame-creation-function'), this +function runs the hook `before-make-frame-hook'. After creating +the frame, it runs the hook `after-make-frame-functions' with one +argument, the newly created frame. If a display parameter is supplied and a window-system is not, guess the window-system from the display. From c7a0c137770be2ff5378a6c545fdea2d26e010f0 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Mon, 25 Sep 2017 08:44:23 -0400 Subject: [PATCH 59/81] * lisp/xdg.el (xdg-thumb-uri): Fix doc string. --- lisp/xdg.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/xdg.el b/lisp/xdg.el index e94fa8ec924..e962cd21a6c 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -84,7 +84,7 @@ (defun xdg-thumb-uri (filename) "Return the canonical URI for FILENAME. -If FILENAME has absolute path /foo/bar.jpg, its canonical URI is +If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is file:///foo/bar.jpg" (concat "file://" (expand-file-name filename))) From b719f6b20ba00c86d860be113d8a842bc384f2df Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Mon, 25 Sep 2017 08:45:08 -0400 Subject: [PATCH 60/81] Loosen strict parsing requirement for desktop files There are other desktop-looking files, for instance those having to do with MIME typess, that would benefit from being able to be read by this function. It helps to have some flexibility. * lisp/xdg.el (xdg-desktop-read-file): Remove an error condition. * test/lisp/xdg-tests.el: Remove a test. --- lisp/xdg.el | 2 -- test/lisp/xdg-tests.el | 3 --- 2 files changed, 5 deletions(-) diff --git a/lisp/xdg.el b/lisp/xdg.el index e962cd21a6c..76106f42586 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -197,8 +197,6 @@ Optional argument GROUP defaults to the string \"Desktop Entry\"." (unless (looking-at xdg-desktop-group-regexp) (error "Expected group name! Instead saw: %s" (buffer-substring (point) (point-at-eol)))) - (unless (equal (match-string 1) "Desktop Entry") - (error "Wrong first group: %s" (match-string 1))) (when group (while (and (re-search-forward xdg-desktop-group-regexp nil t) (not (equal (match-string 1) group))))) diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index e3c9a743e44..b80f5e85524 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -40,9 +40,6 @@ (should (equal (gethash "Name" tab1) "Test")) (should (eq 'default (gethash "Exec" tab1 'default))) (should (equal "frobnicate" (gethash "Exec" tab2)))) - (should-error - (xdg-desktop-read-file - (expand-file-name "wrong.desktop" xdg-tests-data-dir))) (should-error (xdg-desktop-read-file (expand-file-name "malformed.desktop" xdg-tests-data-dir))) From 49cd561dc62ea6b3fbedab7aef0f020733f4cf09 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 25 Sep 2017 17:52:24 +0200 Subject: [PATCH 61/81] * test/lisp/tramp-tests.el (tramp-test21-file-links): Special code for smb. --- lisp/net/tramp-smb.el | 6 +++++- test/lisp/net/tramp-tests.el | 15 +++++++++------ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index ee6baaab121..35aa8110946 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -535,7 +535,7 @@ pass to the OPERATION." ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) (tramp-set-connection-property v "process-buffer" nil) - (when t1 (delete-directory tmpdir 'recurse)))) + (when t1 (delete-directory tmpdir 'recursive)))) ;; Handle KEEP-DATE argument. (when keep-date @@ -1583,6 +1583,10 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." "Read entries which match DIRECTORY. Either the shares are listed, or the `dir' command is executed. Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." + ;; If CIFS capabilities are enabled, symlinks are not listed + ;; by `dir'. This is a consequence of + ;; . See also + ;; . (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) (with-tramp-file-property v localname "file-entries" diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 88e97092ed7..bfdc3017804 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2653,8 +2653,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 (tramp--test-make-temp-name 'local quoted)) - (tmp-name4 (tramp--test-make-temp-name nil quoted))) - + (tmp-name4 (tramp--test-make-temp-name nil quoted)) + (tmp-name5 + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4))) ;; Check `make-symbolic-link'. (unwind-protect (tramp--test-ignore-make-symbolic-link-error @@ -2716,9 +2717,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (funcall (if quoted 'tramp-compat-file-name-unquote 'identity) (file-remote-p tmp-name1 'localname)) - (file-symlink-p - (expand-file-name - (file-name-nondirectory tmp-name1) tmp-name4))))) + (file-symlink-p tmp-name5))) + ;; `smbclient' does not show symlinks in directories, so + ;; we cannot delete a non-empty directory. We delete the + ;; file explicitely. + (delete-file tmp-name5)) ;; Cleanup. (ignore-errors @@ -2737,7 +2740,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (add-name-to-file tmp-name1 tmp-name2) :type 'file-already-exists) - ;; number means interactive case. + ;; A number means interactive case. (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) (should-error (add-name-to-file tmp-name1 tmp-name2 0) From 5a41dd0a1f317b36f86fb4e52db945385250c56e Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 26 Sep 2017 01:44:54 +0300 Subject: [PATCH 62/81] Reset default-directory inside *xref-grep* buffer * lisp/progmodes/xref.el (xref-collect-matches): Reset default-directory, too. (Bug#28575) --- lisp/progmodes/xref.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 623c9c4e07f..80cdcb3f18b 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -928,12 +928,14 @@ IGNORES is a list of glob patterns." files (expand-file-name dir) ignores)) + (def default-directory) (buf (get-buffer-create " *xref-grep*")) (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)) (status nil) (hits nil)) (with-current-buffer buf (erase-buffer) + (setq default-directory def) (setq status (call-process-shell-command command nil t)) (goto-char (point-min)) From 3a68dec32730eddfc066b3b9528f4bc63b5fa9f6 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 26 Sep 2017 02:25:03 +0300 Subject: [PATCH 63/81] ; Update NEWS for the change in eldoc-message --- etc/NEWS | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 040d265f75b..1b5ae658f6c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1353,6 +1353,12 @@ non-nil, but the code returned the list in the increasing order of priority instead. Now the code does what the documentation says it should do. +--- +** 'eldoc-message' only accepts one argument now. Programs that +called it with multiple arguments before should pass them through +'format' first. Even that is discouraged: for ElDoc support, you +should set 'eldoc-documentation-function' instead of calling +'eldoc-message' directly. * Lisp Changes in Emacs 26.1 From a58d0c590a777be98e58cd8c92ee1381e07e9b2d Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 30 Aug 2017 19:31:48 -0400 Subject: [PATCH 64/81] Fix loading of smie-config rules (Bug#24848) * lisp/emacs-lisp/smie.el (smie-config--setter): Use `set-default' instead of `setq-default'. (smie-config): Use `custom-initialize-set' instead of `custom-initialize-default' as the :initialize argument. * lisp/progmodes/sh-script.el (sh-learn-buffer-indent): Mention that we call `smie-config-guess' so that the user will have a chance to find the correct docstring to consult. Remove hedging comments regarding use of abnormal hooks. --- lisp/emacs-lisp/smie.el | 4 ++-- lisp/progmodes/sh-script.el | 8 +++++--- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 87c4782e217..da1e12b1408 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1956,7 +1956,7 @@ E.g. provided via a file-local call to `smie-config-local'.") (defvar smie-config--modefuns nil) (defun smie-config--setter (var value) - (setq-default var value) + (set-default var value) (let ((old-modefuns smie-config--modefuns)) (setq smie-config--modefuns nil) (pcase-dolist (`(,mode . ,rules) value) @@ -1982,7 +1982,7 @@ value with which to replace it." ;; FIXME improve value-type. :type '(choice (const nil) (alist :key-type symbol)) - :initialize 'custom-initialize-default + :initialize 'custom-initialize-set :set #'smie-config--setter) (defun smie-config-local (rules) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0bda8bc275d..f2027e37345 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -3594,6 +3594,10 @@ so that `occur-next' and `occur-prev' will work." (defun sh-learn-buffer-indent (&optional arg) "Learn how to indent the buffer the way it currently is. +If `sh-use-smie' is non-nil, call `smie-config-guess'. +Otherwise, run the sh-script specific indent learning command, as +decribed below. + Output in buffer \"*indent*\" shows any lines which have conflicting values of a variable, and the final value of all variables learned. When called interactively, pop to this buffer automatically if @@ -3610,8 +3614,7 @@ to the value of variable `sh-learn-basic-offset'. Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the function completes. The function is abnormal because it is called -with an alist of variables learned. This feature may be changed or -removed in the future. +with an alist of variables learned. This command can often take a long time to run." (interactive "P") @@ -3809,7 +3812,6 @@ This command can often take a long time to run." " has" "s have") (if (zerop num-diffs) "." ":")))))) - ;; Are abnormal hooks considered bad form? (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) (and (called-interactively-p 'any) (or sh-popup-occur-buffer (> num-diffs 0)) From f5e72b04d930215f6e770e2fe9e02ad6debf03ad Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 30 Aug 2017 19:42:47 -0400 Subject: [PATCH 65/81] Make sh-indentation into an alias for sh-basic-offset (Bug#21751) * lisp/progmodes/sh-script.el (sh-indentation): Redefine as obsolete variable alias for `sh-basic-offset'. (sh-mode, sh-smie--indent-continuation) (sh-smie-rc-rules, sh-basic-indent-line): Replace `sh-indentation' with `sh-basic-offset'. --- lisp/progmodes/sh-script.el | 26 +++++++++++--------------- 1 file changed, 11 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index f2027e37345..14598bcafb9 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -593,11 +593,7 @@ sign. See `sh-feature'." (sexp :format "Evaluate: %v")))) :group 'sh-script) - -(defcustom sh-indentation 4 - "The width for further indentation in Shell-Script mode." - :type 'integer - :group 'sh-script) +(define-obsolete-variable-alias 'sh-indentation 'sh-basic-offset "26.1") (put 'sh-indentation 'safe-local-variable 'integerp) (defcustom sh-remember-variable-min 3 @@ -1617,7 +1613,7 @@ with your script for an edit-interpret-debug cycle." (setq-local skeleton-pair-alist '((?` _ ?`))) (setq-local skeleton-pair-filter-function 'sh-quoted-p) (setq-local skeleton-further-elements - '((< '(- (min sh-indentation (current-column)))))) + '((< '(- (min sh-basic-offset (current-column)))))) (setq-local skeleton-filter-function 'sh-feature) (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp @@ -2012,7 +2008,7 @@ May return nil if the line should not be treated as continued." (forward-line -1) (if (sh-smie--looking-back-at-continuation-p) (current-indentation) - (+ (current-indentation) sh-indentation)))) + (+ (current-indentation) sh-basic-offset)))) (t ;; Just make sure a line-continuation is indented deeper. (save-excursion @@ -2033,13 +2029,13 @@ May return nil if the line should not be treated as continued." ;; check the line before that one. (> ci indent)) (t ;Previous line is the beginning of the continued line. - (setq indent (min (+ ci sh-indentation) max)) + (setq indent (min (+ ci sh-basic-offset) max)) nil))))) indent)))))) (defun sh-smie-sh-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) sh-indentation) + (`(:elem . basic) sh-basic-offset) (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) (sh-var-value 'sh-indent-for-case-label))) (`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case")) @@ -2248,8 +2244,8 @@ Point should be before the newline." (defun sh-smie-rc-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) sh-indentation) - ;; (`(:after . "case") (or sh-indentation smie-indent-basic)) + (`(:elem . basic) sh-basic-offset) + ;; (`(:after . "case") (or sh-basic-offset smie-indent-basic)) (`(:after . ";") (if (smie-rule-parent-p "case") (smie-rule-parent (sh-var-value 'sh-indent-after-case)))) @@ -2490,7 +2486,7 @@ the value thus obtained, and the result is used instead." (defun sh-basic-indent-line () "Indent a line for Sh mode (shell script mode). -Indent as far as preceding non-empty line, then by steps of `sh-indentation'. +Indent as far as preceding non-empty line, then by steps of `sh-basic-offset'. Lines containing only comments are considered empty." (interactive) (let ((previous (save-excursion @@ -2514,9 +2510,9 @@ Lines containing only comments are considered empty." (delete-region (point) (progn (beginning-of-line) (point))) (if (eolp) - (max previous (* (1+ (/ current sh-indentation)) - sh-indentation)) - (* (1+ (/ current sh-indentation)) sh-indentation)))))) + (max previous (* (1+ (/ current sh-basic-offset)) + sh-basic-offset)) + (* (1+ (/ current sh-basic-offset)) sh-basic-offset)))))) (if (< (current-column) (current-indentation)) (skip-chars-forward " \t")))) From 66d35ae49dae8815910198586e277895671bd19b Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 23 Sep 2017 10:04:36 -0400 Subject: [PATCH 66/81] * lisp/eshell/esh-util.el (eshell-condition-case): Add debug declaration. --- lisp/eshell/esh-util.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index c204ec869b5..8b24ec3c430 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -142,7 +142,7 @@ function `string-to-number'." (defmacro eshell-condition-case (tag form &rest handlers) "If `eshell-handle-errors' is non-nil, this is `condition-case'. Otherwise, evaluates FORM with no error handling." - (declare (indent 2)) + (declare (indent 2) (debug (sexp form &rest form))) (if eshell-handle-errors `(condition-case-unless-debug ,tag ,form From 79162cb0db1b62eec35f4fec0e6eac8669bc8f37 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Mon, 25 Sep 2017 07:15:51 -0400 Subject: [PATCH 67/81] Fix subr-x-tests when running from elc * test/lisp/emacs-lisp/subr-x-tests.el (subr-x-and-let*-test-group-1): Use `eval' around the `should-error' cases. --- test/lisp/emacs-lisp/subr-x-tests.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 2c6740a96cf..0e8871d9a9c 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -397,9 +397,14 @@ (should (equal 1 (let ((x 1)) (and-let* (x))))) (should (equal nil (and-let* ((x nil))))) (should (equal 1 (and-let* ((x 1))))) - (should-error (and-let* (nil (x 1))) :type 'setting-constant) + ;; The error doesn't trigger when compiled: the compiler will give + ;; a warning and then drop the erroneous code. Therefore, use + ;; `eval' to avoid compilation. + (should-error (eval '(and-let* (nil (x 1))) lexical-binding) + :type 'setting-constant) (should (equal nil (and-let* ((nil) (x 1))))) - (should-error (and-let* (2 (x 1))) :type 'wrong-type-argument) + (should-error (eval (and-let* (2 (x 1))) lexical-binding) + :type 'wrong-type-argument) (should (equal 1 (and-let* ((2) (x 1))))) (should (equal 2 (and-let* ((x 1) (2))))) (should (equal nil (let ((x nil)) (and-let* (x) x)))) From a2244f417a7cf577172cec927b055f0aca9ef282 Mon Sep 17 00:00:00 2001 From: Joerg Behrmann Date: Mon, 18 Sep 2017 16:59:49 +0200 Subject: [PATCH 68/81] Improve python3-compatibility of fallback completion (Bug#28499) * lisp/progmodes/python.el (python-eldoc-setup-code): Use inspect.getfullargspec instead of inspect.getargspec to avoid a deprecation warning on every usage of eldoc in python-mode. Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f3513ced4bb..365191c56b0 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4271,8 +4271,10 @@ See `python-check-command' for the default." import inspect try: str_type = basestring + argspec_function = inspect.getargspec except NameError: str_type = str + argspec_function = inspect.getfullargspec if isinstance(obj, str_type): obj = eval(obj, globals()) doc = inspect.getdoc(obj) @@ -4285,9 +4287,7 @@ See `python-check-command' for the default." target = obj objtype = 'def' if target: - args = inspect.formatargspec( - *inspect.getargspec(target) - ) + args = inspect.formatargspec(*argspec_function(target)) name = obj.__name__ doc = '{objtype} {name}{args}'.format( objtype=objtype, name=name, args=args From 827db6b559100153fd7dcab1ecdabd9233e906ab Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 26 Sep 2017 02:49:00 +0300 Subject: [PATCH 69/81] Use a separate syntax-ppss cache for narrowed buffers * lisp/emacs-lisp/syntax.el (syntax-ppss-wide): New variable, to contain the data from `syntax-ppss-last' and `syntax-ppss-cache'. (syntax-ppss-cache, syntax-ppss-last): Remove. (syntax-ppss-narrow, syntax-ppss-narrow-start): New variables. (syntax-ppss-flush-cache): Flush both caches. (syntax-ppss--data): Return the appropriate last result and buffer cache for the current restriction. (syntax-ppss, syntax-ppss-debug): Use it (bug#22983). --- lisp/emacs-lisp/syntax.el | 107 +++++++++++++++++++++++++------------- 1 file changed, 72 insertions(+), 35 deletions(-) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index f6137837858..9eb6bde7454 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -381,10 +381,26 @@ This function should move the cursor back to some syntactically safe point (where the PPSS is equivalent to nil).") (make-obsolete-variable 'syntax-begin-function nil "25.1") -(defvar-local syntax-ppss-cache nil - "List of (POS . PPSS) pairs, in decreasing POS order.") -(defvar-local syntax-ppss-last nil - "Cache of (LAST-POS . LAST-PPSS).") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Several caches. +;; +;; Because `syntax-ppss' is equivalent to (parse-partial-sexp +;; (POINT-MIN) x), we need either to empty the cache when we narrow +;; the buffer, which is suboptimal, or we need to use several caches. +;; We use two of them, one for widened buffer, and one for narrowing. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar-local syntax-ppss-wide nil + "Cons of two elements (LAST . CACHE). +Where LAST is a pair (LAST-POS . LAST-PPS) caching the last invocation +and CACHE is a list of (POS . PPSS) pairs, in decreasing POS order. +These are valid when the buffer has no restriction.") + +(defvar-local syntax-ppss-narrow nil + "Same as `syntax-ppss-wide' but for a narrowed buffer.") + +(defvar-local syntax-ppss-narrow-start nil + "Start position of the narrowing for `syntax-ppss-narrow'.") (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) (defun syntax-ppss-flush-cache (beg &rest ignored) @@ -392,24 +408,29 @@ point (where the PPSS is equivalent to nil).") ;; Set syntax-propertize to refontify anything past beg. (setq syntax-propertize--done (min beg syntax-propertize--done)) ;; Flush invalid cache entries. - (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) - (setq syntax-ppss-cache (cdr syntax-ppss-cache))) - ;; Throw away `last' value if made invalid. - (when (< beg (or (car syntax-ppss-last) 0)) - ;; If syntax-begin-function jumped to BEG, then the old state at BEG can - ;; depend on the text after BEG (which is presumably changed). So if - ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the - ;; assumed nil state at BEG may not be valid any more. - (if (<= beg (or (syntax-ppss-toplevel-pos (cdr syntax-ppss-last)) - (nth 3 syntax-ppss-last) - 0)) - (setq syntax-ppss-last nil) - (setcar syntax-ppss-last nil))) - ;; Unregister if there's no cache left. Sadly this doesn't work - ;; because `before-change-functions' is temporarily bound to nil here. - ;; (unless syntax-ppss-cache - ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t)) - ) + (dolist (cell (list syntax-ppss-wide syntax-ppss-narrow)) + (pcase cell + (`(,last . ,cache) + (while (and cache (> (caar cache) beg)) + (setq cache (cdr cache))) + ;; Throw away `last' value if made invalid. + (when (< beg (or (car last) 0)) + ;; If syntax-begin-function jumped to BEG, then the old state at BEG can + ;; depend on the text after BEG (which is presumably changed). So if + ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the + ;; assumed nil state at BEG may not be valid any more. + (if (<= beg (or (syntax-ppss-toplevel-pos (cdr last)) + (nth 3 last) + 0)) + (setq last nil) + (setcar last nil))) + ;; Unregister if there's no cache left. Sadly this doesn't work + ;; because `before-change-functions' is temporarily bound to nil here. + ;; (unless cache + ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t)) + (setcar cell last) + (setcdr cell cache))) + )) (defvar syntax-ppss-stats [(0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (1 . 2500.0)]) @@ -423,6 +444,17 @@ point (where the PPSS is equivalent to nil).") (defvar-local syntax-ppss-table nil "Syntax-table to use during `syntax-ppss', if any.") +(defun syntax-ppss--data () + (if (eq (point-min) 1) + (progn + (unless syntax-ppss-wide + (setq syntax-ppss-wide (cons nil nil))) + syntax-ppss-wide) + (unless (eq syntax-ppss-narrow-start (point-min)) + (setq syntax-ppss-narrow-start (point-min)) + (setq syntax-ppss-narrow (cons nil nil))) + syntax-ppss-narrow)) + (defun syntax-ppss (&optional pos) "Parse-Partial-Sexp State at POS, defaulting to point. The returned value is the same as that of `parse-partial-sexp' @@ -439,10 +471,13 @@ running the hook." (syntax-propertize pos) ;; (with-syntax-table (or syntax-ppss-table (syntax-table)) - (let ((old-ppss (cdr syntax-ppss-last)) - (old-pos (car syntax-ppss-last)) - (ppss nil) - (pt-min (point-min))) + (let* ((cell (syntax-ppss--data)) + (ppss-last (car cell)) + (ppss-cache (cdr cell)) + (old-ppss (cdr ppss-last)) + (old-pos (car ppss-last)) + (ppss nil) + (pt-min (point-min))) (if (and old-pos (> old-pos pos)) (setq old-pos nil)) ;; Use the OLD-POS if usable and close. Don't update the `last' cache. (condition-case nil @@ -475,7 +510,7 @@ running the hook." ;; The OLD-* data can't be used. Consult the cache. (t (let ((cache-pred nil) - (cache syntax-ppss-cache) + (cache ppss-cache) (pt-min (point-min)) ;; I differentiate between PT-MIN and PT-BEST because ;; I feel like it might be important to ensure that the @@ -491,7 +526,7 @@ running the hook." (if cache (setq pt-min (caar cache) ppss (cdar cache))) ;; Setup the before-change function if necessary. - (unless (or syntax-ppss-cache syntax-ppss-last) + (unless (or ppss-cache ppss-last) (add-hook 'before-change-functions 'syntax-ppss-flush-cache t t)) @@ -541,7 +576,7 @@ running the hook." pt-min (setq pt-min (/ (+ pt-min pos) 2)) nil nil ppss)) (push (cons pt-min ppss) - (if cache-pred (cdr cache-pred) syntax-ppss-cache))) + (if cache-pred (cdr cache-pred) ppss-cache))) ;; Compute the actual return value. (setq ppss (parse-partial-sexp pt-min pos nil nil ppss)) @@ -562,13 +597,15 @@ running the hook." (if (> (- (caar cache-pred) pos) syntax-ppss-max-span) (push pair (cdr cache-pred)) (setcar cache-pred pair)) - (if (or (null syntax-ppss-cache) - (> (- (caar syntax-ppss-cache) pos) + (if (or (null ppss-cache) + (> (- (caar ppss-cache) pos) syntax-ppss-max-span)) - (push pair syntax-ppss-cache) - (setcar syntax-ppss-cache pair))))))))) + (push pair ppss-cache) + (setcar ppss-cache pair))))))))) - (setq syntax-ppss-last (cons pos ppss)) + (setq ppss-last (cons pos ppss)) + (setcar cell ppss-last) + (setcdr cell ppss-cache) ppss) (args-out-of-range ;; If the buffer is more narrowed than when we built the cache, @@ -582,7 +619,7 @@ running the hook." (defun syntax-ppss-debug () (let ((pt nil) (min-diffs nil)) - (dolist (x (append syntax-ppss-cache (list (cons (point-min) nil)))) + (dolist (x (append (cdr (syntax-ppss--data)) (list (cons (point-min) nil)))) (when pt (push (- pt (car x)) min-diffs)) (setq pt (car x))) min-diffs)) From e7c8da4d058233859e74441aff5236a02b039d21 Mon Sep 17 00:00:00 2001 From: Devon Sean McCullough Date: Tue, 26 Sep 2017 10:51:04 -0400 Subject: [PATCH 70/81] bug#28609: simple.el Correct grammar; also, call a pair a pair. --- lisp/simple.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 4e42fd52415..d21b15d5314 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -39,11 +39,11 @@ (defcustom shell-command-dont-erase-buffer nil "If non-nil, output buffer is not erased between shell commands. -Also, a non-nil value set the point in the output buffer -once the command complete. -The value `beg-last-out' set point at the beginning of the output, -`end-last-out' set point at the end of the buffer, `save-point' -restore the buffer position before the command." +Also, a non-nil value sets the point in the output buffer +once the command completes. +The value `beg-last-out' sets point at the beginning of the output, +`end-last-out' sets point at the end of the buffer, `save-point' +restores the buffer position before the command." :type '(choice (const :tag "Erase buffer" nil) (const :tag "Set point to beginning of last output" beg-last-out) @@ -53,9 +53,9 @@ restore the buffer position before the command." :version "26.1") (defvar shell-command-saved-pos nil - "Point position in the output buffer after command complete. -It is an alist (BUFFER . POS), where BUFFER is the output -buffer, and POS is the point position in BUFFER once the command finish. + "Point position in the output buffer after command completes. +It is an alist of (BUFFER . POS), where BUFFER is the output +buffer, and POS is the point position in BUFFER once the command finishes. This variable is used when `shell-command-dont-erase-buffer' is non-nil.") (defcustom idle-update-delay 0.5 @@ -1003,7 +1003,7 @@ Called with one argument METHOD. If METHOD is `delete-only', then delete the region; the return value is undefined. If METHOD is nil, then return the content as a string. If METHOD is `bounds', then return the boundaries of the region -as a list of the form (START . END). +as a pair of (START . END) positions. If METHOD is anything else, delete the region and return its content as a string, after filtering it with `filter-buffer-substring', which is called with METHOD as its 3rd argument.") @@ -5473,7 +5473,7 @@ also checks the value of `use-empty-active-region'." (progn (cl-assert (mark)) t))) (defun region-bounds () - "Return the boundaries of the region as a list of (START . END) positions." + "Return the boundaries of the region as a pair of (START . END) positions." (funcall region-extract-function 'bounds)) (defun region-noncontiguous-p () From 1e5949642a19a21fd9d47f66c66fd4d3bd99e910 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 26 Sep 2017 20:34:27 +0200 Subject: [PATCH 71/81] ; * src/gtkutil.c (xg_create_frame_widgets): Add FIXME re. X drawing --- src/gtkutil.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/gtkutil.c b/src/gtkutil.c index 0203a5d5c1a..0da70399193 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1217,7 +1217,10 @@ xg_create_frame_widgets (struct frame *f) with regular X drawing primitives, so from a GTK/GDK point of view, the widget is totally blank. When an expose comes, this will make the widget blank, and then Emacs redraws it. This flickers - a lot, so we turn off double buffering. */ + a lot, so we turn off double buffering. + FIXME: gtk_widget_set_double_buffered is deprecated and might stop + working in the future. We need to migrate away from combining + X and GTK+ drawing to a pure GTK+ build. */ gtk_widget_set_double_buffered (wfixed, FALSE); gtk_window_set_wmclass (GTK_WINDOW (wtop), From 98a37e60142340b9c2b4e6b17c373f4ae6a2d8b4 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 26 Sep 2017 12:35:52 -0700 Subject: [PATCH 72/81] lisp/simple.el: Indicate when a list of pairs is meant in a docstring --- lisp/simple.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index d21b15d5314..469557713d7 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1003,7 +1003,7 @@ Called with one argument METHOD. If METHOD is `delete-only', then delete the region; the return value is undefined. If METHOD is nil, then return the content as a string. If METHOD is `bounds', then return the boundaries of the region -as a pair of (START . END) positions. +as a list of pairs of (START . END) positions. If METHOD is anything else, delete the region and return its content as a string, after filtering it with `filter-buffer-substring', which is called with METHOD as its 3rd argument.") @@ -5473,7 +5473,7 @@ also checks the value of `use-empty-active-region'." (progn (cl-assert (mark)) t))) (defun region-bounds () - "Return the boundaries of the region as a pair of (START . END) positions." + "Return the boundaries of the region as a list of pairs of (START . END) positions." (funcall region-extract-function 'bounds)) (defun region-noncontiguous-p () From 0e82fa34163dba21121e3a9cffa7f896c81c4d93 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 26 Sep 2017 16:31:57 -0700 Subject: [PATCH 73/81] Avoid some unnecessary copying in Fformat etc. This patch is just for performance; it should not affect behavior. On my platform, it made the microbenchmark (format "%S" load-path) run about 45% faster. It should also speed up calls like (message "%s" STRING). * src/callint.c (Fcall_interactively): * src/dbusbind.c (XD_OBJECT_TO_STRING): * src/editfns.c (Fmessage, Fmessage_box): * src/xdisp.c (vadd_to_log, Ftrace_to_stderr): Use styled_format instead of Fformat or Fformat_message, to avoid unnecessary copying. * src/editfns.c (styled_format): New arg NEW_RESULT. All uses changed. Reuse an input string if it has the right value and if !NEW_RESULT. * src/lisp.h (style_format): New decl. --- src/callint.c | 7 ++----- src/dbusbind.c | 3 ++- src/editfns.c | 47 +++++++++++++++++++++++++++++++++++++---------- src/lisp.h | 1 + src/xdisp.c | 4 ++-- 5 files changed, 44 insertions(+), 18 deletions(-) diff --git a/src/callint.c b/src/callint.c index 105ec071d07..469205cc380 100644 --- a/src/callint.c +++ b/src/callint.c @@ -272,7 +272,7 @@ invoke it. If KEYS is omitted or nil, the return value of { /* `args' will contain the array of arguments to pass to the function. `visargs' will contain the same list but in a nicer form, so that if we - pass it to `Fformat_message' it will be understandable to a human. */ + pass it to styled_format it will be understandable to a human. */ Lisp_Object *args, *visargs; Lisp_Object specs; Lisp_Object filter_specs; @@ -502,10 +502,7 @@ invoke it. If KEYS is omitted or nil, the return value of for (i = 2; *tem; i++) { visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n")); - if (strchr (SSDATA (visargs[1]), '%')) - callint_message = Fformat_message (i - 1, visargs + 1); - else - callint_message = visargs[1]; + callint_message = styled_format (i - 1, visargs + 1, true, false); switch (*tem) { diff --git a/src/dbusbind.c b/src/dbusbind.c index 4a7068416fe..789aa008611 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -237,7 +237,8 @@ static char * XD_OBJECT_TO_STRING (Lisp_Object object) { AUTO_STRING (format, "%s"); - return SSDATA (CALLN (Fformat, format, object)); + Lisp_Object args[] = { format, object }; + return SSDATA (styled_format (ARRAYELTS (args), args, false, false)); } #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \ diff --git a/src/editfns.c b/src/editfns.c index 2f8b075817a..ef0374199cc 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -74,7 +74,6 @@ static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec, static long int tm_gmtoff (struct tm *); static int tm_diff (struct tm *, struct tm *); static void update_buffer_properties (ptrdiff_t, ptrdiff_t); -static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool); #ifndef HAVE_TM_GMTOFF # define HAVE_TM_GMTOFF false @@ -3959,7 +3958,7 @@ usage: (message FORMAT-STRING &rest ARGS) */) } else { - Lisp_Object val = Fformat_message (nargs, args); + Lisp_Object val = styled_format (nargs, args, true, false); message3 (val); return val; } @@ -3985,7 +3984,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */) } else { - Lisp_Object val = Fformat_message (nargs, args); + Lisp_Object val = styled_format (nargs, args, true, false); Lisp_Object pane, menu; pane = list1 (Fcons (build_string ("OK"), Qt)); @@ -4141,7 +4140,7 @@ produced text. usage: (format STRING &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return styled_format (nargs, args, false); + return styled_format (nargs, args, false, true); } DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0, @@ -4157,13 +4156,16 @@ and right quote replacement characters are specified by usage: (format-message STRING &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return styled_format (nargs, args, true); + return styled_format (nargs, args, true, true); } -/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. */ +/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. + If NEW_RESULT, the result is a new string; otherwise, the result + may be one of the arguments. */ -static Lisp_Object -styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) +Lisp_Object +styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message, + bool new_result) { ptrdiff_t n; /* The number of the next arg to substitute. */ char initial_buffer[4000]; @@ -4193,6 +4195,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) /* The start and end bytepos in the output string. */ ptrdiff_t start, end; + /* Whether the argument is a newly created string. */ + bool_bf new_string : 1; + /* Whether the argument is a string with intervals. */ bool_bf intervals : 1; } *info; @@ -4342,7 +4347,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) memset (&discarded[format0 - format_start], 1, format - format0 - (conversion == '%')); if (conversion == '%') - goto copy_char; + { + new_result = true; + goto copy_char; + } ++n; if (! (n < nargs)) @@ -4352,6 +4360,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (nspec < ispec) { spec->argument = args[n]; + spec->new_string = false; spec->intervals = false; nspec = ispec; } @@ -4369,11 +4378,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { Lisp_Object noescape = conversion == 'S' ? Qnil : Qt; spec->argument = arg = Fprin1_to_string (arg, noescape); + spec->new_string = true; if (STRING_MULTIBYTE (arg) && ! multibyte) { multibyte = true; goto retry; } + new_result = false; } conversion = 's'; } @@ -4387,6 +4398,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) goto retry; } spec->argument = arg = Fchar_to_string (arg); + spec->new_string = true; } if (!EQ (arg, args[n])) @@ -4409,6 +4421,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (conversion == 's') { + if (format == end && format - format_start == 2 + && (!new_result || spec->new_string) + && ! string_intervals (args[0])) + return arg; + /* handle case (precision[n] >= 0) */ ptrdiff_t prec = -1; @@ -4487,6 +4504,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (string_intervals (arg)) spec->intervals = arg_intervals = true; + new_result = true; continue; } } @@ -4754,6 +4772,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } spec->end = nchars; + new_result = true; continue; } } @@ -4772,9 +4791,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } convsrc = format_char == '`' ? uLSQM : uRSQM; convbytes = 3; + new_result = true; } else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) - convsrc = "'"; + { + convsrc = "'"; + new_result = true; + } else { /* Copy a single character from format to buf. */ @@ -4798,6 +4821,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) int c = BYTE8_TO_CHAR (format_char); convbytes = CHAR_STRING (c, str); convsrc = (char *) str; + new_result = true; } } @@ -4844,6 +4868,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (bufsize < p - buf) emacs_abort (); + if (! new_result) + return args[0]; + if (maybe_combine_byte) nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf); Lisp_Object val = make_specified_string (buf, nchars, p - buf, multibyte); diff --git a/src/lisp.h b/src/lisp.h index c5030824427..0c3ca3ae06b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3969,6 +3969,7 @@ extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); +extern Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool, bool); extern void init_editfns (bool); extern void syms_of_editfns (void); diff --git a/src/xdisp.c b/src/xdisp.c index 141275f15a0..86164eb9f6f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10194,7 +10194,7 @@ vadd_to_log (char const *format, va_list ap) for (ptrdiff_t i = 1; i <= nargs; i++) args[i] = va_arg (ap, Lisp_Object); Lisp_Object msg = Qnil; - msg = Fformat_message (nargs, args); + msg = styled_format (nargs, args, true, false); ptrdiff_t len = SBYTES (msg) + 1; USE_SAFE_ALLOCA; @@ -19525,7 +19525,7 @@ DEFUN ("trace-to-stderr", Ftrace_to_stderr, Strace_to_stderr, 1, MANY, "", usage: (trace-to-stderr STRING &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object s = Fformat (nargs, args); + Lisp_Object s = styled_format (nargs, args, false, false); fwrite (SDATA (s), 1, SBYTES (s), stderr); return Qnil; } From a3f647c5c810e8be5321bf99cb21d565590a7cf8 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 26 Sep 2017 17:15:56 -0700 Subject: [PATCH 74/81] * src/editfns.c (styled_format): Fix typo in previous change. --- src/editfns.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/editfns.c b/src/editfns.c index ef0374199cc..e326604467c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4384,7 +4384,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message, multibyte = true; goto retry; } - new_result = false; } conversion = 's'; } From 7cf59c6635f747fe2d974b92be1fd937d3821681 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 27 Sep 2017 22:15:19 +0100 Subject: [PATCH 75/81] Revert "Add flymake-backends defcustom" This reverts Git commit 13993c46a21495167517f76d2e36b6c09ac5e89e. Don't merge this back to master as development happening there builds upon this work. See also https://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00932.html --- lisp/progmodes/flymake-proc.el | 23 +++------- lisp/progmodes/flymake-ui.el | 78 +++++++++++----------------------- 2 files changed, 31 insertions(+), 70 deletions(-) diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index df1a0750cfb..0cbf3e1c67d 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -123,12 +123,10 @@ NAME is the file name function to use, default `flymake-get-real-file-name'." (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) mode-and-masks)) -(defun flymake-proc-can-syntax-check-buffer () - "Determine whether we can syntax check current buffer. -Return nil if we cannot, non-nil if -we can." - (and buffer-file-name - (if (flymake-get-init-function buffer-file-name) t nil))) +(defun flymake-can-syntax-check-file (file-name) + "Determine whether we can syntax check FILE-NAME. +Return nil if we cannot, non-nil if we can." + (if (flymake-get-init-function file-name) t nil)) (defun flymake-get-init-function (file-name) "Return init function to be used for the file." @@ -719,11 +717,12 @@ Return its components if so, nil otherwise." (error (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) -(defun flymake-proc-start-syntax-check () +(defun flymake-start-syntax-check () "Start syntax checking for current buffer." (interactive) (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (not flymake-is-running) + (when (and (not flymake-is-running) + (flymake-can-syntax-check-file buffer-file-name)) (when (or (not flymake-compilation-prevents-syntax-check) (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") (flymake-clear-buildfile-cache) @@ -1088,13 +1087,5 @@ Use CREATE-TEMP-F for creating temp copy." (list "val" (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))) - -;;;; Hook onto flymake-ui - -(add-to-list 'flymake-backends - `(flymake-proc-can-syntax-check-buffer - . - flymake-proc-start-syntax-check)) - (provide 'flymake-proc) ;;; flymake-proc.el ends here diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el index bf5218c41d2..2a15a497d84 100644 --- a/lisp/progmodes/flymake-ui.el +++ b/lisp/progmodes/flymake-ui.el @@ -108,17 +108,6 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'." :group 'flymake :type 'integer) -(defcustom flymake-backends '() - "Ordered list of backends providing syntax check information for a buffer. -Value is an alist of conses (PREDICATE . CHECKER). Both PREDICATE -and CHECKER are functions called with a single argument, the -buffer in which `flymake-mode' was enabled. PREDICATE is expected -to (quickly) return t or nil if the buffer can be syntax checked -by CHECKER, which in can performs more morose operations, -possibly asynchronously." - :group 'flymake - :type 'alist) - (defvar-local flymake-timer nil "Timer for starting syntax check.") @@ -379,7 +368,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-last-change-time nil) (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake--start-syntax-check))))) + (flymake-start-syntax-check))))) (define-obsolete-function-alias 'flymake-display-err-menu-for-current-line 'flymake-popup-current-error-menu "24.4") @@ -453,20 +442,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" (buffer-name) status warning)) -(defvar-local flymake--backend nil - "The currently active backend selected by `flymake-mode'") - -(defun flymake--can-syntax-check-buffer (buffer) - (let ((all flymake-backends) - (candidate)) - (catch 'done - (while (setq candidate (pop all)) - (when (with-current-buffer buffer (funcall (car candidate))) - (throw 'done (cdr candidate))))))) - -(defun flymake--start-syntax-check () - (funcall flymake--backend)) - ;;;###autoload (define-minor-mode flymake-mode nil :group 'flymake :lighter flymake-mode-line @@ -474,36 +449,31 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." ;; Turning the mode ON. (flymake-mode - (let* ((backend (flymake--can-syntax-check-buffer (current-buffer)))) - (cond - ((not backend) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) - (t - (setq flymake--backend backend) + (cond + ((not buffer-file-name) + (message "Flymake unable to run without a buffer file name")) + ((not (flymake-can-syntax-check-file buffer-file-name)) + (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) + (t + (add-hook 'after-change-functions 'flymake-after-change-function nil t) + (add-hook 'after-save-hook 'flymake-after-save-hook nil t) + (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - (add-hook 'after-change-functions 'flymake-after-change-function nil t) - (add-hook 'after-save-hook 'flymake-after-save-hook nil t) - (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) + (flymake-report-status "" "") - (flymake-report-status "" "") + (setq flymake-timer + (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - (setq flymake-timer - (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - - (when (and flymake-start-syntax-check-on-find-file - ;; Since we write temp files in current dir, there's no point - ;; trying if the directory is read-only (bug#8954). - (file-writable-p (file-name-directory buffer-file-name))) - (with-demoted-errors - (flymake--start-syntax-check))))) - ) - ) + (when (and flymake-start-syntax-check-on-find-file + ;; Since we write temp files in current dir, there's no point + ;; trying if the directory is read-only (bug#8954). + (file-writable-p (file-name-directory buffer-file-name))) + (with-demoted-errors + (flymake-start-syntax-check)))))) ;; Turning the mode OFF. (t - (setq flymake--backend nil) - (remove-hook 'after-change-functions 'flymake-after-change-function t) (remove-hook 'after-save-hook 'flymake-after-save-hook t) (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) @@ -538,14 +508,14 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (let((new-text (buffer-substring start stop))) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake--start-syntax-check)) + (flymake-start-syntax-check)) (setq flymake-last-change-time (float-time)))) (defun flymake-after-save-hook () (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? (progn (flymake-log 3 "starting syntax check as buffer was saved") - (flymake--start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) (defun flymake-kill-buffer-hook () (when flymake-timer @@ -556,10 +526,10 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-find-file-hook () ;;+(when flymake-start-syntax-check-on-find-file ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake--start-syntax-check) + ;;+ (flymake-start-syntax-check) ;;+) (when (and (not (local-variable-p 'flymake-mode (current-buffer))) - (flymake--can-syntax-check-buffer (current-buffer))) + (flymake-can-syntax-check-file buffer-file-name)) (flymake-mode) (flymake-log 3 "automatically turned ON flymake mode"))) From ce540f8a687672fade6eb91e64ddf86e1e868784 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 27 Sep 2017 22:35:49 +0100 Subject: [PATCH 76/81] Revert "Split flymake.el into flymake-proc.el and flymake-ui.el" In other words, re-coalesce the two files, lisp/progmodes/flymake-proc.el and lisp/progmodes/flymake-ui.el, back into a single one, lisp/progmodes/flymake.el. The changesets "Prefer HTTPS to FTP and HTTP in documentation" and "allow nil init in flymake-allowed-file-name-masks to disable flymake" are kept in place in the new lisp/progmodes/flymake.el. This reverts Git commit eb34f7f5a29e7bf62326ecb6e693f28878be28cd. Don't merge this back to master as development happening there builds upon this work. See also https://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00932.html. --- lisp/progmodes/flymake-proc.el | 1091 --------------------- lisp/progmodes/flymake-ui.el | 604 ------------ lisp/progmodes/flymake.el | 1629 +++++++++++++++++++++++++++++++- 3 files changed, 1620 insertions(+), 1704 deletions(-) delete mode 100644 lisp/progmodes/flymake-proc.el delete mode 100644 lisp/progmodes/flymake-ui.el diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el deleted file mode 100644 index 0cbf3e1c67d..00000000000 --- a/lisp/progmodes/flymake-proc.el +++ /dev/null @@ -1,1091 +0,0 @@ -;;; flymake-proc.el --- Flymake for external syntax checker processes -*- lexical-binding: t; -*- - -;; Copyright (C) 2003-2017 Free Software Foundation, Inc. - -;; Author: Pavel Kobyakov -;; Maintainer: Leo Liu -;; Version: 0.3 -;; Keywords: c languages tools - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. -;; -;; This file contains the most original implementation of flymake's -;; main source of on-the-fly diagnostic info, the external syntax -;; checker backend. -;; -;;; Bugs/todo: - -;; - Only uses "Makefile", not "makefile" or "GNUmakefile" -;; (from http://bugs.debian.org/337339). - -;;; Code: - -(require 'flymake-ui) - -(defcustom flymake-compilation-prevents-syntax-check t - "If non-nil, don't start syntax check if compilation is running." - :group 'flymake - :type 'boolean) - -(defcustom flymake-xml-program - (if (executable-find "xmlstarlet") "xmlstarlet" "xml") - "Program to use for XML validation." - :type 'file - :group 'flymake - :version "24.4") - -(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") - "Dirs where to look for master files." - :group 'flymake - :type '(repeat (string))) - -(defcustom flymake-master-file-count-limit 32 - "Max number of master files to check." - :group 'flymake - :type 'integer) - -(defcustom flymake-allowed-file-name-masks - '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) - ("\\.xml\\'" flymake-xml-init) - ("\\.html?\\'" flymake-xml-init) - ("\\.cs\\'" flymake-simple-make-init) - ("\\.p[ml]\\'" flymake-perl-init) - ("\\.php[345]?\\'" flymake-php-init) - ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup) - ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup) - ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup) - ("\\.tex\\'" flymake-simple-tex-init) - ("\\.idl\\'" flymake-simple-make-init) - ;; ("\\.cpp\\'" 1) - ;; ("\\.java\\'" 3) - ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") - ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) - ;; ("\\.idl\\'" 1) - ;; ("\\.odl\\'" 1) - ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'") - ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) - ;; ("\\.tex\\'" 1) - ) - "Files syntax checking is allowed for. -This is an alist with elements of the form: - REGEXP [INIT [CLEANUP [NAME]]] -REGEXP is a regular expression that matches a file name. -INIT is the init function to use, missing means disable `flymake-mode'. -CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. -NAME is the file name function to use, default `flymake-get-real-file-name'." - :group 'flymake - :type '(alist :key-type (regexp :tag "File regexp") - :value-type - (list :tag "Handler functions" - (choice :tag "Init function" - (const :tag "disable" nil) - function) - (choice :tag "Cleanup function" - (const :tag "flymake-simple-cleanup" nil) - function) - (choice :tag "Name function" - (const :tag "flymake-get-real-file-name" nil) - function)))) - -(defvar flymake-processes nil - "List of currently active flymake processes.") - -(defvar-local flymake-output-residual nil) - -(defun flymake-get-file-name-mode-and-masks (file-name) - "Return the corresponding entry from `flymake-allowed-file-name-masks'." - (unless (stringp file-name) - (error "Invalid file-name")) - (let ((fnm flymake-allowed-file-name-masks) - (mode-and-masks nil)) - (while (and (not mode-and-masks) fnm) - (let ((item (pop fnm))) - (when (string-match (car item) file-name) - (setq mode-and-masks item)))) ; (cdr item) may be nil - (setq mode-and-masks (cdr mode-and-masks)) - (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) - mode-and-masks)) - -(defun flymake-can-syntax-check-file (file-name) - "Determine whether we can syntax check FILE-NAME. -Return nil if we cannot, non-nil if we can." - (if (flymake-get-init-function file-name) t nil)) - -(defun flymake-get-init-function (file-name) - "Return init function to be used for the file." - (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) - ;;(flymake-log 0 "calling %s" init-f) - ;;(funcall init-f (current-buffer)) - init-f)) - -(defun flymake-get-cleanup-function (file-name) - "Return cleanup function to be used for the file." - (or (nth 1 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-simple-cleanup)) - -(defun flymake-get-real-file-name-function (file-name) - (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-get-real-file-name)) - -(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) - -(defun flymake-get-buildfile-from-cache (dir-name) - "Look up DIR-NAME in cache and return its associated value. -If DIR-NAME is not found, return nil." - (gethash dir-name flymake-find-buildfile-cache)) - -(defun flymake-add-buildfile-to-cache (dir-name buildfile) - "Associate DIR-NAME with BUILDFILE in the buildfile cache." - (puthash dir-name buildfile flymake-find-buildfile-cache)) - -(defun flymake-clear-buildfile-cache () - "Clear the buildfile cache." - (clrhash flymake-find-buildfile-cache)) - -(defun flymake-find-buildfile (buildfile-name source-dir-name) - "Find buildfile starting from current directory. -Buildfile includes Makefile, build.xml etc. -Return its file name if found, or nil if not found." - (or (flymake-get-buildfile-from-cache source-dir-name) - (let* ((file (locate-dominating-file source-dir-name buildfile-name))) - (if file - (progn - (flymake-log 3 "found buildfile at %s" file) - (flymake-add-buildfile-to-cache source-dir-name file) - file) - (progn - (flymake-log 3 "buildfile for %s not found" source-dir-name) - nil))))) - -(defun flymake-fix-file-name (name) - "Replace all occurrences of `\\' with `/'." - (when name - (setq name (expand-file-name name)) - (setq name (abbreviate-file-name name)) - (setq name (directory-file-name name)) - name)) - -(defun flymake-same-files (file-name-one file-name-two) - "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. -Return t if so, nil if not." - (equal (flymake-fix-file-name file-name-one) - (flymake-fix-file-name file-name-two))) - -;; This is bound dynamically to pass a parameter to a sort predicate below -(defvar flymake-included-file-name) - -(defun flymake-find-possible-master-files (file-name master-file-dirs masks) - "Find (by name and location) all possible master files. - -Name is specified by FILE-NAME and location is specified by -MASTER-FILE-DIRS. Master files include .cpp and .c for .h. -Files are searched for starting from the .h directory and max -max-level parent dirs. File contents are not checked." - (let* ((dirs master-file-dirs) - (files nil) - (done nil)) - - (while (and (not done) dirs) - (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) - (masks masks)) - (while (and (file-exists-p dir) (not done) masks) - (let* ((mask (car masks)) - (dir-files (directory-files dir t mask))) - - (flymake-log 3 "dir %s, %d file(s) for mask %s" - dir (length dir-files) mask) - (while (and (not done) dir-files) - (when (not (file-directory-p (car dir-files))) - (setq files (cons (car dir-files) files)) - (when (>= (length files) flymake-master-file-count-limit) - (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) - (setq done t))) - (setq dir-files (cdr dir-files)))) - (setq masks (cdr masks)))) - (setq dirs (cdr dirs))) - (when files - (let ((flymake-included-file-name (file-name-nondirectory file-name))) - (setq files (sort files 'flymake-master-file-compare)))) - (flymake-log 3 "found %d possible master file(s)" (length files)) - files)) - -(defun flymake-master-file-compare (file-one file-two) - "Compare two files specified by FILE-ONE and FILE-TWO. -This function is used in sort to move most possible file names -to the beginning of the list (File.h -> File.cpp moved to top)." - (and (equal (file-name-sans-extension flymake-included-file-name) - (file-name-base file-one)) - (not (equal file-one file-two)))) - -(defvar flymake-check-file-limit 8192 - "Maximum number of chars to look at when checking possible master file. -Nil means search the entire file.") - -(defun flymake-check-patch-master-file-buffer - (master-file-temp-buffer - master-file-name patched-master-file-name - source-file-name patched-source-file-name - include-dirs regexp) - "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. -If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME -instead of SOURCE-FILE-NAME. - -For example, foo.cpp is a master file if it includes foo.h. - -When a buffer for MASTER-FILE-NAME exists, use it as a source -instead of reading master file from disk." - (let* ((source-file-nondir (file-name-nondirectory source-file-name)) - (source-file-extension (file-name-extension source-file-nondir)) - (source-file-nonext (file-name-sans-extension source-file-nondir)) - (found nil) - (inc-name nil) - (search-limit flymake-check-file-limit)) - (setq regexp - (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" - ;; Hack for tex files, where \include often excludes .tex. - ;; Maybe this is safe generally. - (if (and (> (length source-file-extension) 1) - (string-equal source-file-extension "tex")) - (format "%s\\(?:\\.%s\\)?" - (regexp-quote source-file-nonext) - (regexp-quote source-file-extension)) - (regexp-quote source-file-nondir)))) - (unwind-protect - (with-current-buffer master-file-temp-buffer - (if (or (not search-limit) - (> search-limit (point-max))) - (setq search-limit (point-max))) - (flymake-log 3 "checking %s against regexp %s" - master-file-name regexp) - (goto-char (point-min)) - (while (and (< (point) search-limit) - (re-search-forward regexp search-limit t)) - (let ((match-beg (match-beginning 1)) - (match-end (match-end 1))) - - (flymake-log 3 "found possible match for %s" source-file-nondir) - (setq inc-name (match-string 1)) - (and (> (length source-file-extension) 1) - (string-equal source-file-extension "tex") - (not (string-match (format "\\.%s\\'" source-file-extension) - inc-name)) - (setq inc-name (concat inc-name "." source-file-extension))) - (when (eq t (compare-strings - source-file-nondir nil nil - inc-name (- (length inc-name) - (length source-file-nondir)) nil)) - (flymake-log 3 "inc-name=%s" inc-name) - (when (flymake-check-include source-file-name inc-name - include-dirs) - (setq found t) - ;; replace-match is not used here as it fails in - ;; XEmacs with 'last match not a buffer' error as - ;; check-includes calls replace-in-string - (flymake-replace-region - match-beg match-end - (file-name-nondirectory patched-source-file-name)))) - (forward-line 1))) - (when found - (flymake-save-buffer-in-file patched-master-file-name))) - ;;+(flymake-log 3 "killing buffer %s" - ;; (buffer-name master-file-temp-buffer)) - (kill-buffer master-file-temp-buffer)) - ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) - (when found - (flymake-log 2 "found master file %s" master-file-name)) - found)) - -;;; XXX: remove -(defun flymake-replace-region (beg end rep) - "Replace text in BUFFER in region (BEG END) with REP." - (save-excursion - (goto-char end) - ;; Insert before deleting, so as to better preserve markers's positions. - (insert rep) - (delete-region beg end))) - -(defun flymake-read-file-to-temp-buffer (file-name) - "Insert contents of FILE-NAME into newly created temp buffer." - (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) - (with-current-buffer temp-buffer - (insert-file-contents file-name)) - temp-buffer)) - -(defun flymake-copy-buffer-to-temp-buffer (buffer) - "Copy contents of BUFFER into newly created temp buffer." - (with-current-buffer - (get-buffer-create (generate-new-buffer-name - (concat "flymake:" (buffer-name buffer)))) - (insert-buffer-substring buffer) - (current-buffer))) - -(defun flymake-check-include (source-file-name inc-name include-dirs) - "Check if SOURCE-FILE-NAME can be found in include path. -Return t if it can be found via include path using INC-NAME." - (if (file-name-absolute-p inc-name) - (flymake-same-files source-file-name inc-name) - (while (and include-dirs - (not (flymake-same-files - source-file-name - (concat (file-name-directory source-file-name) - "/" (car include-dirs) - "/" inc-name)))) - (setq include-dirs (cdr include-dirs))) - include-dirs)) - -(defun flymake-find-buffer-for-file (file-name) - "Check if there exists a buffer visiting FILE-NAME. -Return t if so, nil if not." - (let ((buffer-name (get-file-buffer file-name))) - (if buffer-name - (get-buffer buffer-name)))) - -(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) - "Save SOURCE-FILE-NAME with a different name. -Find master file, patch and save it." - (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) - (master-file-count (length possible-master-files)) - (idx 0) - (temp-buffer nil) - (master-file-name nil) - (patched-master-file-name nil) - (found nil)) - - (while (and (not found) (< idx master-file-count)) - (setq master-file-name (nth idx possible-master-files)) - (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) - (if (flymake-find-buffer-for-file master-file-name) - (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) - (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name))) - (setq found - (flymake-check-patch-master-file-buffer - temp-buffer - master-file-name - patched-master-file-name - source-file-name - patched-source-file-name - (funcall get-incl-dirs-f (file-name-directory master-file-name)) - include-regexp)) - (setq idx (1+ idx))) - (if found - (list master-file-name patched-master-file-name) - (progn - (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count - (file-name-nondirectory source-file-name)) - nil)))) - -(defun flymake-save-buffer-in-file (file-name) - "Save the entire buffer contents into file FILE-NAME. -Create parent directories as needed." - (make-directory (file-name-directory file-name) 1) - (write-region nil nil file-name nil 566) - (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) - -(defun flymake-process-filter (process output) - "Parse OUTPUT and highlight error lines. -It's flymake process filter." - (let ((source-buffer (process-buffer process))) - - (flymake-log 3 "received %d byte(s) of output from process %d" - (length output) (process-id process)) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (flymake-parse-output-and-residual output))))) - -(defun flymake-process-sentinel (process _event) - "Sentinel for syntax check buffers." - (when (memq (process-status process) '(signal exit)) - (let* ((exit-status (process-exit-status process)) - (command (process-command process)) - (source-buffer (process-buffer process)) - (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) - - (flymake-log 2 "process %d exited with code %d" - (process-id process) exit-status) - (condition-case err - (progn - (flymake-log 3 "cleaning up using %s" cleanup-f) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (funcall cleanup-f))) - - (delete-process process) - (setq flymake-processes (delq process flymake-processes)) - - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - - (flymake-parse-residual) - (flymake-post-syntax-check exit-status command) - (setq flymake-is-running nil)))) - (error - (let ((err-str (format "Error in process sentinel for buffer %s: %s" - source-buffer (error-message-string err)))) - (flymake-log 0 err-str) - (with-current-buffer source-buffer - (setq flymake-is-running nil)))))))) - -(defun flymake-post-syntax-check (exit-status command) - (save-restriction - (widen) - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (count-lines (point-min) (point-max)))) - (flymake-delete-own-overlays) - (flymake-highlight-err-lines flymake-err-info) - (let (err-count warn-count) - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name) err-count warn-count - (- (float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil) - - (if (and (equal 0 err-count) (equal 0 warn-count)) - (if (equal 0 exit-status) - (flymake-report-status "" "") ; PASSED - (if (not flymake-check-was-interrupted) - (flymake-report-fatal-status "CFGERR" - (format "Configuration error has occurred while running %s" command)) - (flymake-report-status nil ""))) ; "STOPPED" - (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) - -(defun flymake-parse-output-and-residual (output) - "Split OUTPUT into lines, merge in residual if necessary." - (let* ((buffer-residual flymake-output-residual) - (total-output (if buffer-residual (concat buffer-residual output) output)) - (lines-and-residual (flymake-split-output total-output)) - (lines (nth 0 lines-and-residual)) - (new-residual (nth 1 lines-and-residual))) - (setq flymake-output-residual new-residual) - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info lines)))) - -(defun flymake-parse-residual () - "Parse residual if it's non empty." - (when flymake-output-residual - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - (list flymake-output-residual))) - (setq flymake-output-residual nil))) - -(defun flymake-fix-line-numbers (err-info-list min-line max-line) - "Replace line numbers with fixed value. -If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. -If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. -The reason for this fix is because some compilers might report -line number outside the file being compiled." - (let* ((count (length err-info-list)) - (err-info nil) - (line 0)) - (while (> count 0) - (setq err-info (nth (1- count) err-info-list)) - (setq line (flymake-er-get-line err-info)) - (when (or (< line min-line) (> line max-line)) - (setq line (if (< line min-line) min-line max-line)) - (setq err-info-list (flymake-set-at err-info-list (1- count) - (flymake-er-make-er line - (flymake-er-get-line-err-info-list err-info))))) - (setq count (1- count)))) - err-info-list) - -(defun flymake-parse-err-lines (err-info-list lines) - "Parse err LINES, store info in ERR-INFO-LIST." - (let* ((count (length lines)) - (idx 0) - (line-err-info nil) - (real-file-name nil) - (source-file-name buffer-file-name) - (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) - - (while (< idx count) - (setq line-err-info (flymake-parse-line (nth idx lines))) - (when line-err-info - (setq real-file-name (funcall get-real-file-name-f - (flymake-ler-file line-err-info))) - (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) - - (when (flymake-same-files real-file-name source-file-name) - (setq line-err-info (flymake-ler-set-file line-err-info nil)) - (setq err-info-list (flymake-add-err-info err-info-list line-err-info)))) - (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) - (setq idx (1+ idx))) - err-info-list)) - -(defun flymake-split-output (output) - "Split OUTPUT into lines. -Return last one as residual if it does not end with newline char. -Returns ((LINES) RESIDUAL)." - (when (and output (> (length output) 0)) - (let* ((lines (split-string output "[\n\r]+" t)) - (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) - (residual nil)) - (when (not complete) - (setq residual (car (last lines))) - (setq lines (butlast lines))) - (list lines residual)))) - -(defun flymake-reformat-err-line-patterns-from-compile-el (original-list) - "Grab error line patterns from ORIGINAL-LIST in compile.el format. -Convert it to flymake internal format." - (let* ((converted-list '())) - (dolist (item original-list) - (setq item (cdr item)) - (let ((regexp (nth 0 item)) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item))) - (if (consp file) (setq file (car file))) - (if (consp line) (setq line (car line))) - (if (consp col) (setq col (car col))) - - (when (not (functionp line)) - (setq converted-list (cons (list regexp file line col) converted-list))))) - converted-list)) - -(require 'compile) - -(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text - (append - '( - ;; MS Visual C++ 6.0 - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; jikes - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; MS midl - ("midl[ ]*:[ ]*\\(command line error .*\\)" - nil nil nil 1) - ;; MS C# - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; perl - ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) - ;; PHP - ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) - ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) - ;; ant/javac. Note this also matches gcc warnings! - (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)" - 2 4 nil 5)) - ;; compilation-error-regexp-alist) - (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) - "Patterns for matching error/warning lines. Each pattern has the form -\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). -Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns -from compile.el") - -(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") -(defvar flymake-warning-predicate "^[wW]arning" - "Predicate matching against error text to detect a warning. -Takes a single argument, the error's text and should return non-nil -if it's a warning. -Instead of a function, it can also be a regular expression.") - -(defun flymake-parse-line (line) - "Parse LINE to see if it is an error or warning. -Return its components if so, nil otherwise." - (let ((raw-file-name nil) - (line-no 0) - (err-type "e") - (err-text nil) - (patterns flymake-err-line-patterns) - (matched nil)) - (while (and patterns (not matched)) - (when (string-match (car (car patterns)) line) - (let* ((file-idx (nth 1 (car patterns))) - (line-idx (nth 2 (car patterns)))) - - (setq raw-file-name (if file-idx (match-string file-idx line) nil)) - (setq line-no (if line-idx (string-to-number - (match-string line-idx line)) 0)) - (setq err-text (if (> (length (car patterns)) 4) - (match-string (nth 4 (car patterns)) line) - (flymake-patch-err-text - (substring line (match-end 0))))) - (if (null err-text) - (setq err-text "") - (when (cond ((stringp flymake-warning-predicate) - (string-match flymake-warning-predicate err-text)) - ((functionp flymake-warning-predicate) - (funcall flymake-warning-predicate err-text))) - (setq err-type "w"))) - (flymake-log - 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" - file-idx line-idx raw-file-name line-no err-text) - (setq matched t))) - (setq patterns (cdr patterns))) - (if matched - (flymake-ler-make-ler raw-file-name line-no err-type err-text) - ()))) - -(defun flymake-get-project-include-dirs-imp (basedir) - "Include dirs for the project current file belongs to." - (if (flymake-get-project-include-dirs-from-cache basedir) - (progn - (flymake-get-project-include-dirs-from-cache basedir)) - ;;else - (let* ((command-line (concat "make -C " - (shell-quote-argument basedir) - " DUMPVARS=INCLUDE_DIRS dumpvars")) - (output (shell-command-to-string command-line)) - (lines (split-string output "\n" t)) - (count (length lines)) - (idx 0) - (inc-dirs nil)) - (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) - (setq idx (1+ idx))) - (when (< idx count) - (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) - (inc-count (length inc-lines))) - (while (> inc-count 0) - (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) - (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) - (setq inc-count (1- inc-count))))) - (flymake-add-project-include-dirs-to-cache basedir inc-dirs) - inc-dirs))) - -(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp - "Function used to get project include dirs, one parameter: basedir name.") - -(defun flymake-get-project-include-dirs (basedir) - (funcall flymake-get-project-include-dirs-function basedir)) - -(defun flymake-get-system-include-dirs () - "System include dirs - from the `INCLUDE' env setting." - (let* ((includes (getenv "INCLUDE"))) - (if includes (split-string includes path-separator t) nil))) - -(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) - -(defun flymake-get-project-include-dirs-from-cache (base-dir) - (gethash base-dir flymake-project-include-dirs-cache)) - -(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs) - (puthash base-dir include-dirs flymake-project-include-dirs-cache)) - -(defun flymake-clear-project-include-dirs-cache () - (clrhash flymake-project-include-dirs-cache)) - -(defun flymake-get-include-dirs (base-dir) - "Get dirs to use when resolving local file names." - (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) - include-dirs)) - -;; (defun flymake-restore-formatting () -;; "Remove any formatting made by flymake." -;; ) - -;; (defun flymake-get-program-dir (buffer) -;; "Get dir to start program in." -;; (unless (bufferp buffer) -;; (error "Invalid buffer")) -;; (with-current-buffer buffer -;; default-directory)) - -(defun flymake-safe-delete-file (file-name) - (when (and file-name (file-exists-p file-name)) - (delete-file file-name) - (flymake-log 1 "deleted file %s" file-name))) - -(defun flymake-safe-delete-directory (dir-name) - (condition-case nil - (progn - (delete-directory dir-name) - (flymake-log 1 "deleted dir %s" dir-name)) - (error - (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) - -(defun flymake-start-syntax-check () - "Start syntax checking for current buffer." - (interactive) - (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (and (not flymake-is-running) - (flymake-can-syntax-check-file buffer-file-name)) - (when (or (not flymake-compilation-prevents-syntax-check) - (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") - (flymake-clear-buildfile-cache) - (flymake-clear-project-include-dirs-cache) - - (setq flymake-check-was-interrupted nil) - - (let* ((source-file-name buffer-file-name) - (init-f (flymake-get-init-function source-file-name)) - (cleanup-f (flymake-get-cleanup-function source-file-name)) - (cmd-and-args (funcall init-f)) - (cmd (nth 0 cmd-and-args)) - (args (nth 1 cmd-and-args)) - (dir (nth 2 cmd-and-args))) - (if (not cmd-and-args) - (progn - (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) - (funcall cleanup-f)) - (progn - (setq flymake-last-change-time nil) - (flymake-start-syntax-check-process cmd args dir))))))) - -(defun flymake-start-syntax-check-process (cmd args dir) - "Start syntax check process." - (condition-case err - (let* ((process - (let ((default-directory (or dir default-directory))) - (when dir - (flymake-log 3 "starting process on dir %s" dir)) - (apply 'start-file-process - "flymake-proc" (current-buffer) cmd args)))) - (set-process-sentinel process 'flymake-process-sentinel) - (set-process-filter process 'flymake-process-filter) - (set-process-query-on-exit-flag process nil) - (push process flymake-processes) - - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (float-time)) - - (flymake-report-status nil "*") - (flymake-log 2 "started process %d, command=%s, dir=%s" - (process-id process) (process-command process) - default-directory) - process) - (error - (let* ((err-str - (format-message - "Failed to launch syntax check process `%s' with args %s: %s" - cmd args (error-message-string err))) - (source-file-name buffer-file-name) - (cleanup-f (flymake-get-cleanup-function source-file-name))) - (flymake-log 0 err-str) - (funcall cleanup-f) - (flymake-report-fatal-status "PROCERR" err-str))))) - -(defun flymake-kill-process (proc) - "Kill process PROC." - (kill-process proc) - (let* ((buf (process-buffer proc))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq flymake-check-was-interrupted t)))) - (flymake-log 1 "killed process %d" (process-id proc))) - -(defun flymake-stop-all-syntax-checks () - "Kill all syntax check processes." - (interactive) - (while flymake-processes - (flymake-kill-process (pop flymake-processes)))) - -(defun flymake-compilation-is-running () - (and (boundp 'compilation-in-progress) - compilation-in-progress)) - -(defun flymake-compile () - "Kill all flymake syntax checks, start compilation." - (interactive) - (flymake-stop-all-syntax-checks) - (call-interactively 'compile)) - -;;;; general init-cleanup and helper routines -(defun flymake-create-temp-inplace (file-name prefix) - (unless (stringp file-name) - (error "Invalid file-name")) - (or prefix - (setq prefix "flymake")) - (let* ((ext (file-name-extension file-name)) - (temp-name (file-truename - (concat (file-name-sans-extension file-name) - "_" prefix - (and ext (concat "." ext)))))) - (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) - temp-name)) - -(defun flymake-create-temp-with-folder-structure (file-name _prefix) - (unless (stringp file-name) - (error "Invalid file-name")) - - (let* ((dir (file-name-directory file-name)) - ;; Not sure what this slash-pos is all about, but I guess it's just - ;; trying to remove the leading / of absolute file names. - (slash-pos (string-match "/" dir)) - (temp-dir (expand-file-name (substring dir (1+ slash-pos)) - temporary-file-directory))) - - (file-truename (expand-file-name (file-name-nondirectory file-name) - temp-dir)))) - -(defun flymake-delete-temp-directory (dir-name) - "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." - (let* ((temp-dir temporary-file-directory) - (suffix (substring dir-name (1+ (length temp-dir))))) - - (while (> (length suffix) 0) - (setq suffix (directory-file-name suffix)) - ;;+(flymake-log 0 "suffix=%s" suffix) - (flymake-safe-delete-directory - (file-truename (expand-file-name suffix temp-dir))) - (setq suffix (file-name-directory suffix))))) - -(defvar-local flymake-temp-source-file-name nil) -(defvar-local flymake-master-file-name nil) -(defvar-local flymake-temp-master-file-name nil) -(defvar-local flymake-base-dir nil) - -(defun flymake-init-create-temp-buffer-copy (create-temp-f) - "Make a temporary copy of the current buffer, save its name in buffer data and return the name." - (let* ((source-file-name buffer-file-name) - (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) - - (flymake-save-buffer-in-file temp-source-file-name) - (setq flymake-temp-source-file-name temp-source-file-name) - temp-source-file-name)) - -(defun flymake-simple-cleanup () - "Do cleanup after `flymake-init-create-temp-buffer-copy'. -Delete temp file." - (flymake-safe-delete-file flymake-temp-source-file-name) - (setq flymake-last-change-time nil)) - -(defun flymake-get-real-file-name (file-name-from-err-msg) - "Translate file name from error message to \"real\" file name. -Return full-name. Names are real, not patched." - (let* ((real-name nil) - (source-file-name buffer-file-name) - (master-file-name flymake-master-file-name) - (temp-source-file-name flymake-temp-source-file-name) - (temp-master-file-name flymake-temp-master-file-name) - (base-dirs - (list flymake-base-dir - (file-name-directory source-file-name) - (if master-file-name (file-name-directory master-file-name)))) - (files (list (list source-file-name source-file-name) - (list temp-source-file-name source-file-name) - (list master-file-name master-file-name) - (list temp-master-file-name master-file-name)))) - - (when (equal 0 (length file-name-from-err-msg)) - (setq file-name-from-err-msg source-file-name)) - - (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) - ;; if real-name is nil, than file name from err msg is none of the files we've patched - (if (not real-name) - (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) - (if (not real-name) - (setq real-name file-name-from-err-msg)) - (setq real-name (flymake-fix-file-name real-name)) - (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) - real-name)) - -(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files) - (let* ((base-dirs-count (length base-dirs)) - (file-count (length files)) - (real-name nil)) - - (while (and (not real-name) (> base-dirs-count 0)) - (setq file-count (length files)) - (while (and (not real-name) (> file-count 0)) - (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) - (this-file (nth 0 (nth (1- file-count) files))) - (this-real-name (nth 1 (nth (1- file-count) files)))) - ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) - (when (and this-dir this-file (flymake-same-files - (expand-file-name file-name-from-err-msg this-dir) - this-file)) - (setq real-name this-real-name))) - (setq file-count (1- file-count))) - (setq base-dirs-count (1- base-dirs-count))) - real-name)) - -(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) - (let* ((real-name nil)) - (if (file-name-absolute-p file-name-from-err-msg) - (setq real-name file-name-from-err-msg) - (let* ((base-dirs-count (length base-dirs))) - (while (and (not real-name) (> base-dirs-count 0)) - (let* ((full-name (expand-file-name file-name-from-err-msg - (nth (1- base-dirs-count) base-dirs)))) - (if (file-exists-p full-name) - (setq real-name full-name)) - (setq base-dirs-count (1- base-dirs-count)))))) - real-name)) - -(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name) - "Find buildfile, store its dir in buffer data and return its dir, if found." - (let* ((buildfile-dir - (flymake-find-buildfile buildfile-name - (file-name-directory source-file-name)))) - (if buildfile-dir - (setq flymake-base-dir buildfile-dir) - (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) - (flymake-report-fatal-status - "NOMK" (format "No buildfile (%s) found for %s" - buildfile-name source-file-name))))) - -(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) - "Find master file (or buffer), create its copy along with a copy of the source file." - (let* ((source-file-name buffer-file-name) - (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) - (master-and-temp-master (flymake-create-master-file - source-file-name temp-source-file-name - get-incl-dirs-f create-temp-f - master-file-masks include-regexp))) - - (if (not master-and-temp-master) - (progn - (flymake-log 1 "cannot find master file for %s" source-file-name) - (flymake-report-status "!" "") ; NOMASTER - nil) - (setq flymake-master-file-name (nth 0 master-and-temp-master)) - (setq flymake-temp-master-file-name (nth 1 master-and-temp-master))))) - -(defun flymake-master-cleanup () - (flymake-simple-cleanup) - (flymake-safe-delete-file flymake-temp-master-file-name)) - -;;;; make-specific init-cleanup routines -(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) - "Create a command line for syntax check using GET-CMD-LINE-F." - (funcall get-cmd-line-f - (if use-relative-source - (file-relative-name source-file-name base-dir) - source-file-name) - (if use-relative-base-dir - (file-relative-name base-dir - (file-name-directory source-file-name)) - base-dir))) - -(defun flymake-get-make-cmdline (source base-dir) - (list "make" - (list "-s" - "-C" - base-dir - (concat "CHK_SOURCES=" source) - "SYNTAX_CHECK_MODE=1" - "check-syntax"))) - -(defun flymake-get-ant-cmdline (source base-dir) - (list "ant" - (list "-buildfile" - (concat base-dir "/" "build.xml") - (concat "-DCHK_SOURCES=" source) - "check-syntax"))) - -(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) - "Create syntax check command line for a directly checked source file. -Use CREATE-TEMP-F for creating temp copy." - (let* ((args nil) - (source-file-name buffer-file-name) - (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name))) - (if buildfile-dir - (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))) - (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir - use-relative-base-dir use-relative-source - get-cmdline-f)))) - args)) - -(defun flymake-simple-make-init () - (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) - -(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) - "Create make command line for a source file checked via master file compilation." - (let* ((make-args nil) - (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - get-incl-dirs-f 'flymake-create-temp-inplace - master-file-masks include-regexp))) - (when temp-master-file-name - (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) - (if buildfile-dir - (setq make-args (flymake-get-syntax-check-program-args - temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline))))) - make-args)) - -(defun flymake-find-make-buildfile (source-dir) - (flymake-find-buildfile "Makefile" source-dir)) - -;;;; .h/make specific -(defun flymake-master-make-header-init () - (flymake-master-make-init - 'flymake-get-include-dirs - '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") - "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) - -;;;; .java/make specific -(defun flymake-simple-make-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)) - -(defun flymake-simple-ant-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline)) - -(defun flymake-simple-java-cleanup () - "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs." - (flymake-safe-delete-file flymake-temp-source-file-name) - (when flymake-temp-source-file-name - (flymake-delete-temp-directory - (file-name-directory flymake-temp-source-file-name)))) - -;;;; perl-specific init-cleanup routines -(defun flymake-perl-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "perl" (list "-wc " local-file)))) - -;;;; php-specific init-cleanup routines -(defun flymake-php-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "php" (list "-f" local-file "-l")))) - -;;;; tex-specific init-cleanup routines -(defun flymake-get-tex-args (file-name) - ;;(list "latex" (list "-c-style-errors" file-name)) - (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) - -(defun flymake-simple-tex-init () - (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) - -;; Perhaps there should be a buffer-local variable flymake-master-file -;; that people can set to override this stuff. Could inherit from -;; the similar AUCTeX variable. -(defun flymake-master-tex-init () - (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace - '("\\.tex\\'") - "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) - (when temp-master-file-name - (flymake-get-tex-args temp-master-file-name)))) - -(defun flymake-get-include-dirs-dot (_base-dir) - '(".")) - -;;;; xml-specific init-cleanup routines -(defun flymake-xml-init () - (list flymake-xml-program - (list "val" (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)))) - -(provide 'flymake-proc) -;;; flymake-proc.el ends here diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el deleted file mode 100644 index 2a15a497d84..00000000000 --- a/lisp/progmodes/flymake-ui.el +++ /dev/null @@ -1,604 +0,0 @@ -;;; flymake-ui.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*- - -;; Copyright (C) 2003-2017 Free Software Foundation, Inc. - -;; Author: Pavel Kobyakov -;; Maintainer: Leo Liu -;; Version: 0.3 -;; Keywords: c languages tools - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.xo -;; -;; This file contains the UI for displaying and interacting with the -;; results of such checks, as well as entry points for backends to -;; hook on to. Backends are sources of diagnostic info. -;; -;;; Code: - -(eval-when-compile (require 'cl-lib)) - -(defgroup flymake nil - "Universal on-the-fly syntax checker." - :version "23.1" - :link '(custom-manual "(flymake) Top") - :group 'tools) - -(defcustom flymake-error-bitmap '(exclamation-mark error) - "Bitmap (a symbol) used in the fringe for indicating errors. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-warning-bitmap 'question-mark - "Bitmap (a symbol) used in the fringe for indicating warnings. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-fringe-indicator-position 'left-fringe - "The position to put flymake fringe indicator. -The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. -See `flymake-error-bitmap' and `flymake-warning-bitmap'." - :group 'flymake - :version "24.3" - :type '(choice (const left-fringe) - (const right-fringe) - (const :tag "No fringe indicators" nil))) - -(defcustom flymake-start-syntax-check-on-newline t - "Start syntax check if newline char was added/removed from the buffer." - :group 'flymake - :type 'boolean) - -(defcustom flymake-no-changes-timeout 0.5 - "Time to wait after last change before starting compilation." - :group 'flymake - :type 'number) - -(defcustom flymake-gui-warnings-enabled t - "Enables/disables GUI warnings." - :group 'flymake - :type 'boolean) -(make-obsolete-variable 'flymake-gui-warnings-enabled - "it no longer has any effect." "26.1") - -(defcustom flymake-start-syntax-check-on-find-file t - "Start syntax check on find file." - :group 'flymake - :type 'boolean) - -(defcustom flymake-log-level -1 - "Logging level, only messages with level lower or equal will be logged. --1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" - :group 'flymake - :type 'integer) - -(defvar-local flymake-timer nil - "Timer for starting syntax check.") - -(defvar-local flymake-last-change-time nil - "Time of last buffer change.") - -(defvar-local flymake-check-start-time nil - "Time at which syntax check was started.") - -(defvar-local flymake-check-was-interrupted nil - "Non-nil if syntax check was killed by `flymake-compile'.") - -(defvar-local flymake-err-info nil - "Sorted list of line numbers and lists of err info in the form (file, err-text).") - -(defvar-local flymake-new-err-info nil - "Same as `flymake-err-info', effective when a syntax check is in progress.") - -(defun flymake-log (level text &rest args) - "Log a message at level LEVEL. -If LEVEL is higher than `flymake-log-level', the message is -ignored. Otherwise, it is printed using `message'. -TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see the function `format')." - (if (<= level flymake-log-level) - (let* ((msg (apply #'format-message text args))) - (message "%s" msg)))) - -(defun flymake-ins-after (list pos val) - "Insert VAL into LIST after position POS. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) - tmp)) - -(defun flymake-set-at (list pos val) - "Set VAL at position POS in LIST. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcar (nthcdr pos tmp) val) - tmp)) - -(defun flymake-er-make-er (line-no line-err-info-list) - (list line-no line-err-info-list)) - -(defun flymake-er-get-line (err-info) - (nth 0 err-info)) - -(defun flymake-er-get-line-err-info-list (err-info) - (nth 1 err-info)) - -(cl-defstruct (flymake-ler - (:constructor nil) - (:constructor flymake-ler-make-ler (file line type text &optional full-file))) - file line type text full-file) - -(defun flymake-ler-set-file (line-err-info file) - (flymake-ler-make-ler file - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-ler-set-full-file (line-err-info full-file) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - full-file)) - -(defun flymake-ler-set-line (line-err-info line) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - line - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-get-line-err-count (line-err-info-list type) - "Return number of errors of specified TYPE. -Value of TYPE is either \"e\" or \"w\"." - (let* ((idx 0) - (count (length line-err-info-list)) - (err-count 0)) - - (while (< idx count) - (when (equal type (flymake-ler-type (nth idx line-err-info-list))) - (setq err-count (1+ err-count))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-get-err-count (err-info-list type) - "Return number of errors of specified TYPE for ERR-INFO-LIST." - (let* ((idx 0) - (count (length err-info-list)) - (err-count 0)) - (while (< idx count) - (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-highlight-err-lines (err-info-list) - "Highlight error lines in BUFFER using info from ERR-INFO-LIST." - (save-excursion - (dolist (err err-info-list) - (flymake-highlight-line (car err) (nth 1 err))))) - -(defun flymake-overlay-p (ov) - "Determine whether overlay OV was created by flymake." - (and (overlayp ov) (overlay-get ov 'flymake-overlay))) - -(defun flymake-make-overlay (beg end tooltip-text face bitmap) - "Allocate a flymake overlay in range BEG and END." - (when (not (flymake-region-has-flymake-overlays beg end)) - (let ((ov (make-overlay beg end nil t)) - (fringe (and flymake-fringe-indicator-position - (propertize "!" 'display - (cons flymake-fringe-indicator-position - (if (listp bitmap) - bitmap - (list bitmap))))))) - (overlay-put ov 'face face) - (overlay-put ov 'help-echo tooltip-text) - (overlay-put ov 'flymake-overlay t) - (overlay-put ov 'priority 100) - (overlay-put ov 'evaporate t) - (overlay-put ov 'before-string fringe) - ;;+(flymake-log 3 "created overlay %s" ov) - ov) - (flymake-log 3 "created an overlay at (%d-%d)" beg end))) - -(defun flymake-delete-own-overlays () - "Delete all flymake overlays in BUFFER." - (dolist (ol (overlays-in (point-min) (point-max))) - (when (flymake-overlay-p ol) - (delete-overlay ol) - ;;+(flymake-log 3 "deleted overlay %s" ol) - ))) - -(defun flymake-region-has-flymake-overlays (beg end) - "Check if region specified by BEG and END has overlay. -Return t if it has at least one flymake overlay, nil if no overlay." - (let ((ov (overlays-in beg end)) - (has-flymake-overlays nil)) - (while (consp ov) - (when (flymake-overlay-p (car ov)) - (setq has-flymake-overlays t)) - (setq ov (cdr ov))) - has-flymake-overlays)) - -(defface flymake-errline - '((((supports :underline (:style wave))) - :underline (:style wave :color "Red1")) - (t - :inherit error)) - "Face used for marking error lines." - :version "24.4" - :group 'flymake) - -(defface flymake-warnline - '((((supports :underline (:style wave))) - :underline (:style wave :color "DarkOrange")) - (t - :inherit warning)) - "Face used for marking warning lines." - :version "24.4" - :group 'flymake) - -(defun flymake-highlight-line (line-no line-err-info-list) - "Highlight line LINE-NO in current buffer. -Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." - (goto-char (point-min)) - (forward-line (1- line-no)) - (pcase-let* ((beg (progn (back-to-indentation) (point))) - (end (progn - (end-of-line) - (skip-chars-backward " \t\f\t\n" beg) - (if (eq (point) beg) - (line-beginning-position 2) - (point)))) - (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) - (`(,face ,bitmap) - (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (list 'flymake-errline flymake-error-bitmap) - (list 'flymake-warnline flymake-warning-bitmap)))) - (flymake-make-overlay beg end tooltip-text face bitmap))) - -(defun flymake-find-err-info (err-info-list line-no) - "Find (line-err-info-list pos) for specified LINE-NO." - (if err-info-list - (let* ((line-err-info-list nil) - (pos 0) - (count (length err-info-list))) - - (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) - (setq pos (1+ pos))) - (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) - (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list)))) - (list line-err-info-list pos)) - '(nil 0))) - -(defun flymake-line-err-info-is-less-or-equal (line-one line-two) - (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) - (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) - -(defun flymake-add-line-err-info (line-err-info-list line-err-info) - "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. -The new element is inserted in the proper position, according to -the predicate `flymake-line-err-info-is-less-or-equal'. -The updated value of LINE-ERR-INFO-LIST is returned." - (if (not line-err-info-list) - (list line-err-info) - (let* ((count (length line-err-info-list)) - (idx 0)) - (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) - (setq idx (1+ idx))) - (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) - (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info)))) - line-err-info-list))) - -(defun flymake-add-err-info (err-info-list line-err-info) - "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order. -Returns the updated value of ERR-INFO-LIST. -For the format of ERR-INFO-LIST, see `flymake-err-info'. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." - (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) - (info-and-pos (flymake-find-err-info err-info-list line-no)) - (exists (car info-and-pos)) - (pos (nth 1 info-and-pos)) - (line-err-info-list nil) - (err-info nil)) - - (if exists - (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list))))) - (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) - - (setq err-info (flymake-er-make-er line-no line-err-info-list)) - (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) - ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) - (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info)))) - err-info-list)) - -(defvar-local flymake-is-running nil - "If t, flymake syntax check process is running for the current buffer.") - -(defun flymake-on-timer-event (buffer) - "Start a syntax check for buffer BUFFER if necessary." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and (not flymake-is-running) - flymake-last-change-time - (> (- (float-time) flymake-last-change-time) - flymake-no-changes-timeout)) - - (setq flymake-last-change-time nil) - (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake-start-syntax-check))))) - -(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line - 'flymake-popup-current-error-menu "24.4") - -(defun flymake-popup-current-error-menu (&optional event) - "Pop up a menu with errors/warnings for current line." - (interactive (list last-nonmenu-event)) - (let* ((line-no (line-number-at-pos)) - (errors (or (car (flymake-find-err-info flymake-err-info line-no)) - (user-error "No errors for current line"))) - (menu (mapcar (lambda (x) - (if (flymake-ler-file x) - (cons (format "%s - %s(%d)" - (flymake-ler-text x) - (flymake-ler-file x) - (flymake-ler-line x)) - x) - (list (flymake-ler-text x)))) - errors)) - (event (if (mouse-event-p event) - event - (list 'mouse-1 (posn-at-point)))) - (title (format "Line %d: %d error(s), %d warning(s)" - line-no - (flymake-get-line-err-count errors "e") - (flymake-get-line-err-count errors "w"))) - (choice (x-popup-menu event (list title (cons "" menu))))) - (flymake-log 3 "choice=%s" choice) - (when choice - (flymake-goto-file-and-line (flymake-ler-full-file choice) - (flymake-ler-line choice))))) - -(defun flymake-goto-file-and-line (file line) - "Try to get buffer for FILE and goto line LINE in it." - (if (not (file-exists-p file)) - (flymake-log 1 "File %s does not exist" file) - (find-file file) - (goto-char (point-min)) - (forward-line (1- line)))) - -;; flymake minor mode declarations -(defvar-local flymake-mode-line nil) -(defvar-local flymake-mode-line-e-w nil) -(defvar-local flymake-mode-line-status nil) - -(defun flymake-report-status (e-w &optional status) - "Show status in mode line." - (when e-w - (setq flymake-mode-line-e-w e-w)) - (when status - (setq flymake-mode-line-status status)) - (let* ((mode-line " Flymake")) - (when (> (length flymake-mode-line-e-w) 0) - (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) - (setq mode-line (concat mode-line flymake-mode-line-status)) - (setq flymake-mode-line mode-line) - (force-mode-line-update))) - -;; Nothing in flymake uses this at all any more, so this is just for -;; third-party compatibility. -(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") - -(defun flymake-report-fatal-status (status warning) - "Display a warning and switch flymake mode off." - ;; This first message was always shown by default, and flymake-log - ;; does nothing by default, hence the use of message. - ;; Another option is display-warning. - (if (< flymake-log-level 0) - (message "Flymake: %s. Flymake will be switched OFF" warning)) - (flymake-mode 0) - (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" - (buffer-name) status warning)) - -;;;###autoload -(define-minor-mode flymake-mode nil - :group 'flymake :lighter flymake-mode-line - (cond - - ;; Turning the mode ON. - (flymake-mode - (cond - ((not buffer-file-name) - (message "Flymake unable to run without a buffer file name")) - ((not (flymake-can-syntax-check-file buffer-file-name)) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) - (t - (add-hook 'after-change-functions 'flymake-after-change-function nil t) - (add-hook 'after-save-hook 'flymake-after-save-hook nil t) - (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - - (flymake-report-status "" "") - - (setq flymake-timer - (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - - (when (and flymake-start-syntax-check-on-find-file - ;; Since we write temp files in current dir, there's no point - ;; trying if the directory is read-only (bug#8954). - (file-writable-p (file-name-directory buffer-file-name))) - (with-demoted-errors - (flymake-start-syntax-check)))))) - - ;; Turning the mode OFF. - (t - (remove-hook 'after-change-functions 'flymake-after-change-function t) - (remove-hook 'after-save-hook 'flymake-after-save-hook t) - (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) - ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - - (flymake-delete-own-overlays) - - (when flymake-timer - (cancel-timer flymake-timer) - (setq flymake-timer nil)) - - (setq flymake-is-running nil)))) - -;; disabling flymake-mode is safe, enabling - not necessarily so -(put 'flymake-mode 'safe-local-variable 'null) - -;;;###autoload -(defun flymake-mode-on () - "Turn flymake mode on." - (flymake-mode 1) - (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name))) - -;;;###autoload -(defun flymake-mode-off () - "Turn flymake mode off." - (flymake-mode 0) - (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) - -(defun flymake-after-change-function (start stop _len) - "Start syntax check for current buffer if it isn't already running." - ;;+(flymake-log 0 "setting change time to %s" (float-time)) - (let((new-text (buffer-substring start stop))) - (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) - (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake-start-syntax-check)) - (setq flymake-last-change-time (float-time)))) - -(defun flymake-after-save-hook () - (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? - (progn - (flymake-log 3 "starting syntax check as buffer was saved") - (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) - -(defun flymake-kill-buffer-hook () - (when flymake-timer - (cancel-timer flymake-timer) - (setq flymake-timer nil))) - -;;;###autoload -(defun flymake-find-file-hook () - ;;+(when flymake-start-syntax-check-on-find-file - ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake-start-syntax-check) - ;;+) - (when (and (not (local-variable-p 'flymake-mode (current-buffer))) - (flymake-can-syntax-check-file buffer-file-name)) - (flymake-mode) - (flymake-log 3 "automatically turned ON flymake mode"))) - -(defun flymake-get-first-err-line-no (err-info-list) - "Return first line with error." - (when err-info-list - (flymake-er-get-line (car err-info-list)))) - -(defun flymake-get-last-err-line-no (err-info-list) - "Return last line with error." - (when err-info-list - (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)))) - -(defun flymake-get-next-err-line-no (err-info-list line-no) - "Return next line with error." - (when err-info-list - (let* ((count (length err-info-list)) - (idx 0)) - (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) - (setq idx (1+ idx))) - (if (< idx count) - (flymake-er-get-line (nth idx err-info-list)))))) - -(defun flymake-get-prev-err-line-no (err-info-list line-no) - "Return previous line with error." - (when err-info-list - (let* ((count (length err-info-list))) - (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) - (setq count (1- count))) - (if (> count 0) - (flymake-er-get-line (nth (1- count) err-info-list)))))) - -(defun flymake-skip-whitespace () - "Move forward until non-whitespace is reached." - (while (looking-at "[ \t]") - (forward-char))) - -(defun flymake-goto-line (line-no) - "Go to line LINE-NO, then skip whitespace." - (goto-char (point-min)) - (forward-line (1- line-no)) - (flymake-skip-whitespace)) - -(defun flymake-goto-next-error () - "Go to next error in err ring." - (interactive) - (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-first-err-line-no flymake-err-info)) - (flymake-log 1 "passed end of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-goto-prev-error () - "Go to previous error in err ring." - (interactive) - (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-last-err-line-no flymake-err-info)) - (flymake-log 1 "passed beginning of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-patch-err-text (string) - (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) - (match-string 1 string) - string)) - -(provide 'flymake-ui) -;;; flymake-ui.el ends here diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 059bce95eed..866116fbecd 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -24,18 +24,1629 @@ ;;; Commentary: ;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. -;; -;; It collects diagnostic information for multiple sources and -;; visually annotates the relevant lines in the buffer. -;; -;; This file is just a stub for that loads the UI and backends, which -;; could also be loaded separately. +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks +;; using the external syntax check tool (for C/C++ this is usually the +;; compiler). + +;;; Bugs/todo: + +;; - Only uses "Makefile", not "makefile" or "GNUmakefile" +;; (from http://bugs.debian.org/337339). ;;; Code: -(require 'flymake-ui) -(require 'flymake-proc) +(eval-when-compile (require 'cl-lib)) + +(defgroup flymake nil + "Universal on-the-fly syntax checker." + :version "23.1" + :link '(custom-manual "(flymake) Top") + :group 'tools) + +(defcustom flymake-error-bitmap '(exclamation-mark error) + "Bitmap (a symbol) used in the fringe for indicating errors. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :group 'flymake + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-warning-bitmap 'question-mark + "Bitmap (a symbol) used in the fringe for indicating warnings. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :group 'flymake + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-fringe-indicator-position 'left-fringe + "The position to put flymake fringe indicator. +The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. +See `flymake-error-bitmap' and `flymake-warning-bitmap'." + :group 'flymake + :version "24.3" + :type '(choice (const left-fringe) + (const right-fringe) + (const :tag "No fringe indicators" nil))) + +(defcustom flymake-compilation-prevents-syntax-check t + "If non-nil, don't start syntax check if compilation is running." + :group 'flymake + :type 'boolean) + +(defcustom flymake-start-syntax-check-on-newline t + "Start syntax check if newline char was added/removed from the buffer." + :group 'flymake + :type 'boolean) + +(defcustom flymake-no-changes-timeout 0.5 + "Time to wait after last change before starting compilation." + :group 'flymake + :type 'number) + +(defcustom flymake-gui-warnings-enabled t + "Enables/disables GUI warnings." + :group 'flymake + :type 'boolean) +(make-obsolete-variable 'flymake-gui-warnings-enabled + "it no longer has any effect." "26.1") + +(defcustom flymake-start-syntax-check-on-find-file t + "Start syntax check on find file." + :group 'flymake + :type 'boolean) + +(defcustom flymake-log-level -1 + "Logging level, only messages with level lower or equal will be logged. +-1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" + :group 'flymake + :type 'integer) + +(defcustom flymake-xml-program + (if (executable-find "xmlstarlet") "xmlstarlet" "xml") + "Program to use for XML validation." + :type 'file + :group 'flymake + :version "24.4") + +(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") + "Dirs where to look for master files." + :group 'flymake + :type '(repeat (string))) + +(defcustom flymake-master-file-count-limit 32 + "Max number of master files to check." + :group 'flymake + :type 'integer) + +(defcustom flymake-allowed-file-name-masks + '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) + ("\\.xml\\'" flymake-xml-init) + ("\\.html?\\'" flymake-xml-init) + ("\\.cs\\'" flymake-simple-make-init) + ("\\.p[ml]\\'" flymake-perl-init) + ("\\.php[345]?\\'" flymake-php-init) + ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup) + ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup) + ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup) + ("\\.tex\\'" flymake-simple-tex-init) + ("\\.idl\\'" flymake-simple-make-init) + ;; ("\\.cpp\\'" 1) + ;; ("\\.java\\'" 3) + ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") + ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) + ;; ("\\.idl\\'" 1) + ;; ("\\.odl\\'" 1) + ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'") + ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) + ;; ("\\.tex\\'" 1) + ) + "Files syntax checking is allowed for. +This is an alist with elements of the form: + REGEXP INIT [CLEANUP [NAME]] +REGEXP is a regular expression that matches a file name. +INIT is the init function to use, missing means disable `flymake-mode'. +CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. +NAME is the file name function to use, default `flymake-get-real-file-name'." + :group 'flymake + :type '(alist :key-type (regexp :tag "File regexp") + :value-type + (list :tag "Handler functions" + (choice :tag "Init function" + (const :tag "disable" nil) + function) + (choice :tag "Cleanup function" + (const :tag "flymake-simple-cleanup" nil) + function) + (choice :tag "Name function" + (const :tag "flymake-get-real-file-name" nil) + function)))) + +(defvar-local flymake-is-running nil + "If t, flymake syntax check process is running for the current buffer.") + +(defvar-local flymake-timer nil + "Timer for starting syntax check.") + +(defvar-local flymake-last-change-time nil + "Time of last buffer change.") + +(defvar-local flymake-check-start-time nil + "Time at which syntax check was started.") + +(defvar-local flymake-check-was-interrupted nil + "Non-nil if syntax check was killed by `flymake-compile'.") + +(defvar-local flymake-err-info nil + "Sorted list of line numbers and lists of err info in the form (file, err-text).") + +(defvar-local flymake-new-err-info nil + "Same as `flymake-err-info', effective when a syntax check is in progress.") + +(defun flymake-log (level text &rest args) + "Log a message at level LEVEL. +If LEVEL is higher than `flymake-log-level', the message is +ignored. Otherwise, it is printed using `message'. +TEXT is a format control string, and the remaining arguments ARGS +are the string substitutions (see the function `format')." + (if (<= level flymake-log-level) + (let* ((msg (apply #'format-message text args))) + (message "%s" msg)))) + +(defun flymake-ins-after (list pos val) + "Insert VAL into LIST after position POS. +POS counts from zero." + (let ((tmp (copy-sequence list))) + (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) + tmp)) + +(defun flymake-set-at (list pos val) + "Set VAL at position POS in LIST. +POS counts from zero." + (let ((tmp (copy-sequence list))) + (setcar (nthcdr pos tmp) val) + tmp)) + +(defvar flymake-processes nil + "List of currently active flymake processes.") + +(defvar-local flymake-output-residual nil) + +(defun flymake-get-file-name-mode-and-masks (file-name) + "Return the corresponding entry from `flymake-allowed-file-name-masks'." + (unless (stringp file-name) + (error "Invalid file-name")) + (let ((fnm flymake-allowed-file-name-masks) + (mode-and-masks nil)) + (while (and (not mode-and-masks) fnm) + (let ((item (pop fnm))) + (when (string-match (car item) file-name) + (setq mode-and-masks item)))) ; (cdr item) may be nil + (setq mode-and-masks (cdr mode-and-masks)) + (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) + mode-and-masks)) + +(defun flymake-can-syntax-check-file (file-name) + "Determine whether we can syntax check FILE-NAME. +Return nil if we cannot, non-nil if we can." + (if (flymake-get-init-function file-name) t nil)) + +(defun flymake-get-init-function (file-name) + "Return init function to be used for the file." + (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) + ;;(flymake-log 0 "calling %s" init-f) + ;;(funcall init-f (current-buffer)) + init-f)) + +(defun flymake-get-cleanup-function (file-name) + "Return cleanup function to be used for the file." + (or (nth 1 (flymake-get-file-name-mode-and-masks file-name)) + 'flymake-simple-cleanup)) + +(defun flymake-get-real-file-name-function (file-name) + (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) + 'flymake-get-real-file-name)) + +(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) + +(defun flymake-get-buildfile-from-cache (dir-name) + "Look up DIR-NAME in cache and return its associated value. +If DIR-NAME is not found, return nil." + (gethash dir-name flymake-find-buildfile-cache)) + +(defun flymake-add-buildfile-to-cache (dir-name buildfile) + "Associate DIR-NAME with BUILDFILE in the buildfile cache." + (puthash dir-name buildfile flymake-find-buildfile-cache)) + +(defun flymake-clear-buildfile-cache () + "Clear the buildfile cache." + (clrhash flymake-find-buildfile-cache)) + +(defun flymake-find-buildfile (buildfile-name source-dir-name) + "Find buildfile starting from current directory. +Buildfile includes Makefile, build.xml etc. +Return its file name if found, or nil if not found." + (or (flymake-get-buildfile-from-cache source-dir-name) + (let* ((file (locate-dominating-file source-dir-name buildfile-name))) + (if file + (progn + (flymake-log 3 "found buildfile at %s" file) + (flymake-add-buildfile-to-cache source-dir-name file) + file) + (progn + (flymake-log 3 "buildfile for %s not found" source-dir-name) + nil))))) + +(defun flymake-fix-file-name (name) + "Replace all occurrences of `\\' with `/'." + (when name + (setq name (expand-file-name name)) + (setq name (abbreviate-file-name name)) + (setq name (directory-file-name name)) + name)) + +(defun flymake-same-files (file-name-one file-name-two) + "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. +Return t if so, nil if not." + (equal (flymake-fix-file-name file-name-one) + (flymake-fix-file-name file-name-two))) + +;; This is bound dynamically to pass a parameter to a sort predicate below +(defvar flymake-included-file-name) + +(defun flymake-find-possible-master-files (file-name master-file-dirs masks) + "Find (by name and location) all possible master files. + +Name is specified by FILE-NAME and location is specified by +MASTER-FILE-DIRS. Master files include .cpp and .c for .h. +Files are searched for starting from the .h directory and max +max-level parent dirs. File contents are not checked." + (let* ((dirs master-file-dirs) + (files nil) + (done nil)) + + (while (and (not done) dirs) + (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) + (masks masks)) + (while (and (file-exists-p dir) (not done) masks) + (let* ((mask (car masks)) + (dir-files (directory-files dir t mask))) + + (flymake-log 3 "dir %s, %d file(s) for mask %s" + dir (length dir-files) mask) + (while (and (not done) dir-files) + (when (not (file-directory-p (car dir-files))) + (setq files (cons (car dir-files) files)) + (when (>= (length files) flymake-master-file-count-limit) + (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) + (setq done t))) + (setq dir-files (cdr dir-files)))) + (setq masks (cdr masks)))) + (setq dirs (cdr dirs))) + (when files + (let ((flymake-included-file-name (file-name-nondirectory file-name))) + (setq files (sort files 'flymake-master-file-compare)))) + (flymake-log 3 "found %d possible master file(s)" (length files)) + files)) + +(defun flymake-master-file-compare (file-one file-two) + "Compare two files specified by FILE-ONE and FILE-TWO. +This function is used in sort to move most possible file names +to the beginning of the list (File.h -> File.cpp moved to top)." + (and (equal (file-name-sans-extension flymake-included-file-name) + (file-name-base file-one)) + (not (equal file-one file-two)))) + +(defvar flymake-check-file-limit 8192 + "Maximum number of chars to look at when checking possible master file. +Nil means search the entire file.") + +(defun flymake-check-patch-master-file-buffer + (master-file-temp-buffer + master-file-name patched-master-file-name + source-file-name patched-source-file-name + include-dirs regexp) + "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. +If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME +instead of SOURCE-FILE-NAME. + +For example, foo.cpp is a master file if it includes foo.h. + +When a buffer for MASTER-FILE-NAME exists, use it as a source +instead of reading master file from disk." + (let* ((source-file-nondir (file-name-nondirectory source-file-name)) + (source-file-extension (file-name-extension source-file-nondir)) + (source-file-nonext (file-name-sans-extension source-file-nondir)) + (found nil) + (inc-name nil) + (search-limit flymake-check-file-limit)) + (setq regexp + (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" + ;; Hack for tex files, where \include often excludes .tex. + ;; Maybe this is safe generally. + (if (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex")) + (format "%s\\(?:\\.%s\\)?" + (regexp-quote source-file-nonext) + (regexp-quote source-file-extension)) + (regexp-quote source-file-nondir)))) + (unwind-protect + (with-current-buffer master-file-temp-buffer + (if (or (not search-limit) + (> search-limit (point-max))) + (setq search-limit (point-max))) + (flymake-log 3 "checking %s against regexp %s" + master-file-name regexp) + (goto-char (point-min)) + (while (and (< (point) search-limit) + (re-search-forward regexp search-limit t)) + (let ((match-beg (match-beginning 1)) + (match-end (match-end 1))) + + (flymake-log 3 "found possible match for %s" source-file-nondir) + (setq inc-name (match-string 1)) + (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex") + (not (string-match (format "\\.%s\\'" source-file-extension) + inc-name)) + (setq inc-name (concat inc-name "." source-file-extension))) + (when (eq t (compare-strings + source-file-nondir nil nil + inc-name (- (length inc-name) + (length source-file-nondir)) nil)) + (flymake-log 3 "inc-name=%s" inc-name) + (when (flymake-check-include source-file-name inc-name + include-dirs) + (setq found t) + ;; replace-match is not used here as it fails in + ;; XEmacs with 'last match not a buffer' error as + ;; check-includes calls replace-in-string + (flymake-replace-region + match-beg match-end + (file-name-nondirectory patched-source-file-name)))) + (forward-line 1))) + (when found + (flymake-save-buffer-in-file patched-master-file-name))) + ;;+(flymake-log 3 "killing buffer %s" + ;; (buffer-name master-file-temp-buffer)) + (kill-buffer master-file-temp-buffer)) + ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) + (when found + (flymake-log 2 "found master file %s" master-file-name)) + found)) + +;;; XXX: remove +(defun flymake-replace-region (beg end rep) + "Replace text in BUFFER in region (BEG END) with REP." + (save-excursion + (goto-char end) + ;; Insert before deleting, so as to better preserve markers's positions. + (insert rep) + (delete-region beg end))) + +(defun flymake-read-file-to-temp-buffer (file-name) + "Insert contents of FILE-NAME into newly created temp buffer." + (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) + (with-current-buffer temp-buffer + (insert-file-contents file-name)) + temp-buffer)) + +(defun flymake-copy-buffer-to-temp-buffer (buffer) + "Copy contents of BUFFER into newly created temp buffer." + (with-current-buffer + (get-buffer-create (generate-new-buffer-name + (concat "flymake:" (buffer-name buffer)))) + (insert-buffer-substring buffer) + (current-buffer))) + +(defun flymake-check-include (source-file-name inc-name include-dirs) + "Check if SOURCE-FILE-NAME can be found in include path. +Return t if it can be found via include path using INC-NAME." + (if (file-name-absolute-p inc-name) + (flymake-same-files source-file-name inc-name) + (while (and include-dirs + (not (flymake-same-files + source-file-name + (concat (file-name-directory source-file-name) + "/" (car include-dirs) + "/" inc-name)))) + (setq include-dirs (cdr include-dirs))) + include-dirs)) + +(defun flymake-find-buffer-for-file (file-name) + "Check if there exists a buffer visiting FILE-NAME. +Return t if so, nil if not." + (let ((buffer-name (get-file-buffer file-name))) + (if buffer-name + (get-buffer buffer-name)))) + +(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) + "Save SOURCE-FILE-NAME with a different name. +Find master file, patch and save it." + (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) + (master-file-count (length possible-master-files)) + (idx 0) + (temp-buffer nil) + (master-file-name nil) + (patched-master-file-name nil) + (found nil)) + + (while (and (not found) (< idx master-file-count)) + (setq master-file-name (nth idx possible-master-files)) + (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) + (if (flymake-find-buffer-for-file master-file-name) + (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) + (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name))) + (setq found + (flymake-check-patch-master-file-buffer + temp-buffer + master-file-name + patched-master-file-name + source-file-name + patched-source-file-name + (funcall get-incl-dirs-f (file-name-directory master-file-name)) + include-regexp)) + (setq idx (1+ idx))) + (if found + (list master-file-name patched-master-file-name) + (progn + (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count + (file-name-nondirectory source-file-name)) + nil)))) + +(defun flymake-save-buffer-in-file (file-name) + "Save the entire buffer contents into file FILE-NAME. +Create parent directories as needed." + (make-directory (file-name-directory file-name) 1) + (write-region nil nil file-name nil 566) + (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) + +(defun flymake-process-filter (process output) + "Parse OUTPUT and highlight error lines. +It's flymake process filter." + (let ((source-buffer (process-buffer process))) + + (flymake-log 3 "received %d byte(s) of output from process %d" + (length output) (process-id process)) + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (flymake-parse-output-and-residual output))))) + +(defun flymake-process-sentinel (process _event) + "Sentinel for syntax check buffers." + (when (memq (process-status process) '(signal exit)) + (let* ((exit-status (process-exit-status process)) + (command (process-command process)) + (source-buffer (process-buffer process)) + (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) + + (flymake-log 2 "process %d exited with code %d" + (process-id process) exit-status) + (condition-case err + (progn + (flymake-log 3 "cleaning up using %s" cleanup-f) + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (funcall cleanup-f))) + + (delete-process process) + (setq flymake-processes (delq process flymake-processes)) + + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + + (flymake-parse-residual) + (flymake-post-syntax-check exit-status command) + (setq flymake-is-running nil)))) + (error + (let ((err-str (format "Error in process sentinel for buffer %s: %s" + source-buffer (error-message-string err)))) + (flymake-log 0 err-str) + (with-current-buffer source-buffer + (setq flymake-is-running nil)))))))) + +(defun flymake-post-syntax-check (exit-status command) + (save-restriction + (widen) + (setq flymake-err-info flymake-new-err-info) + (setq flymake-new-err-info nil) + (setq flymake-err-info + (flymake-fix-line-numbers + flymake-err-info 1 (count-lines (point-min) (point-max)))) + (flymake-delete-own-overlays) + (flymake-highlight-err-lines flymake-err-info) + (let (err-count warn-count) + (setq err-count (flymake-get-err-count flymake-err-info "e")) + (setq warn-count (flymake-get-err-count flymake-err-info "w")) + (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" + (buffer-name) err-count warn-count + (- (float-time) flymake-check-start-time)) + (setq flymake-check-start-time nil) + + (if (and (equal 0 err-count) (equal 0 warn-count)) + (if (equal 0 exit-status) + (flymake-report-status "" "") ; PASSED + (if (not flymake-check-was-interrupted) + (flymake-report-fatal-status "CFGERR" + (format "Configuration error has occurred while running %s" command)) + (flymake-report-status nil ""))) ; "STOPPED" + (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) + +(defun flymake-parse-output-and-residual (output) + "Split OUTPUT into lines, merge in residual if necessary." + (let* ((buffer-residual flymake-output-residual) + (total-output (if buffer-residual (concat buffer-residual output) output)) + (lines-and-residual (flymake-split-output total-output)) + (lines (nth 0 lines-and-residual)) + (new-residual (nth 1 lines-and-residual))) + (setq flymake-output-residual new-residual) + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info lines)))) + +(defun flymake-parse-residual () + "Parse residual if it's non empty." + (when flymake-output-residual + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info + (list flymake-output-residual))) + (setq flymake-output-residual nil))) + +(defun flymake-er-make-er (line-no line-err-info-list) + (list line-no line-err-info-list)) + +(defun flymake-er-get-line (err-info) + (nth 0 err-info)) + +(defun flymake-er-get-line-err-info-list (err-info) + (nth 1 err-info)) + +(cl-defstruct (flymake-ler + (:constructor nil) + (:constructor flymake-ler-make-ler (file line type text &optional full-file))) + file line type text full-file) + +(defun flymake-ler-set-file (line-err-info file) + (flymake-ler-make-ler file + (flymake-ler-line line-err-info) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + (flymake-ler-full-file line-err-info))) + +(defun flymake-ler-set-full-file (line-err-info full-file) + (flymake-ler-make-ler (flymake-ler-file line-err-info) + (flymake-ler-line line-err-info) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + full-file)) + +(defun flymake-ler-set-line (line-err-info line) + (flymake-ler-make-ler (flymake-ler-file line-err-info) + line + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + (flymake-ler-full-file line-err-info))) + +(defun flymake-get-line-err-count (line-err-info-list type) + "Return number of errors of specified TYPE. +Value of TYPE is either \"e\" or \"w\"." + (let* ((idx 0) + (count (length line-err-info-list)) + (err-count 0)) + + (while (< idx count) + (when (equal type (flymake-ler-type (nth idx line-err-info-list))) + (setq err-count (1+ err-count))) + (setq idx (1+ idx))) + err-count)) + +(defun flymake-get-err-count (err-info-list type) + "Return number of errors of specified TYPE for ERR-INFO-LIST." + (let* ((idx 0) + (count (length err-info-list)) + (err-count 0)) + (while (< idx count) + (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) + (setq idx (1+ idx))) + err-count)) + +(defun flymake-fix-line-numbers (err-info-list min-line max-line) + "Replace line numbers with fixed value. +If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. +If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. +The reason for this fix is because some compilers might report +line number outside the file being compiled." + (let* ((count (length err-info-list)) + (err-info nil) + (line 0)) + (while (> count 0) + (setq err-info (nth (1- count) err-info-list)) + (setq line (flymake-er-get-line err-info)) + (when (or (< line min-line) (> line max-line)) + (setq line (if (< line min-line) min-line max-line)) + (setq err-info-list (flymake-set-at err-info-list (1- count) + (flymake-er-make-er line + (flymake-er-get-line-err-info-list err-info))))) + (setq count (1- count)))) + err-info-list) + +(defun flymake-highlight-err-lines (err-info-list) + "Highlight error lines in BUFFER using info from ERR-INFO-LIST." + (save-excursion + (dolist (err err-info-list) + (flymake-highlight-line (car err) (nth 1 err))))) + +(defun flymake-overlay-p (ov) + "Determine whether overlay OV was created by flymake." + (and (overlayp ov) (overlay-get ov 'flymake-overlay))) + +(defun flymake-make-overlay (beg end tooltip-text face bitmap) + "Allocate a flymake overlay in range BEG and END." + (when (not (flymake-region-has-flymake-overlays beg end)) + (let ((ov (make-overlay beg end nil t)) + (fringe (and flymake-fringe-indicator-position + (propertize "!" 'display + (cons flymake-fringe-indicator-position + (if (listp bitmap) + bitmap + (list bitmap))))))) + (overlay-put ov 'face face) + (overlay-put ov 'help-echo tooltip-text) + (overlay-put ov 'flymake-overlay t) + (overlay-put ov 'priority 100) + (overlay-put ov 'evaporate t) + (overlay-put ov 'before-string fringe) + ;;+(flymake-log 3 "created overlay %s" ov) + ov) + (flymake-log 3 "created an overlay at (%d-%d)" beg end))) + +(defun flymake-delete-own-overlays () + "Delete all flymake overlays in BUFFER." + (dolist (ol (overlays-in (point-min) (point-max))) + (when (flymake-overlay-p ol) + (delete-overlay ol) + ;;+(flymake-log 3 "deleted overlay %s" ol) + ))) + +(defun flymake-region-has-flymake-overlays (beg end) + "Check if region specified by BEG and END has overlay. +Return t if it has at least one flymake overlay, nil if no overlay." + (let ((ov (overlays-in beg end)) + (has-flymake-overlays nil)) + (while (consp ov) + (when (flymake-overlay-p (car ov)) + (setq has-flymake-overlays t)) + (setq ov (cdr ov))) + has-flymake-overlays)) + +(defface flymake-errline + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :inherit error)) + "Face used for marking error lines." + :version "24.4" + :group 'flymake) + +(defface flymake-warnline + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :inherit warning)) + "Face used for marking warning lines." + :version "24.4" + :group 'flymake) + +(defun flymake-highlight-line (line-no line-err-info-list) + "Highlight line LINE-NO in current buffer. +Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." + (goto-char (point-min)) + (forward-line (1- line-no)) + (pcase-let* ((beg (progn (back-to-indentation) (point))) + (end (progn + (end-of-line) + (skip-chars-backward " \t\f\t\n" beg) + (if (eq (point) beg) + (line-beginning-position 2) + (point)))) + (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) + (`(,face ,bitmap) + (if (> (flymake-get-line-err-count line-err-info-list "e") 0) + (list 'flymake-errline flymake-error-bitmap) + (list 'flymake-warnline flymake-warning-bitmap)))) + (flymake-make-overlay beg end tooltip-text face bitmap))) + +(defun flymake-parse-err-lines (err-info-list lines) + "Parse err LINES, store info in ERR-INFO-LIST." + (let* ((count (length lines)) + (idx 0) + (line-err-info nil) + (real-file-name nil) + (source-file-name buffer-file-name) + (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) + + (while (< idx count) + (setq line-err-info (flymake-parse-line (nth idx lines))) + (when line-err-info + (setq real-file-name (funcall get-real-file-name-f + (flymake-ler-file line-err-info))) + (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) + + (when (flymake-same-files real-file-name source-file-name) + (setq line-err-info (flymake-ler-set-file line-err-info nil)) + (setq err-info-list (flymake-add-err-info err-info-list line-err-info)))) + (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) + (setq idx (1+ idx))) + err-info-list)) + +(defun flymake-split-output (output) + "Split OUTPUT into lines. +Return last one as residual if it does not end with newline char. +Returns ((LINES) RESIDUAL)." + (when (and output (> (length output) 0)) + (let* ((lines (split-string output "[\n\r]+" t)) + (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) + (residual nil)) + (when (not complete) + (setq residual (car (last lines))) + (setq lines (butlast lines))) + (list lines residual)))) + +(defun flymake-reformat-err-line-patterns-from-compile-el (original-list) + "Grab error line patterns from ORIGINAL-LIST in compile.el format. +Convert it to flymake internal format." + (let* ((converted-list '())) + (dolist (item original-list) + (setq item (cdr item)) + (let ((regexp (nth 0 item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item))) + (if (consp file) (setq file (car file))) + (if (consp line) (setq line (car line))) + (if (consp col) (setq col (car col))) + + (when (not (functionp line)) + (setq converted-list (cons (list regexp file line col) converted-list))))) + converted-list)) + +(require 'compile) + +(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text + (append + '( + ;; MS Visual C++ 6.0 + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; jikes + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; MS midl + ("midl[ ]*:[ ]*\\(command line error .*\\)" + nil nil nil 1) + ;; MS C# + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; perl + ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) + ;; PHP + ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) + ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) + ;; ant/javac. Note this also matches gcc warnings! + (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)" + 2 4 nil 5)) + ;; compilation-error-regexp-alist) + (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) + "Patterns for matching error/warning lines. Each pattern has the form +\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). +Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns +from compile.el") + +(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") +(defvar flymake-warning-predicate "^[wW]arning" + "Predicate matching against error text to detect a warning. +Takes a single argument, the error's text and should return non-nil +if it's a warning. +Instead of a function, it can also be a regular expression.") + +(defun flymake-parse-line (line) + "Parse LINE to see if it is an error or warning. +Return its components if so, nil otherwise." + (let ((raw-file-name nil) + (line-no 0) + (err-type "e") + (err-text nil) + (patterns flymake-err-line-patterns) + (matched nil)) + (while (and patterns (not matched)) + (when (string-match (car (car patterns)) line) + (let* ((file-idx (nth 1 (car patterns))) + (line-idx (nth 2 (car patterns)))) + + (setq raw-file-name (if file-idx (match-string file-idx line) nil)) + (setq line-no (if line-idx (string-to-number + (match-string line-idx line)) 0)) + (setq err-text (if (> (length (car patterns)) 4) + (match-string (nth 4 (car patterns)) line) + (flymake-patch-err-text + (substring line (match-end 0))))) + (if (null err-text) + (setq err-text "") + (when (cond ((stringp flymake-warning-predicate) + (string-match flymake-warning-predicate err-text)) + ((functionp flymake-warning-predicate) + (funcall flymake-warning-predicate err-text))) + (setq err-type "w"))) + (flymake-log + 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" + file-idx line-idx raw-file-name line-no err-text) + (setq matched t))) + (setq patterns (cdr patterns))) + (if matched + (flymake-ler-make-ler raw-file-name line-no err-type err-text) + ()))) + +(defun flymake-find-err-info (err-info-list line-no) + "Find (line-err-info-list pos) for specified LINE-NO." + (if err-info-list + (let* ((line-err-info-list nil) + (pos 0) + (count (length err-info-list))) + + (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) + (setq pos (1+ pos))) + (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) + (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list)))) + (list line-err-info-list pos)) + '(nil 0))) + +(defun flymake-line-err-info-is-less-or-equal (line-one line-two) + (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) + (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) + (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) + (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) + (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) + (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) + +(defun flymake-add-line-err-info (line-err-info-list line-err-info) + "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. +For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. +The new element is inserted in the proper position, according to +the predicate `flymake-line-err-info-is-less-or-equal'. +The updated value of LINE-ERR-INFO-LIST is returned." + (if (not line-err-info-list) + (list line-err-info) + (let* ((count (length line-err-info-list)) + (idx 0)) + (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) + (setq idx (1+ idx))) + (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) + (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info)))) + line-err-info-list))) + +(defun flymake-add-err-info (err-info-list line-err-info) + "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order. +Returns the updated value of ERR-INFO-LIST. +For the format of ERR-INFO-LIST, see `flymake-err-info'. +For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." + (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) + (info-and-pos (flymake-find-err-info err-info-list line-no)) + (exists (car info-and-pos)) + (pos (nth 1 info-and-pos)) + (line-err-info-list nil) + (err-info nil)) + + (if exists + (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list))))) + (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) + + (setq err-info (flymake-er-make-er line-no line-err-info-list)) + (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) + ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) + (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info)))) + err-info-list)) + +(defun flymake-get-project-include-dirs-imp (basedir) + "Include dirs for the project current file belongs to." + (if (flymake-get-project-include-dirs-from-cache basedir) + (progn + (flymake-get-project-include-dirs-from-cache basedir)) + ;;else + (let* ((command-line (concat "make -C " + (shell-quote-argument basedir) + " DUMPVARS=INCLUDE_DIRS dumpvars")) + (output (shell-command-to-string command-line)) + (lines (split-string output "\n" t)) + (count (length lines)) + (idx 0) + (inc-dirs nil)) + (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) + (setq idx (1+ idx))) + (when (< idx count) + (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) + (inc-count (length inc-lines))) + (while (> inc-count 0) + (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) + (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) + (setq inc-count (1- inc-count))))) + (flymake-add-project-include-dirs-to-cache basedir inc-dirs) + inc-dirs))) + +(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp + "Function used to get project include dirs, one parameter: basedir name.") + +(defun flymake-get-project-include-dirs (basedir) + (funcall flymake-get-project-include-dirs-function basedir)) + +(defun flymake-get-system-include-dirs () + "System include dirs - from the `INCLUDE' env setting." + (let* ((includes (getenv "INCLUDE"))) + (if includes (split-string includes path-separator t) nil))) + +(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) + +(defun flymake-get-project-include-dirs-from-cache (base-dir) + (gethash base-dir flymake-project-include-dirs-cache)) + +(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs) + (puthash base-dir include-dirs flymake-project-include-dirs-cache)) + +(defun flymake-clear-project-include-dirs-cache () + (clrhash flymake-project-include-dirs-cache)) + +(defun flymake-get-include-dirs (base-dir) + "Get dirs to use when resolving local file names." + (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) + include-dirs)) + +;; (defun flymake-restore-formatting () +;; "Remove any formatting made by flymake." +;; ) + +;; (defun flymake-get-program-dir (buffer) +;; "Get dir to start program in." +;; (unless (bufferp buffer) +;; (error "Invalid buffer")) +;; (with-current-buffer buffer +;; default-directory)) + +(defun flymake-safe-delete-file (file-name) + (when (and file-name (file-exists-p file-name)) + (delete-file file-name) + (flymake-log 1 "deleted file %s" file-name))) + +(defun flymake-safe-delete-directory (dir-name) + (condition-case nil + (progn + (delete-directory dir-name) + (flymake-log 1 "deleted dir %s" dir-name)) + (error + (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) + +(defun flymake-start-syntax-check () + "Start syntax checking for current buffer." + (interactive) + (flymake-log 3 "flymake is running: %s" flymake-is-running) + (when (and (not flymake-is-running) + (flymake-can-syntax-check-file buffer-file-name)) + (when (or (not flymake-compilation-prevents-syntax-check) + (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") + (flymake-clear-buildfile-cache) + (flymake-clear-project-include-dirs-cache) + + (setq flymake-check-was-interrupted nil) + + (let* ((source-file-name buffer-file-name) + (init-f (flymake-get-init-function source-file-name)) + (cleanup-f (flymake-get-cleanup-function source-file-name)) + (cmd-and-args (funcall init-f)) + (cmd (nth 0 cmd-and-args)) + (args (nth 1 cmd-and-args)) + (dir (nth 2 cmd-and-args))) + (if (not cmd-and-args) + (progn + (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) + (funcall cleanup-f)) + (progn + (setq flymake-last-change-time nil) + (flymake-start-syntax-check-process cmd args dir))))))) + +(defun flymake-start-syntax-check-process (cmd args dir) + "Start syntax check process." + (condition-case err + (let* ((process + (let ((default-directory (or dir default-directory))) + (when dir + (flymake-log 3 "starting process on dir %s" dir)) + (apply 'start-file-process + "flymake-proc" (current-buffer) cmd args)))) + (set-process-sentinel process 'flymake-process-sentinel) + (set-process-filter process 'flymake-process-filter) + (set-process-query-on-exit-flag process nil) + (push process flymake-processes) + + (setq flymake-is-running t) + (setq flymake-last-change-time nil) + (setq flymake-check-start-time (float-time)) + + (flymake-report-status nil "*") + (flymake-log 2 "started process %d, command=%s, dir=%s" + (process-id process) (process-command process) + default-directory) + process) + (error + (let* ((err-str + (format-message + "Failed to launch syntax check process `%s' with args %s: %s" + cmd args (error-message-string err))) + (source-file-name buffer-file-name) + (cleanup-f (flymake-get-cleanup-function source-file-name))) + (flymake-log 0 err-str) + (funcall cleanup-f) + (flymake-report-fatal-status "PROCERR" err-str))))) + +(defun flymake-kill-process (proc) + "Kill process PROC." + (kill-process proc) + (let* ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (setq flymake-check-was-interrupted t)))) + (flymake-log 1 "killed process %d" (process-id proc))) + +(defun flymake-stop-all-syntax-checks () + "Kill all syntax check processes." + (interactive) + (while flymake-processes + (flymake-kill-process (pop flymake-processes)))) + +(defun flymake-compilation-is-running () + (and (boundp 'compilation-in-progress) + compilation-in-progress)) + +(defun flymake-compile () + "Kill all flymake syntax checks, start compilation." + (interactive) + (flymake-stop-all-syntax-checks) + (call-interactively 'compile)) + +(defun flymake-on-timer-event (buffer) + "Start a syntax check for buffer BUFFER if necessary." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (and (not flymake-is-running) + flymake-last-change-time + (> (- (float-time) flymake-last-change-time) + flymake-no-changes-timeout)) + + (setq flymake-last-change-time nil) + (flymake-log 3 "starting syntax check as more than 1 second passed since last change") + (flymake-start-syntax-check))))) + +(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line + 'flymake-popup-current-error-menu "24.4") + +(defun flymake-popup-current-error-menu (&optional event) + "Pop up a menu with errors/warnings for current line." + (interactive (list last-nonmenu-event)) + (let* ((line-no (line-number-at-pos)) + (errors (or (car (flymake-find-err-info flymake-err-info line-no)) + (user-error "No errors for current line"))) + (menu (mapcar (lambda (x) + (if (flymake-ler-file x) + (cons (format "%s - %s(%d)" + (flymake-ler-text x) + (flymake-ler-file x) + (flymake-ler-line x)) + x) + (list (flymake-ler-text x)))) + errors)) + (event (if (mouse-event-p event) + event + (list 'mouse-1 (posn-at-point)))) + (title (format "Line %d: %d error(s), %d warning(s)" + line-no + (flymake-get-line-err-count errors "e") + (flymake-get-line-err-count errors "w"))) + (choice (x-popup-menu event (list title (cons "" menu))))) + (flymake-log 3 "choice=%s" choice) + (when choice + (flymake-goto-file-and-line (flymake-ler-full-file choice) + (flymake-ler-line choice))))) + +(defun flymake-goto-file-and-line (file line) + "Try to get buffer for FILE and goto line LINE in it." + (if (not (file-exists-p file)) + (flymake-log 1 "File %s does not exist" file) + (find-file file) + (goto-char (point-min)) + (forward-line (1- line)))) + +;; flymake minor mode declarations +(defvar-local flymake-mode-line nil) +(defvar-local flymake-mode-line-e-w nil) +(defvar-local flymake-mode-line-status nil) + +(defun flymake-report-status (e-w &optional status) + "Show status in mode line." + (when e-w + (setq flymake-mode-line-e-w e-w)) + (when status + (setq flymake-mode-line-status status)) + (let* ((mode-line " Flymake")) + (when (> (length flymake-mode-line-e-w) 0) + (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) + (setq mode-line (concat mode-line flymake-mode-line-status)) + (setq flymake-mode-line mode-line) + (force-mode-line-update))) + +;; Nothing in flymake uses this at all any more, so this is just for +;; third-party compatibility. +(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") + +(defun flymake-report-fatal-status (status warning) + "Display a warning and switch flymake mode off." + ;; This first message was always shown by default, and flymake-log + ;; does nothing by default, hence the use of message. + ;; Another option is display-warning. + (if (< flymake-log-level 0) + (message "Flymake: %s. Flymake will be switched OFF" warning)) + (flymake-mode 0) + (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" + (buffer-name) status warning)) + +;;;###autoload +(define-minor-mode flymake-mode nil + :group 'flymake :lighter flymake-mode-line + (cond + + ;; Turning the mode ON. + (flymake-mode + (cond + ((not buffer-file-name) + (message "Flymake unable to run without a buffer file name")) + ((not (flymake-can-syntax-check-file buffer-file-name)) + (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) + (t + (add-hook 'after-change-functions 'flymake-after-change-function nil t) + (add-hook 'after-save-hook 'flymake-after-save-hook nil t) + (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) + + (flymake-report-status "" "") + + (setq flymake-timer + (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) + + (when (and flymake-start-syntax-check-on-find-file + ;; Since we write temp files in current dir, there's no point + ;; trying if the directory is read-only (bug#8954). + (file-writable-p (file-name-directory buffer-file-name))) + (with-demoted-errors + (flymake-start-syntax-check)))))) + + ;; Turning the mode OFF. + (t + (remove-hook 'after-change-functions 'flymake-after-change-function t) + (remove-hook 'after-save-hook 'flymake-after-save-hook t) + (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) + ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) + + (flymake-delete-own-overlays) + + (when flymake-timer + (cancel-timer flymake-timer) + (setq flymake-timer nil)) + + (setq flymake-is-running nil)))) + +;;;###autoload +(defun flymake-mode-on () + "Turn flymake mode on." + (flymake-mode 1) + (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name))) + +;;;###autoload +(defun flymake-mode-off () + "Turn flymake mode off." + (flymake-mode 0) + (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) + +(defun flymake-after-change-function (start stop _len) + "Start syntax check for current buffer if it isn't already running." + ;;+(flymake-log 0 "setting change time to %s" (float-time)) + (let((new-text (buffer-substring start stop))) + (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) + (flymake-log 3 "starting syntax check as new-line has been seen") + (flymake-start-syntax-check)) + (setq flymake-last-change-time (float-time)))) + +(defun flymake-after-save-hook () + (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? + (progn + (flymake-log 3 "starting syntax check as buffer was saved") + (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + +(defun flymake-kill-buffer-hook () + (when flymake-timer + (cancel-timer flymake-timer) + (setq flymake-timer nil))) + +;;;###autoload +(defun flymake-find-file-hook () + ;;+(when flymake-start-syntax-check-on-find-file + ;;+ (flymake-log 3 "starting syntax check on file open") + ;;+ (flymake-start-syntax-check) + ;;+) + (when (and (not (local-variable-p 'flymake-mode (current-buffer))) + (flymake-can-syntax-check-file buffer-file-name)) + (flymake-mode) + (flymake-log 3 "automatically turned ON flymake mode"))) + +(defun flymake-get-first-err-line-no (err-info-list) + "Return first line with error." + (when err-info-list + (flymake-er-get-line (car err-info-list)))) + +(defun flymake-get-last-err-line-no (err-info-list) + "Return last line with error." + (when err-info-list + (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)))) + +(defun flymake-get-next-err-line-no (err-info-list line-no) + "Return next line with error." + (when err-info-list + (let* ((count (length err-info-list)) + (idx 0)) + (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) + (setq idx (1+ idx))) + (if (< idx count) + (flymake-er-get-line (nth idx err-info-list)))))) + +(defun flymake-get-prev-err-line-no (err-info-list line-no) + "Return previous line with error." + (when err-info-list + (let* ((count (length err-info-list))) + (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) + (setq count (1- count))) + (if (> count 0) + (flymake-er-get-line (nth (1- count) err-info-list)))))) + +(defun flymake-skip-whitespace () + "Move forward until non-whitespace is reached." + (while (looking-at "[ \t]") + (forward-char))) + +(defun flymake-goto-line (line-no) + "Go to line LINE-NO, then skip whitespace." + (goto-char (point-min)) + (forward-line (1- line-no)) + (flymake-skip-whitespace)) + +(defun flymake-goto-next-error () + "Go to next error in err ring." + (interactive) + (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) + (when (not line-no) + (setq line-no (flymake-get-first-err-line-no flymake-err-info)) + (flymake-log 1 "passed end of file")) + (if line-no + (flymake-goto-line line-no) + (flymake-log 1 "no errors in current buffer")))) + +(defun flymake-goto-prev-error () + "Go to previous error in err ring." + (interactive) + (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) + (when (not line-no) + (setq line-no (flymake-get-last-err-line-no flymake-err-info)) + (flymake-log 1 "passed beginning of file")) + (if line-no + (flymake-goto-line line-no) + (flymake-log 1 "no errors in current buffer")))) + +(defun flymake-patch-err-text (string) + (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) + (match-string 1 string) + string)) + +;;;; general init-cleanup and helper routines +(defun flymake-create-temp-inplace (file-name prefix) + (unless (stringp file-name) + (error "Invalid file-name")) + (or prefix + (setq prefix "flymake")) + (let* ((ext (file-name-extension file-name)) + (temp-name (file-truename + (concat (file-name-sans-extension file-name) + "_" prefix + (and ext (concat "." ext)))))) + (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) + temp-name)) + +(defun flymake-create-temp-with-folder-structure (file-name _prefix) + (unless (stringp file-name) + (error "Invalid file-name")) + + (let* ((dir (file-name-directory file-name)) + ;; Not sure what this slash-pos is all about, but I guess it's just + ;; trying to remove the leading / of absolute file names. + (slash-pos (string-match "/" dir)) + (temp-dir (expand-file-name (substring dir (1+ slash-pos)) + temporary-file-directory))) + + (file-truename (expand-file-name (file-name-nondirectory file-name) + temp-dir)))) + +(defun flymake-delete-temp-directory (dir-name) + "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." + (let* ((temp-dir temporary-file-directory) + (suffix (substring dir-name (1+ (length temp-dir))))) + + (while (> (length suffix) 0) + (setq suffix (directory-file-name suffix)) + ;;+(flymake-log 0 "suffix=%s" suffix) + (flymake-safe-delete-directory + (file-truename (expand-file-name suffix temp-dir))) + (setq suffix (file-name-directory suffix))))) + +(defvar-local flymake-temp-source-file-name nil) +(defvar-local flymake-master-file-name nil) +(defvar-local flymake-temp-master-file-name nil) +(defvar-local flymake-base-dir nil) + +(defun flymake-init-create-temp-buffer-copy (create-temp-f) + "Make a temporary copy of the current buffer, save its name in buffer data and return the name." + (let* ((source-file-name buffer-file-name) + (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) + + (flymake-save-buffer-in-file temp-source-file-name) + (setq flymake-temp-source-file-name temp-source-file-name) + temp-source-file-name)) + +(defun flymake-simple-cleanup () + "Do cleanup after `flymake-init-create-temp-buffer-copy'. +Delete temp file." + (flymake-safe-delete-file flymake-temp-source-file-name) + (setq flymake-last-change-time nil)) + +(defun flymake-get-real-file-name (file-name-from-err-msg) + "Translate file name from error message to \"real\" file name. +Return full-name. Names are real, not patched." + (let* ((real-name nil) + (source-file-name buffer-file-name) + (master-file-name flymake-master-file-name) + (temp-source-file-name flymake-temp-source-file-name) + (temp-master-file-name flymake-temp-master-file-name) + (base-dirs + (list flymake-base-dir + (file-name-directory source-file-name) + (if master-file-name (file-name-directory master-file-name)))) + (files (list (list source-file-name source-file-name) + (list temp-source-file-name source-file-name) + (list master-file-name master-file-name) + (list temp-master-file-name master-file-name)))) + + (when (equal 0 (length file-name-from-err-msg)) + (setq file-name-from-err-msg source-file-name)) + + (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) + ;; if real-name is nil, than file name from err msg is none of the files we've patched + (if (not real-name) + (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) + (if (not real-name) + (setq real-name file-name-from-err-msg)) + (setq real-name (flymake-fix-file-name real-name)) + (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) + real-name)) + +(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files) + (let* ((base-dirs-count (length base-dirs)) + (file-count (length files)) + (real-name nil)) + + (while (and (not real-name) (> base-dirs-count 0)) + (setq file-count (length files)) + (while (and (not real-name) (> file-count 0)) + (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) + (this-file (nth 0 (nth (1- file-count) files))) + (this-real-name (nth 1 (nth (1- file-count) files)))) + ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) + (when (and this-dir this-file (flymake-same-files + (expand-file-name file-name-from-err-msg this-dir) + this-file)) + (setq real-name this-real-name))) + (setq file-count (1- file-count))) + (setq base-dirs-count (1- base-dirs-count))) + real-name)) + +(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) + (let* ((real-name nil)) + (if (file-name-absolute-p file-name-from-err-msg) + (setq real-name file-name-from-err-msg) + (let* ((base-dirs-count (length base-dirs))) + (while (and (not real-name) (> base-dirs-count 0)) + (let* ((full-name (expand-file-name file-name-from-err-msg + (nth (1- base-dirs-count) base-dirs)))) + (if (file-exists-p full-name) + (setq real-name full-name)) + (setq base-dirs-count (1- base-dirs-count)))))) + real-name)) + +(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name) + "Find buildfile, store its dir in buffer data and return its dir, if found." + (let* ((buildfile-dir + (flymake-find-buildfile buildfile-name + (file-name-directory source-file-name)))) + (if buildfile-dir + (setq flymake-base-dir buildfile-dir) + (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) + (flymake-report-fatal-status + "NOMK" (format "No buildfile (%s) found for %s" + buildfile-name source-file-name))))) + +(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) + "Find master file (or buffer), create its copy along with a copy of the source file." + (let* ((source-file-name buffer-file-name) + (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) + (master-and-temp-master (flymake-create-master-file + source-file-name temp-source-file-name + get-incl-dirs-f create-temp-f + master-file-masks include-regexp))) + + (if (not master-and-temp-master) + (progn + (flymake-log 1 "cannot find master file for %s" source-file-name) + (flymake-report-status "!" "") ; NOMASTER + nil) + (setq flymake-master-file-name (nth 0 master-and-temp-master)) + (setq flymake-temp-master-file-name (nth 1 master-and-temp-master))))) + +(defun flymake-master-cleanup () + (flymake-simple-cleanup) + (flymake-safe-delete-file flymake-temp-master-file-name)) + +;;;; make-specific init-cleanup routines +(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) + "Create a command line for syntax check using GET-CMD-LINE-F." + (funcall get-cmd-line-f + (if use-relative-source + (file-relative-name source-file-name base-dir) + source-file-name) + (if use-relative-base-dir + (file-relative-name base-dir + (file-name-directory source-file-name)) + base-dir))) + +(defun flymake-get-make-cmdline (source base-dir) + (list "make" + (list "-s" + "-C" + base-dir + (concat "CHK_SOURCES=" source) + "SYNTAX_CHECK_MODE=1" + "check-syntax"))) + +(defun flymake-get-ant-cmdline (source base-dir) + (list "ant" + (list "-buildfile" + (concat base-dir "/" "build.xml") + (concat "-DCHK_SOURCES=" source) + "check-syntax"))) + +(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) + "Create syntax check command line for a directly checked source file. +Use CREATE-TEMP-F for creating temp copy." + (let* ((args nil) + (source-file-name buffer-file-name) + (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name))) + (if buildfile-dir + (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))) + (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir + use-relative-base-dir use-relative-source + get-cmdline-f)))) + args)) + +(defun flymake-simple-make-init () + (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) + +(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) + "Create make command line for a source file checked via master file compilation." + (let* ((make-args nil) + (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy + get-incl-dirs-f 'flymake-create-temp-inplace + master-file-masks include-regexp))) + (when temp-master-file-name + (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) + (if buildfile-dir + (setq make-args (flymake-get-syntax-check-program-args + temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline))))) + make-args)) + +(defun flymake-find-make-buildfile (source-dir) + (flymake-find-buildfile "Makefile" source-dir)) + +;;;; .h/make specific +(defun flymake-master-make-header-init () + (flymake-master-make-init + 'flymake-get-include-dirs + '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") + "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) + +;;;; .java/make specific +(defun flymake-simple-make-java-init () + (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)) + +(defun flymake-simple-ant-java-init () + (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline)) + +(defun flymake-simple-java-cleanup () + "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs." + (flymake-safe-delete-file flymake-temp-source-file-name) + (when flymake-temp-source-file-name + (flymake-delete-temp-directory + (file-name-directory flymake-temp-source-file-name)))) + +;;;; perl-specific init-cleanup routines +(defun flymake-perl-init () + (let* ((temp-file (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) + (list "perl" (list "-wc " local-file)))) + +;;;; php-specific init-cleanup routines +(defun flymake-php-init () + (let* ((temp-file (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) + (list "php" (list "-f" local-file "-l")))) + +;;;; tex-specific init-cleanup routines +(defun flymake-get-tex-args (file-name) + ;;(list "latex" (list "-c-style-errors" file-name)) + (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) + +(defun flymake-simple-tex-init () + (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) + +;; Perhaps there should be a buffer-local variable flymake-master-file +;; that people can set to override this stuff. Could inherit from +;; the similar AUCTeX variable. +(defun flymake-master-tex-init () + (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy + 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace + '("\\.tex\\'") + "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) + (when temp-master-file-name + (flymake-get-tex-args temp-master-file-name)))) + +(defun flymake-get-include-dirs-dot (_base-dir) + '(".")) + +;;;; xml-specific init-cleanup routines +(defun flymake-xml-init () + (list flymake-xml-program + (list "val" (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)))) (provide 'flymake) ;;; flymake.el ends here From 88a0dd71f10ffb63fba08c062e948551c3e876c2 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Thu, 28 Sep 2017 10:10:21 +0200 Subject: [PATCH 77/81] In w32fullscreen_hook don't add decorations to undecorated frames * src/w32term.c (w32fullscreen_hook): Do not add (or try to remove) decorations for undecorated frames. --- src/w32term.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/w32term.c b/src/w32term.c index a7a510b9ecb..d7ec40118f3 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6252,7 +6252,8 @@ w32fullscreen_hook (struct frame *f) if (FRAME_PREV_FSMODE (f) == FULLSCREEN_BOTH) { - SetWindowLong (hwnd, GWL_STYLE, dwStyle | WS_OVERLAPPEDWINDOW); + if (!FRAME_UNDECORATED (f)) + SetWindowLong (hwnd, GWL_STYLE, dwStyle | WS_OVERLAPPEDWINDOW); SetWindowPlacement (hwnd, &FRAME_NORMAL_PLACEMENT (f)); } else if (FRAME_PREV_FSMODE (f) == FULLSCREEN_HEIGHT @@ -6278,7 +6279,8 @@ w32fullscreen_hook (struct frame *f) w32_fullscreen_rect (hwnd, f->want_fullscreen, FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect); - SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW); + if (!FRAME_UNDECORATED (f)) + SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW); SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top, rect.right - rect.left, rect.bottom - rect.top, SWP_NOOWNERZORDER | SWP_FRAMECHANGED); From 0f9a78e7700ab3eed370c2f616d7932d953dd100 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Thu, 28 Sep 2017 18:47:07 +0200 Subject: [PATCH 78/81] Add tests for `css-current-defun-name' * test/lisp/textmodes/css-mode-tests.el (css-test-current-defun-name) (css-test-current-defun-name-nested) (css-test-current-defun-name-complex): New tests for `css-current-defun-name'. --- test/lisp/textmodes/css-mode-tests.el | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index f93fdbbc5af..47cf5f9244b 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -80,6 +80,27 @@ (equal (seq-sort #'string-lessp (css--value-class-lookup 'position)) '("bottom" "calc()" "center" "left" "right" "top")))) +(ert-deftest css-test-current-defun-name () + (with-temp-buffer + (insert "body { top: 0; }") + (goto-char 7) + (should (equal (css-current-defun-name) "body")) + (goto-char 18) + (should (equal (css-current-defun-name) "body")))) + +(ert-deftest css-test-current-defun-name-nested () + (with-temp-buffer + (insert "body > .main a { top: 0; }") + (goto-char 20) + (should (equal (css-current-defun-name) "body > .main a")))) + +(ert-deftest css-test-current-defun-name-complex () + (with-temp-buffer + (insert "input[type=submit]:hover { color: red; }") + (goto-char 30) + (should (equal (css-current-defun-name) + "input[type=submit]:hover")))) + ;;; Completion (defun css-mode-tests--completions () From fec63089d53d2196b0348086aeed70277fbc02c0 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sun, 24 Sep 2017 12:01:03 +0100 Subject: [PATCH 79/81] Fix build on macOS (bug#28571) * src/conf_post.h (HAVE_FUTIMENS, HAVE_FUTIMESAT, HAVE_UTIMENSAT) [DARWIN_OS]: Undefine. --- src/conf_post.h | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/conf_post.h b/src/conf_post.h index febdb8b8bf7..af946082eec 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -397,3 +397,12 @@ extern int emacs_setenv_TZ (char const *); #else # define UNINIT /* empty */ #endif + +/* macOS 10.13 supports futimens, futimesat and utimensat, older + versions don't but can appear as though they do. Disable them + entirely to avoid breaking cross-version builds on macOS. */ +#ifdef DARWIN_OS +# undef HAVE_FUTIMENS +# undef HAVE_FUTIMESAT +# undef HAVE_UTIMENSAT +#endif From 7476eeaa236039b8ebd09aad6bd977d26646ace6 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Thu, 28 Sep 2017 22:27:02 +0100 Subject: [PATCH 80/81] Revert "Fix build on macOS (bug#28571)" This reverts commit fec63089d53d2196b0348086aeed70277fbc02c0. Prematurely pushed. --- src/conf_post.h | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/conf_post.h b/src/conf_post.h index af946082eec..febdb8b8bf7 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -397,12 +397,3 @@ extern int emacs_setenv_TZ (char const *); #else # define UNINIT /* empty */ #endif - -/* macOS 10.13 supports futimens, futimesat and utimensat, older - versions don't but can appear as though they do. Disable them - entirely to avoid breaking cross-version builds on macOS. */ -#ifdef DARWIN_OS -# undef HAVE_FUTIMENS -# undef HAVE_FUTIMESAT -# undef HAVE_UTIMENSAT -#endif From af130f900fc499f71ea22f10ba055a75ce35ed4e Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 23 Sep 2017 11:40:14 -0400 Subject: [PATCH 81/81] Fix ert backtrace saving for non-`signal'ed errors (Bug#28333) * lisp/emacs-lisp/ert.el (ert--run-test-debugger): Take the frames above the `debugger' frame, rather than assuming there will be a `signal' frame. --- lisp/emacs-lisp/ert.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d4276221ba5..83acbacb883 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -742,9 +742,8 @@ run. ARGS are the arguments to `debugger'." ;; backtrace ready for printing is important for batch ;; use. ;; - ;; Grab the frames starting from `signal', frames below - ;; that are all from the debugger. - (backtrace (backtrace-frames 'signal)) + ;; Grab the frames above the debugger. + (backtrace (cdr (backtrace-frames debugger))) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) (cl-ecase type